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