Fix perl -d’s "l" command.

The "l" command (without any arguments) got broken in blead, due to the
"use strict" patch because "$max = ..." was changed into "my $max = ..."
while $max should always be a global.

diff --git a/MANIFEST b/MANIFEST
index 6f0e95e..079f5bb 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4292,6 +4292,8 @@ 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/test-l-statement-1       Tests for the Perl debugger
+lib/perl5db/t/test-r-statement Tests for the Perl debugger
 lib/perl5db/t/uncalled-subroutine      Tests for the Perl debugger
 lib/perl5db/t/with-subroutine          Tests for the Perl debugger
 lib/PerlIO.pm                  PerlIO support module

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 4b4ab36..f07467f 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -523,7 +523,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.39_01';
+$VERSION = '1.39_02';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -1801,7 +1801,7 @@ sub DB {
     local (*dbline) = $main::{ '_<' . $filename };
 
     # Last line in the program.
-    my $max = $#dbline;
+    $max = $#dbline;
 
     # if we have something here, see if we should break.
     if ( $dbline{$line}
@@ -4057,7 +4057,7 @@ sub delete_action {
         print $OUT "Deleting all actions...\n";
         for my $file ( keys %had_breakpoints ) {
             local *dbline = $main::{ '_<' . $file };
-            my $max = $#dbline;
+            $max = $#dbline;
             my $was;
             for ( $i = 1 ; $i <= $max ; $i++ ) {
                 if ( defined $dbline{$i} ) {
@@ -4688,7 +4688,7 @@ sub delete_breakpoint {
             # Switch to the desired file temporarily.
             local *dbline = $main::{ '_<' . $file };
 
-            my $max = $#dbline;
+            $max = $#dbline;
             my $was;
 
             # For all lines in this file ...
@@ -5127,7 +5127,7 @@ sub cmd_L {
             local *dbline = $main::{ '_<' . $file };
 
             # Set up to look through the whole file.
-            my $max = $#dbline;
+            $max = $#dbline;
             my $was;    # Flag: did we print something
                         # in this file?
 
@@ -5500,7 +5500,7 @@ sub postponed_sub {
             $had_breakpoints{$file} |= 1;
 
             # Last line in file.
-            my $max = $#dbline;
+            $max = $#dbline;
 
             # Search forward until we hit a breakable line or get to
             # the end of the file.
@@ -9373,7 +9373,7 @@ sub cmd_pre580_D {
             # Switch to the desired file temporarily.
             local *dbline = $main::{ '_<' . $file };
 
-            my $max = $#dbline;
+            $max = $#dbline;
             my $was;
 
             # For all lines in this file ...

diff --git a/lib/perl5db.t b/lib/perl5db.t
index 7cca75c..b6936b2 100644 (file)
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(32);
+plan(34);
 
 my $rc_filename = '.perldb';
 
@@ -850,6 +850,58 @@ package main;
     );
 }
 
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'b 14',
+                'c',
+                '$flag = 1;',
+                'r',
+                'print "Var=$var\n";',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-r-statement',
+        }
+    );
+
+    $wrapper->output_like(
+        qr/
+            ^Foo$
+                .*?
+            ^Bar$
+                .*?
+            ^Var=Test$
+        /msx,
+        'r statement is working properly.',
+    );
+}
+
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'l',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-l-statement-1',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/
+            ^1==>\s+\$x\ =\ 1;\n
+            2:\s+print\ "1\\n";\n
+            3\s*\n
+            4:\s+\$x\ =\ 2;\n
+            5:\s+print\ "2\\n";\n
+        /msx,
+        'l statement is working properly (test No. 1).',
+    );
+}
+
 END {
     1 while unlink ($rc_filename, $out_fn);
 }

diff --git a/lib/perl5db/t/test-l-statement-1 b/lib/perl5db/t/test-l-statement-1
new file mode 100644 (file)
index 0000000..c3cf5b0
--- /dev/null
+++ b/lib/perl5db/t/test-l-statement-1
@@ -0,0 +1,8 @@
+$x = 1;
+print "1\n";
+
+$x = 2;
+print "2\n";
+
+$x = 3;
+print "3\n";

diff --git a/lib/perl5db/t/test-r-statement b/lib/perl5db/t/test-r-statement
new file mode 100644 (file)
index 0000000..f8c7bf5
--- /dev/null
+++ b/lib/perl5db/t/test-r-statement
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $var = "Test";
+
+sub mysub
+{
+    my $flag = 1;
+
+    $flag = 0;
+
+    print "Foo\n";
+
+    if ($flag)
+    {
+        print "Bar\n";
+    }
+
+    return;
+}
+
+mysub();
+
+$var .= "More";
+