summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorShlomi Fish <shlomif@shlomifish.org>2012-06-30 16:40:43 +0300
committerFather Chrysostomos <sprout@cpan.org>2012-06-30 09:57:04 -0700
commit5578394101efd4d95c058c4f22f51763ae92ebc2 (patch)
tree36aaabba4310363a5261828a52dba544de205d2a /lib
parentb81e0e290a7c5a7e7343a6f4a9baf7b6ac93475e (diff)
downloadperl-5578394101efd4d95c058c4f22f51763ae92ebc2.tar.gz
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.
Diffstat (limited to 'lib')
-rw-r--r--lib/perl5db.pl14
-rw-r--r--lib/perl5db.t54
-rw-r--r--lib/perl5db/t/test-l-statement-18
-rw-r--r--lib/perl5db/t/test-r-statement27
4 files changed, 95 insertions, 8 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 4b4ab36bbd..f07467fc9d 100644
--- 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 7cca75c59f..b6936b26b0 100644
--- 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
index 0000000000..c3cf5b080e
--- /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
index 0000000000..f8c7bf5555
--- /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";
+