[perl5db] Fix source cmd from typeahead.

With a test.

diff --git a/MANIFEST b/MANIFEST
index ff83e24..c2ce840 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4332,6 +4332,7 @@ lib/perl5db/t/proxy-constants     Tests for the Perl debugger
 lib/perl5db/t/rt-104168                Tests for the Perl debugger
 lib/perl5db/t/rt-61222         Tests for the Perl debugger
 lib/perl5db/t/rt-66110         Tests for the Perl debugger
+lib/perl5db/t/source-cmd-test-no-q.perldb              TTests for the Perl debugger
 lib/perl5db/t/source-cmd-test.perldb           TTests for the Perl debugger
 lib/perl5db/t/symbol-table-bug Tests for the Perl debugger
 lib/perl5db/t/taint            Tests for the Perl debugger

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 4f517d0..54cabdc 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -6517,6 +6517,20 @@ sub readline {
     # Localize to prevent it from being smashed in the program being debugged.
     local $.;
 
+    # If there are stacked filehandles to read from ...
+    # (Handle it before the typeahead, because we may call source/etc. from
+    # the typeahead.)
+    while (@cmdfhs) {
+
+        # Read from the last one in the stack.
+        my $line = CORE::readline( $cmdfhs[-1] );
+
+        # If we got a line ...
+        defined $line
+          ? ( print $OUT ">> $line" and return $line )    # Echo and return
+          : close pop @cmdfhs;                            # Pop and close
+    } ## end while (@cmdfhs)
+
     # Pull a line out of the typeahead if there's stuff there.
     if (@typeahead) {
 
@@ -6542,18 +6556,6 @@ sub readline {
     local $frame = 0;
     local $doret = -2;
 
-    # If there are stacked filehandles to read from ...
-    while (@cmdfhs) {
-
-        # Read from the last one in the stack.
-        my $line = CORE::readline( $cmdfhs[-1] );
-
-        # If we got a line ...
-        defined $line
-          ? ( print $OUT ">> $line" and return $line )    # Echo and return
-          : close pop @cmdfhs;                            # Pop and close
-    } ## end while (@cmdfhs)
-
     # Nothing on the filehandle stack. Socket?
     if ( ref $OUT and UNIVERSAL::isa( $OUT, 'IO::Socket::INET' ) ) {
 

diff --git a/lib/perl5db.t b/lib/perl5db.t
index a9d49d6..66cee89 100644 (file)
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(80);
+plan(81);
 
 my $rc_filename = '.perldb';
 
@@ -1931,8 +1931,33 @@ sub _calc_trace_wrapper
         #msx,
         'Test the source command (along with l)',
     );
+}
+
+# Test the 'source' command being traversed from withing typeahead.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'source ../lib/perl5db/t/source-cmd-test-no-q.perldb',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/disable-breakpoints-1',
+        }
+    );
 
-    print $wrapper->get_output(), "\n";
+    $wrapper->contents_like(qr#
+        ^3:\s+my\ \$dummy\ =\ 0;\n
+        4\s*\n
+        5:\s+\$x\ =\ "FirstVal";\n
+        6\s*\n
+        7:\s+\$dummy\+\+;\n
+        8\s*\n
+        9:\s+\$x\ =\ "SecondVal";\n
+        10\s*\n
+        #msx,
+        'Test the source command inside a typeahead',
+    );
 }
 
 END {

diff --git a/lib/perl5db/t/source-cmd-test-no-q.perldb b/lib/perl5db/t/source-cmd-test-no-q.perldb
new file mode 100644 (file)
index 0000000..6a6fddd
--- /dev/null
+++ b/lib/perl5db/t/source-cmd-test-no-q.perldb
@@ -0,0 +1 @@
+l 3-10