lib/perl5db.pl: don't dump argless args
authorDavid Mitchell <davem@iabyn.com>
Wed, 15 Nov 2017 15:25:08 +0000 (15:25 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 15 Nov 2017 15:42:15 +0000 (15:42 +0000)
dump_trace() prints a stack backtrace - including caller args - by using
caller() and @DB::args.

However, if a sub is called using the '&foo;' argless mechanism, caller()
doesn't populate @DB::args, so it continues to hold whatever it was set
to previously. This might include SVs which have since been freed or
re-allocated.

So only display args for a particular caller depth if that sub was called
with args.

This was causing smoke failures in lib/perl5db.t when TERM was unset.
It only started failing recently, due I guess to subtle changes in what
SVs were left hanging about in @DB::args from a previous use of caller().

See http://nntp.perl.org/group/perl.perl5.porters/247032
    Subject: Smoke FAIL's for lib/perl5db.t

lib/perl5db.pl

index d0c707e..ecc49a8 100644 (file)
@@ -529,7 +529,7 @@ BEGIN {
 use vars qw($VERSION $header);
 
 # bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.52';
+$VERSION = '1.53';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -6631,9 +6631,9 @@ sub dump_trace {
         $i++
     )
     {
-
-        # Go through the arguments and save them for later.
-        my $save_args = _dump_trace_calc_save_args($nothard);
+        # if the sub has args ($h true), make an anonymous array of the
+        # dumped args.
+        my $args = $h ? _dump_trace_calc_save_args($nothard) : undef;
 
         # If context is true, this is array (@)context.
         # If context is false, this is scalar ($) context.
@@ -6641,10 +6641,6 @@ sub dump_trace {
         # happen' trap.)
         $context = $context ? '@' : ( defined $context ? "\$" : '.' );
 
-        # if the sub has args ($h true), make an anonymous array of the
-        # dumped args.
-        $args = $h ? $save_args : undef;
-
         # remove trailing newline-whitespace-semicolon-end of line sequence
         # from the eval text, if any.
         $e =~ s/\n\s*\;\s*\Z// if $e;