From 611272bb8372feaba3d008744b5aa5a14c8b92c0 Mon Sep 17 00:00:00 2001 From: Peter Scott Date: Thu, 24 Nov 2011 01:21:29 -0800 Subject: [PATCH] The attached patch adds to the debugger a capability I thought about ages ago and which turned out to be absurdly easy to implement. It adds an optional parameter to the t(race) command, a maximum number of stack frames to trace below the current one:, e.g.: t 3 - turn tracing on, trace up to 3 levels below current depth, be silent below that t 2 fnord() - trace up to 2 levels deep in execution of fnord() Since it is backwards compatible I added it to the legacy command set as well, but that's certainly debatable. --- lib/perl5db.pl | 34 +++++++++++++++++++++++----------- lib/perl5db.t | 29 ++++++++++++++++++++++++++++- lib/perl5db/t/rt-104168 | 21 +++++++++++++++++++++ pod/perldebug.pod | 8 ++++++-- 4 files changed, 78 insertions(+), 14 deletions(-) create mode 100644 lib/perl5db/t/rt-104168 diff --git a/lib/perl5db.pl b/lib/perl5db.pl index fd08970..06b1153 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2115,7 +2115,7 @@ number information, and print that. "$line:\t$dbline[$line]$after" ); } else { - print_lineinfo($position); + depth_print_lineinfo($position); } # Scan forward, stopping at either the end or the next @@ -2143,7 +2143,7 @@ number information, and print that. "$i:\t$dbline[$i]$after" ); } else { - print_lineinfo($incr_pos); + depth_print_lineinfo($incr_pos); } } ## end for ($i = $line + 1 ; $i... } ## end else [ if ($slave_editor) @@ -2343,17 +2343,22 @@ environment, and executing with the last value of C<$?>. exit $?; }; -=head4 C - trace +=head4 C - trace [n] Turn tracing on or off. Inverts the appropriate bit in C<$trace> (q.v.). +If level is specified, set C<$trace_to_depth>. =cut - $cmd =~ /^t$/ && do { + $cmd =~ /^t(?:\s+(\d+))?$/ && do { + my $levels = $1; $trace ^= 1; local $\ = ''; + $trace_to_depth = $levels ? $stack_depth + $levels : 1E9; print $OUT "Trace = " - . ( ( $trace & 1 ) ? "on" : "off" ) . "\n"; + . ( ( $trace & 1 ) + ? ( $levels ? "on (to level $trace_to_depth)" : "on" ) + : "off" ) . "\n"; next CMD; }; @@ -3456,7 +3461,9 @@ any variables we might want to address in the C package. =cut # t - turn trace on. - $cmd =~ s/^t\s/\$DB::trace |= 1;\n/; + $cmd =~ s/^t\s+(\d+)?/\$DB::trace |= 1;\n/ && do { + $trace_to_depth = $1 ? $stack_depth||0 + $1 : 1E9; + }; # s - single-step. Remember the last command was 's'. $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do { $laststep = 's' }; @@ -3880,6 +3887,11 @@ sub lsub : lvalue { &$sub; } +# Abstracting common code from multiple places elsewhere: +sub depth_print_lineinfo { + print_lineinfo( @_ ) if $stack_depth < $trace_to_depth; +} + =head1 EXTENDED COMMAND HANDLING AND THE COMMAND API In Perl 5.8.0, there was a major realignment of the commands and what they did, @@ -7327,8 +7339,8 @@ BIB Search forwards for I; final B is optional. BIB Search backwards for I; final B is optional. B [I] List actions and or breakpoints and or watch-expressions. B [[B]I] List subroutine names [not] matching I. -B Toggle trace mode. -B I Trace through execution of I. +B [I] Toggle trace mode (to max I levels below current stack depth). +B [I] I Trace through execution of I. B Sets breakpoint on current line) B [I] [I] Set breakpoint; I defaults to the current execution line; @@ -7468,7 +7480,7 @@ I I BIB BIB Search forw/backw B Return from subroutine B Show module versions B [I|I] Continue until position I B List break/watch/actions - B [...] Set debugger options B [I] Toggle trace [trace expr] + B [...] Set debugger options B [I] [I] Toggle trace [max depth] ][trace expr] B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I] Do pre/post-prompt B [I|I|I] [I] Set breakpoint B<$prc> [I|I] Redo a previous command B I Delete a/all breakpoints B [I<-num>] Display last num commands B [I] I Do cmd before line @@ -7519,8 +7531,8 @@ BIB Search forwards for I; final B is optional. BIB Search backwards for I; final B is optional. B List all breakpoints and actions. B [[B]I] List subroutine names [not] matching I. -B Toggle trace mode. -B I Trace through execution of I. +B [I] Toggle trace mode (to max I levels below current stack depth) . +B [I] I Trace through execution of I. B [I] [I] Set breakpoint; I defaults to the current execution line; I breaks if it evaluates to true, defaults to '1'. diff --git a/lib/perl5db.t b/lib/perl5db.t index c8eb63e..36dbcb8 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(14); +plan(16); my $rc_filename = '.perldb'; @@ -210,6 +210,33 @@ EOF like($output, "All tests successful.", "[perl #66110]"); } +# [perl 104168] level option for tracing +{ + rc(<<'EOF'); +&parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); + +sub afterinit { + push (@DB::typeahead, + 't 2', + 'c', + 'q', + ); + +} +EOF + + my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-104168'); + my $contents; + { + local $/; + open I, "<", 'db.out' or die $!; + $contents = ; + close(I); + } + like($contents, qr/level 2/, "[perl #104168]"); + unlike($contents, qr/baz/, "[perl #104168]"); +} + # taint tests { diff --git a/lib/perl5db/t/rt-104168 b/lib/perl5db/t/rt-104168 new file mode 100644 index 0000000..345817b --- /dev/null +++ b/lib/perl5db/t/rt-104168 @@ -0,0 +1,21 @@ +#!/usr/bin/perl +# +# This code is used by lib/perl5db.t !!! +# + +foo(); + +sub foo { + bar(); +} + + +sub bar { + baz(); +} + +sub baz { + 1; +} + +1; diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 69245f9..fcdb29c 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -269,15 +269,19 @@ X List subroutine names [not] matching the regex. -=item t +=item t [n] X Toggle trace mode (see also the C option). +Optional argument is the maximum number of levels to trace below +the current one; anything deeper than that will be silent. -=item t expr +=item t [n] expr X Trace through execution of C. +Optional first argument is the maximum number of levels to trace below +the current one; anything deeper than that will be silent. See L for examples. =item b -- 2.7.4