Skip Menu |
Report information
Id: 132703
Status: new
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: kes-kes [at] yandex.ru
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.24.0
Fixed In: (no value)



Date: Wed, 10 Jan 2018 16:02:23 +0200
From: KES <kes-kes [...] yandex.ru>
Subject: DB::goto should be improved
To: perlbug <perlbug [...] perl.org>
Download (untitled) / with headers
text/plain 8.6k
Cc: kes-kes@yandex.ru To: perlbug@perl.org Message-Id: <5.24.0_10269_1515582182@work> Subject: DB::goto should be improved From: kes-kes@yandex.ru Reply-To: kes-kes@yandex.ru This is a bug report for perl from kes-kes@yandex.ru, generated with the help of perlbug 1.40 running under perl 5.24.0. ----------------------------------------------------------------- [Please describe your issue here] Hi. When we want to debug goto calls in script: $ cat script.pl sub t{} sub t2 { goto &t; } my $sub = \&t2; $sub->( 1, 2, 3 ); We can write next debugger script: $ cat Devel/DB.pm package DB; BEGIN { $^P |= 0x80 } sub DB{}; sub goto{ my @frame = caller(0); print "Instead of XXX the $DB::sub is called at\n"; print join( ' ', @frame[0..3,4]), "\n"; } 1; Now we can found all places where different subs are called: $ perl -d:DB t.pl Instead of XXX the main::t is called at main t.pl 10 DB::goto 1 BUT1! What sub is replaced is unknown XXX without looking into sources at t.pl script line 10. But we are not lucky because at that point a call by CODEREF. This forces us manually trace code before this call... BUT2! Even worse we lose caller info when our debugger defines DB::sub subroutine $ cat Devel/DB.pm package DB; BEGIN { $^P |= 0x80 } sub DB{}; sub goto{ my @frame = caller(0); print "Instead of XXX the $DB::sub is called at\n"; print join( ' ', @frame[0..3,4]), "\n"; } sub sub { &$DB::sub } # <<< DEFINED 1; $ perl -d:DB t.pl Instead of XXX the main::t is called at DB Devel/DB.pm 12 DB::goto 1 (Ordinary DB::sub is hidden from caller. We even can not use caller inside DB::sub But in these race condition when we call caller from DB::goto the DB::sub frame is visible. BUG?) This makes our debugger pretty useless. I think this was not intended to work in such way. So what information we can gather? By dumping call stack from our goto debugger with and without defined DB::sub sub goto{ my( $lvl, @frame ); print "\nAFTER GOTO: $DB::sub\n"; print join( '-', @frame[0..3,4]), "\n" while @frame = caller( $lvl++ ); } We can see the difference: main-t.pl-10-DB::goto-1 main-t.pl-10-main::t-1 DB-Devel/DB.pm-12-DB::goto-1 main-t.pl-10-main::t-1 I already asked about this [here](https://stackoverflow.com/questions/34595192/how-to-fix-the-dbgoto-frame) but now I can see that problem is not because of execution order as described at [this answer](https://stackoverflow.com/a/34605101/4632019) Look. Now we modify our debugger and script: $ cat script.pl sub t{} sub t2 { scalar t(); # Make this as most recent call. NOTICE SCALAR CONTEXT goto &t; } my $sub = \&t2; $sub->( 1, 2, 3 ); $ cat Devel/DB.pm package DB; BEGIN { $^P |= 0x80 } sub goto{ my( $lvl, @frame ); print "\nAFTER GOTO: $DB::sub\n"; print join( '-', @frame[0..3,4]), "\n" while @frame = caller( $lvl++ ); } sub DB{ print 'DB::DB ', join ' ', (caller 0)[0..2]; print "\n"; }; sub sub{ print 'DB::sub ', join ' ', (sub{ caller }->())[0..2]; print "\n"; if( wantarray ) { my @res = &$DB::sub; return @res; } elsif( defined wantarray) { my $res = &$DB::sub; return $res; } else { &$DB::sub; return; } }; 1; Now the execution order is: DB::DB main t.pl 9 DB::DB main t.pl 10 DB::sub main t.pl 10 DB::DB main t.pl 3 DB::sub main t.pl 3 DB::DB main t.pl 1 DB::DB main t.pl 7 DB::DB main t.pl 1 What is the difference in compare to ThisSuitIsBlackNot's answer? We make one more call before the goto. Also to differentiate our two calls we make them in different context. Our first call is in VOID context; **Latest** call is in SCALAR context; And when we dump call stack from DB::goto we see: DB-Devel/DB.pm-23-DB::goto-1 main-t.pl-10-main::t-1 The 23th line of our debugger is call for VOID context. Therefore our DB::goto see's context of our first call. To prove this we can change context: DB-Devel/DB.pm-20-DB::goto-1 for $x = $sub->( 1, 2, 3 ); and DB-Devel/DB.pm-17-DB::goto-1 for @x = $sub->( 1, 2, 3 ); where 20 and 17 lines are for SCALAR and LIST contexts correspondingly There is no output change when we switch context for second call (line 3 in source) What current information is available: DB-Devel/DB.pm-20-DB::goto-1 main-t.pl-10-main::t-1 (Also notice that this info is not consistent and depend on which features are implemented in DB::) Please improve perl internals to work in next manner instead: When goto OP is executed in normal mode just lets do it its black magic. But when goto OP is executed under dubugger do ordinal call to &DB::goto When it returns do normal goto black magic. The benefit will be next info available to caller from DB::goto main-t.pl-7-DB::goto-0 main-t.pl-10-main::t2-1 We can see everything in t2 frame (with help of PadWalker, for example) We can track modifications of @_ (NOTICE the flag $hasargs is 0) We can see original subroutine name: main::t2 Eliminate BUT1, BUT2 (see above) As I can see this is not hard to implement: Just do &DB::goto call before goto black magic PS. Maybe someone will argue that goto should be hidden. Yes, it should for script, but not under debugger. The debugger should see goto context because debugger is intended for this purpose. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.24.0: Configured by kes at Wed Oct 19 14:07:47 EEST 2016. Summary of my perl5 (revision 5 version 24 subversion 0) configuration: Platform: osname=linux, osvers=4.4.0-43-generic, archname=x86_64-linux uname='linux work 4.4.0-43-generic #63-ubuntu smp wed oct 12 13:48:03 utc 2016 x86_64 x86_64 x86_64 gnulinux ' config_args='-de -Dprefix=/home/kes/perl5/perlbrew/perls/perl-5.24.0 -Aeval:scriptdir=/home/kes/perl5/perlbrew/perls/perl-5.24.0/bin' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include' ccversion='', gccversion='5.4.0 20160609', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='cc', ldflags =' -fstack-protector-strong -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/5/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /lib64 /usr/lib64 libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc libc=libc-2.23.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.23' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong' Locally applied patches: Devel::PatchPerl 1.38 --- @INC for perl 5.24.0: /home/kes/perl5/perlbrew/perls/perl-5.24.0/lib/site_perl/5.24.0/x86_64-linux /home/kes/perl5/perlbrew/perls/perl-5.24.0/lib/site_perl/5.24.0 /home/kes/perl5/perlbrew/perls/perl-5.24.0/lib/5.24.0/x86_64-linux /home/kes/perl5/perlbrew/perls/perl-5.24.0/lib/5.24.0 . --- Environment for perl 5.24.0: HOME=/home/kes LANG=en_US.UTF-8 LANGUAGE=en LC_ADDRESS=uk_UA.UTF-8 LC_IDENTIFICATION=uk_UA.UTF-8 LC_MEASUREMENT=uk_UA.UTF-8 LC_MESSAGES=en_US.UTF-8 LC_MONETARY=uk_UA.UTF-8 LC_NAME=uk_UA.UTF-8 LC_NUMERIC=uk_UA.UTF-8 LC_PAPER=uk_UA.UTF-8 LC_TELEPHONE=uk_UA.UTF-8 LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/kes/perl5/perlbrew/bin:/home/kes/perl5/perlbrew/perls/perl-5.24.0/bin:/home/kes/bin:/home/kes/bin:/home/kes/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games PERLBREW=command perlbrew PERLBREW_BASHRC_VERSION=0.78 PERLBREW_HOME=/home/kes/.perlbrew PERLBREW_MANPATH=/home/kes/perl5/perlbrew/perls/perl-5.24.0/man PERLBREW_PATH=/home/kes/perl5/perlbrew/bin:/home/kes/perl5/perlbrew/perls/perl-5.24.0/bin PERLBREW_PERL=perl-5.24.0 PERLBREW_ROOT=/home/kes/perl5/perlbrew PERLBREW_VERSION=0.78 PERL_BADLANG (unset) SHELL=/bin/bash


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org