Fix "a [command]" statement.
authorShlomi Fish <shlomif@shlomifish.org>
Wed, 3 Oct 2012 12:28:28 +0000 (14:28 +0200)
committerRicardo Signes <rjbs@cpan.org>
Mon, 12 Nov 2012 14:18:34 +0000 (09:18 -0500)
Without a line number. See:

https://rt.perl.org/rt3/Ticket/Display.html?id=115110 .

MANIFEST
lib/perl5db.pl
lib/perl5db.t
lib/perl5db/t/test-a-statement-1 [new file with mode: 0644]

index 3851de9..9192713 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4336,6 +4336,7 @@ 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
+lib/perl5db/t/test-a-statement-1       Tests for the Perl debugger
 lib/perl5db/t/test-dieLevel-option-1   Tests for the Perl debugger
 lib/perl5db/t/test-frame-option-1      Tests for the Perl debugger
 lib/perl5db/t/test-l-statement-1       Tests for the Perl debugger
index 7cfbf35..944bb10 100644 (file)
@@ -4150,11 +4150,14 @@ sub cmd_a {
     my $dbline = shift;
 
     # If it's dot (here), or not all digits,  use the current line.
-    $line =~ s/^(\.|(?:[^\d]))/$dbline/;
+    $line =~ s/\A\./$dbline/;
 
     # Should be a line number followed by an expression.
-    if ( $line =~ /^\s*(\d*)\s*(\S.+)/ ) {
-        my ( $lineno, $expr ) = ( $1, $2 );
+    if ( my ($lineno, $expr) = $line =~ /^\s*(\d*)\s*(\S.+)/ ) {
+
+        if (! length($lineno)) {
+            $lineno = $dbline;
+        }
 
         # If we have an expression ...
         if ( length $expr ) {
index ec50e74..4f3fa53 100644 (file)
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(105);
+plan(106);
 
 my $rc_filename = '.perldb';
 
@@ -1400,7 +1400,7 @@ sub _calc_trace_wrapper
     );
 }
 
-# Test the a command.
+# Test the 'a' command.
 {
     my $wrapper = DebugWrap->new(
         {
@@ -1423,6 +1423,28 @@ sub _calc_trace_wrapper
     );
 }
 
+# Test the 'a' command with no line number.
+{
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'n',
+                q/a print "Hello " . (3 * 4) . "\n";/,
+                'c',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/test-a-statement-1',
+        }
+    );
+
+    $wrapper->output_like(qr#
+        (?:^Hello\ 12\n.*?){4}
+        #msx,
+        "a command with no line number is working",
+    );
+}
+
 # Test the 'A' command
 {
     my $wrapper = DebugWrap->new(
diff --git a/lib/perl5db/t/test-a-statement-1 b/lib/perl5db/t/test-a-statement-1
new file mode 100644 (file)
index 0000000..a1782a0
--- /dev/null
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+while (my $l = <DATA>) {
+    chomp $l;
+    print "$l\n";
+}
+
+__DATA__
+123456789012 This is a test
+3456789012345This is another test
+6789012345678This is yet another test
+9012345678901Is this yet another test?
+234567890123 Yes, this is another test.
+4567890123456I think this is a test.
+7890123456789Now is the time.
+0123456789012For all good men.
+3456789012345To come to the aid party.
+678901234678 This is the tenth line.
+