Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

DB::goto should be improved #16356

Open
p5pRT opened this issue Jan 10, 2018 · 1 comment
Open

DB::goto should be improved #16356

p5pRT opened this issue Jan 10, 2018 · 1 comment

Comments

@p5pRT
Copy link

p5pRT commented Jan 10, 2018

Migrated from rt.perl.org#132703 (status was 'new')

Searchable as RT132703$

@p5pRT
Copy link
Author

p5pRT commented Jan 10, 2018

From @KES777

Created by @KES777

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.

Perl Info

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

2 participants