Blob Blame History Raw
From 6d5f50cb786feea968d70ffc8e88b062d7ef0ff6 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 26 Jun 2020 21:19:24 +0200
Subject: [PATCH] After running an action in the debugger, turn it off
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When running with "c", there was no problem, but when running with "n"
or "s", once the action was executed, it kept executing on the
following lines, which wasn't expected. Clearing $action here prevents
this unwanted behaviour.

Petr Písař: Ported to 5.30.3 from
b248789b64d6bd277c52bfe608ed3192023af1bd.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 lib/perl5db.pl                   |  1 +
 lib/perl5db.t                    | 22 ++++++++++++++++++++++
 lib/perl5db/t/test-a-statement-3 |  6 ++++++
 3 files changed, 29 insertions(+)
 create mode 100644 lib/perl5db/t/test-a-statement-3

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e8a29da..04d3183 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2708,6 +2708,7 @@ If there are any preprompt actions, execute those as well.
         # The &-call is here to ascertain the mutability of @_.
         &DB::eval;
     }
+    undef $action;
 
     # Are we nested another level (e.g., did we evaluate a function
     # that had a breakpoint in it at the debugger prompt)?
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 450f4d0..2753d4d 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2799,6 +2799,28 @@ SKIP:
     );
 }
 
+{
+    # GitHub #17901
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'a 4 $s++',
+                ('s') x 5,
+                'x $s',
+                'q'
+            ],
+            prog => '../lib/perl5db/t/test-a-statement-3',
+            switches => [ '-d' ],
+            stderr => 0,
+        }
+    );
+    $wrapper->contents_like(
+        qr/^0 +2$/m,
+        'Test that the a command runs only on the given lines.',
+    );
+}
+
 {
     # perl 5 RT #126735 regression bug.
     local $ENV{PERLDB_OPTS} = "NonStop=0 RemotePort=non-existent-host.tld:9001";
diff --git a/lib/perl5db/t/test-a-statement-3 b/lib/perl5db/t/test-a-statement-3
new file mode 100644
index 0000000..b188c1c
--- /dev/null
+++ b/lib/perl5db/t/test-a-statement-3
@@ -0,0 +1,6 @@
+use strict; use warnings;
+
+for my $x (1 .. 2) {
+    my $y = $x + 1;
+    my $x = $x - 1;
+}
-- 
2.25.4