perl -d: display lines inside subroutines.
authorShlomi Fish <shlomif@shlomifish.org>
Sat, 10 Dec 2011 11:35:41 +0000 (13:35 +0200)
committerRicardo Signes <rjbs@cpan.org>
Thu, 29 Dec 2011 12:34:22 +0000 (07:34 -0500)
This is another fix to the perl debugger while making sure that lines
inside subroutines will be printed in the run-time display of the perl
debugger: https://rt.perl.org/rt3/Ticket/Display.html?id=104820 .

MANIFEST
lib/perl5db.pl
lib/perl5db.t
lib/perl5db/t/with-subroutine [new file with mode: 0644]

index 7435ba7..53acd0c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4253,6 +4253,7 @@ lib/perl5db/t/rt-61222            Tests for the Perl debugger
 lib/perl5db/t/rt-66110         Tests for the Perl debugger
 lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
 lib/perl5db/t/taint            Tests for the Perl debugger
+lib/perl5db/t/with-subroutine          Tests for the Perl debugger
 lib/PerlIO.pm                  PerlIO support module
 lib/Pod/Functions.pm           used by pod/splitpod
 lib/Pod/t/eol.t                        end of line agnosticism
index 874f6e1..e25b728 100644 (file)
@@ -2057,9 +2057,13 @@ won't cause trouble, and we say that the program is over.
 
 =cut
 
+    # Make sure that we always print if asked for explicitly regardless
+    # of $trace_to_depth .
+    my $explicit_stop = ($single || $was_signal);
+
     # Check to see if we should grab control ($single true,
     # trace set appropriately, or we got a signal).
-    if ( $single || ( $trace & 1 ) || $was_signal ) {
+    if ( $explicit_stop || ( $trace & 1 ) ) {
 
         # Yes, grab control.
         if ($slave_editor) {
@@ -2104,6 +2108,7 @@ number information, and print that.
 
         else {
 
+
             # Still somewhere in the midst of execution. Set up the
             #  debugger prompt.
             $sub =~ s/\'/::/;    # Swap Perl 4 package separators (') to
@@ -2131,7 +2136,7 @@ number information, and print that.
                     "$line:\t$dbline[$line]$after" );
             }
             else {
-                depth_print_lineinfo($position);
+                depth_print_lineinfo($explicit_stop, $position);
             }
 
             # Scan forward, stopping at either the end or the next
@@ -2159,7 +2164,7 @@ number information, and print that.
                         "$i:\t$dbline[$i]$after" );
                 }
                 else {
-                    depth_print_lineinfo($incr_pos);
+                    depth_print_lineinfo($explicit_stop, $incr_pos);
                 }
             } ## end for ($i = $line + 1 ; $i...
         } ## end else [ if ($slave_editor)
@@ -3906,7 +3911,9 @@ sub lsub : lvalue {
 
 # Abstracting common code from multiple places elsewhere:
 sub depth_print_lineinfo {
-    print_lineinfo( @_ ) if $stack_depth < $trace_to_depth;
+    my $always_print = shift;
+
+    print_lineinfo( @_ ) if ($always_print or $stack_depth < $trace_to_depth);
 }
 
 =head1 EXTENDED COMMAND HANDLING AND THE COMMAND API
index c583a85..0a5de2e 100644 (file)
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(21);
+plan(22);
 
 my $rc_filename = '.perldb';
 
@@ -469,7 +469,6 @@ sub afterinit {
     q/print "Exp={$exp}\n";/,
     'q',
     );
-
 }
 EOF
 
@@ -480,6 +479,29 @@ EOF
         "'b .' is working correctly.");
 }
 
+# Testing that the prompt with the information appears inside a subroutine call.
+# See https://rt.perl.org/rt3/Ticket/Display.html?id=104820
+{
+    rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+    push (@DB::typeahead,
+    'c back',
+    'q',
+    );
+}
+EOF
+    my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/with-subroutine');
+
+    like(_out_contents(), 
+        qr/
+        ^main::back\([^\)\n]*\bwith-subroutine:15\):[\ \t]*\n
+        ^15:\s*print\ "hello\ back\\n";
+        /msx,
+        "Prompt should display the line of code inside a subroutine.");
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }
diff --git a/lib/perl5db/t/with-subroutine b/lib/perl5db/t/with-subroutine
new file mode 100644 (file)
index 0000000..b1d70fe
--- /dev/null
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $x = 'hello world';
+
+print "$x\n";
+
+back();
+
+exit;
+
+sub back {
+    print "hello back\n";
+}
+