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.

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index fd08970..06b1153 100644 (file)
--- 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<t> - trace
+=head4 C<t> - 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<DB> 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 @@ B</>I<pattern>B</>    Search forwards for I<pattern>; final B</> is optional.
 B<?>I<pattern>B<?>    Search backwards for I<pattern>; final B<?> is optional.
 B<L> [I<a|b|w>]        List actions and or breakpoints and or watch-expressions.
 B<S> [[B<!>]I<pattern>]    List subroutine names [not] matching I<pattern>.
-B<t>        Toggle trace mode.
-B<t> I<expr>        Trace through execution of I<expr>.
+B<t> [I<n>]       Toggle trace mode (to max I<n> levels below current stack depth).
+B<t> [I<n>] I<expr>        Trace through execution of I<expr>.
 B<b>        Sets breakpoint on current line)
 B<b> [I<line>] [I<condition>]
         Set breakpoint; I<line> defaults to the current execution line;
@@ -7468,7 +7480,7 @@ I<List/search source lines:>               I<Control script execution:>
   B</>I<pattern>B</> B<?>I<patt>B<?>   Search forw/backw    B<r>           Return from subroutine
   B<M>           Show module versions        B<c> [I<ln>|I<sub>]  Continue until position
 I<Debugger controls:>                        B<L>           List break/watch/actions
-  B<o> [...]     Set debugger options        B<t> [I<expr>]    Toggle trace [trace expr]
+  B<o> [...]     Set debugger options        B<t> [I<n>] [I<expr>] Toggle trace [max depth] ][trace expr]
   B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
   B<$prc> [I<N>|I<pat>]   Redo a previous command     B<B> I<ln|*>      Delete a/all breakpoints
   B<H> [I<-num>]    Display last num commands   B<a> [I<ln>] I<cmd>  Do cmd before line
@@ -7519,8 +7531,8 @@ B</>I<pattern>B</>    Search forwards for I<pattern>; final B</> is optional.
 B<?>I<pattern>B<?>    Search backwards for I<pattern>; final B<?> is optional.
 B<L>        List all breakpoints and actions.
 B<S> [[B<!>]I<pattern>]    List subroutine names [not] matching I<pattern>.
-B<t>        Toggle trace mode.
-B<t> I<expr>        Trace through execution of I<expr>.
+B<t> [I<n>]       Toggle trace mode (to max I<n> levels below current stack depth) .
+B<t> [I<n>] I<expr>        Trace through execution of I<expr>.
 B<b> [I<line>] [I<condition>]
         Set breakpoint; I<line> defaults to the current execution line;
         I<condition> breaks if it evaluates to true, defaults to '1'.

diff --git a/lib/perl5db.t b/lib/perl5db.t
index c8eb63e..36dbcb8 100644 (file)
--- 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 = <I>;
+        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 (file)
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 (file)
--- a/pod/perldebug.pod
+++ b/pod/perldebug.pod
@@ -269,15 +269,19 @@ X<debugger command, S>
 
 List subroutine names [not] matching the regex.
 
-=item t
+=item t [n]
 X<debugger command, t>
 
 Toggle trace mode (see also the C<AutoTrace> 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<debugger command, t>
 
 Trace through execution of C<expr>.
+Optional first argument is the maximum number of levels to trace below
+the current one; anything deeper than that will be silent.
 See L<perldebguts/"Frame Listing Output Examples"> for examples.
 
 =item b