Fix "a [command]" statement.

Without a line number. See:

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

3 files changed, 52 insertions, 5 deletions

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 7cfbf3520c..944bb10ebf 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -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 ) {
diff --git a/lib/perl5db.t b/lib/perl5db.t
index ec50e74596..4f3fa536e1 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -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
index 0000000000..a1782a0034
--- /dev/null
+++ b/lib/perl5db/t/test-a-statement-1
@@ -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.
+