diff options
| author | Ilya Zakharevich <ilya@math.berkeley.edu> | 1998-07-14 20:52:10 -0400 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-07-19 06:11:03 +0000 |
| commit | 7ea36084e4245db25ca4470a515a3d5817ca9c0f (patch) | |
| tree | c9c4cfe8e06317557e7a6d1cacfe4d4f0113da4a /lib/perl5db.pl | |
| parent | c6f14548d7bd301fc081005522b7fbe495c9b172 (diff) | |
| download | perl-7ea36084e4245db25ca4470a515a3d5817ca9c0f.tar.gz | |
improve 'frame' handling in debugger
Message-Id: <199807150452.AAA06685@monk.mps.ohio-state.edu>
Subject: [PATCH 5.004_72] Better debugger trace
p4raw-id: //depot/perl@1546
Diffstat (limited to 'lib/perl5db.pl')
| -rw-r--r-- | lib/perl5db.pl | 30 |
1 files changed, 20 insertions, 10 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl index a2b9926cc1..c87e905399 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2,7 +2,7 @@ package DB; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.02; +$VERSION = 1.03; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -1182,9 +1182,13 @@ sub sub { ? ( (print $LINEINFO ' ' x $#stack, "out "), print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; - print ($OUT ($frame & 16 ? ' ' x $#stack : ""), - "list context return from $sub:\n"), dumpit( \@ret ), - $doret = -2 if $doret eq $#stack or $frame & 16; + if ($doret eq $#stack or $frame & 16) { + my $fh = ($doret eq $#stack ? $OUT : $LINEINFO); + print $fh ' ' x $#stack if $frame & 16; + print $fh "list context return from $sub:\n"; + dumpit($fh, \@ret ); + $doret = -2; + } @ret; } else { if (defined wantarray) { @@ -1197,9 +1201,15 @@ sub sub { ? ( (print $LINEINFO ' ' x $#stack, "out "), print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; - print ($OUT ($frame & 16 ? ' ' x $#stack : ""), - "scalar context return from $sub: "), dumpit( $ret ), - $doret = -2 if $doret eq $#stack or $frame & 16; + if ($doret eq $#stack or $frame & 16 and defined wantarray) { + my $fh = ($doret eq $#stack ? $OUT : $LINEINFO); + print $fh (' ' x $#stack) if $frame & 16; + print $fh (defined wantarray + ? "scalar context return from $sub: " + : "void context return from $sub\n"); + dumpit( $fh, $ret ) if defined wantarray; + $doret = -2; + } $ret; } } @@ -1229,7 +1239,7 @@ sub eval { if ($at) { print $OUT $at; } elsif ($onetimeDump eq 'dump') { - dumpit(\@res); + dumpit($OUT, \@res); } elsif ($onetimeDump eq 'methods') { methods($res[0]); } @@ -1284,7 +1294,7 @@ sub postponed { } sub dumpit { - local ($savout) = select($OUT); + local ($savout) = select(shift); my $osingle = $single; my $otrace = $trace; $single = $trace = 0; @@ -1365,7 +1375,7 @@ sub dump_trace { push(@a, $_); } } - $context = $context ? '@' : "\$"; + $context = $context ? '@' : (defined $context ? "\$" : '.'); $args = $h ? [@a] : undef; $e =~ s/\n\s*\;\s*\Z// if $e; $e =~ s/([\\\'])/\\$1/g if $e; |