3f1b01
From b248789b64d6bd277c52bfe608ed3192023af1bd Mon Sep 17 00:00:00 2001
3f1b01
From: "E. Choroba" <choroba@matfyz.cz>
3f1b01
Date: Fri, 26 Jun 2020 21:19:24 +0200
3f1b01
Subject: [PATCH] After running an action in the debugger, turn it off
3f1b01
MIME-Version: 1.0
3f1b01
Content-Type: text/plain; charset=UTF-8
3f1b01
Content-Transfer-Encoding: 8bit
3f1b01
3f1b01
When running with "c", there was no problem, but when running with "n"
3f1b01
or "s", once the action was executed, it kept executing on the
3f1b01
following lines, which wasn't expected. Clearing $action here prevents
3f1b01
this unwanted behaviour.
3f1b01
3f1b01
Signed-off-by: Petr Písař <ppisar@redhat.com>
3f1b01
---
3f1b01
 lib/perl5db.pl                   |  3 ++-
3f1b01
 lib/perl5db.t                    | 22 ++++++++++++++++++++++
3f1b01
 lib/perl5db/t/test-a-statement-3 |  6 ++++++
3f1b01
 3 files changed, 30 insertions(+), 1 deletion(-)
3f1b01
 create mode 100644 lib/perl5db/t/test-a-statement-3
3f1b01
3f1b01
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
3f1b01
index 69a9bb6e64..e04a0e17fa 100644
3f1b01
--- a/lib/perl5db.pl
3f1b01
+++ b/lib/perl5db.pl
3f1b01
@@ -529,7 +529,7 @@ BEGIN {
3f1b01
 use vars qw($VERSION $header);
3f1b01
 
3f1b01
 # bump to X.XX in blead, only use X.XX_XX in maint
3f1b01
-$VERSION = '1.57';
3f1b01
+$VERSION = '1.58';
3f1b01
 
3f1b01
 $header = "perl5db.pl version $VERSION";
3f1b01
 
3f1b01
@@ -2708,6 +2708,7 @@ If there are any preprompt actions, execute those as well.
3f1b01
         # The &-call is here to ascertain the mutability of @_.
3f1b01
         &DB::eval;
3f1b01
     }
3f1b01
+    undef $action;
3f1b01
 
3f1b01
     # Are we nested another level (e.g., did we evaluate a function
3f1b01
     # that had a breakpoint in it at the debugger prompt)?
3f1b01
diff --git a/lib/perl5db.t b/lib/perl5db.t
3f1b01
index 421229a54a..913a301d98 100644
3f1b01
--- a/lib/perl5db.t
3f1b01
+++ b/lib/perl5db.t
3f1b01
@@ -2799,6 +2799,28 @@ SKIP:
3f1b01
     );
3f1b01
 }
3f1b01
 
3f1b01
+{
3f1b01
+    # GitHub #17901
3f1b01
+    my $wrapper = DebugWrap->new(
3f1b01
+        {
3f1b01
+            cmds =>
3f1b01
+            [
3f1b01
+                'a 4 $s++',
3f1b01
+                ('s') x 5,
3f1b01
+                'x $s',
3f1b01
+                'q'
3f1b01
+            ],
3f1b01
+            prog => '../lib/perl5db/t/test-a-statement-3',
3f1b01
+            switches => [ '-d' ],
3f1b01
+            stderr => 0,
3f1b01
+        }
3f1b01
+    );
3f1b01
+    $wrapper->contents_like(
3f1b01
+        qr/^0 +2$/m,
3f1b01
+        'Test that the a command runs only on the given lines.',
3f1b01
+    );
3f1b01
+}
3f1b01
+
3f1b01
 {
3f1b01
     # perl 5 RT #126735 regression bug.
3f1b01
     local $ENV{PERLDB_OPTS} = "NonStop=0 RemotePort=non-existent-host.tld:9001";
3f1b01
diff --git a/lib/perl5db/t/test-a-statement-3 b/lib/perl5db/t/test-a-statement-3
3f1b01
new file mode 100644
3f1b01
index 0000000000..b188c1c5c5
3f1b01
--- /dev/null
3f1b01
+++ b/lib/perl5db/t/test-a-statement-3
3f1b01
@@ -0,0 +1,6 @@
3f1b01
+use strict; use warnings;
3f1b01
+
3f1b01
+for my $x (1 .. 2) {
3f1b01
+    my $y = $x + 1;
3f1b01
+    my $x = $x - 1;
3f1b01
+}
3f1b01
-- 
3f1b01
2.25.4
3f1b01