From bf3e41ff5d42bd65e92e06ce1b1b8f24064a178a Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 28 Feb 2019 11:53:19 +1100
Subject: [PATCH] (perl #124203) fix a similar problem with DB::lsub

---
 MANIFEST                 |  1 +
 lib/perl5db.pl           | 49 ++++++++++++++++++++++++------------------------
 lib/perl5db.t            | 15 +++++++++++++++
 lib/perl5db/t/rt-124203b | 13 +++++++++++++
 4 files changed, 54 insertions(+), 24 deletions(-)
 create mode 100644 lib/perl5db/t/rt-124203b

diff --git a/MANIFEST b/MANIFEST
index 09eaa75..4cf40a8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4654,6 +4654,7 @@ lib/perl5db/t/rt-104168		Tests for the Perl debugger
 lib/perl5db/t/rt-120174		Tests for the Perl debugger
 lib/perl5db/t/rt-121509-restart-after-chdir		Tests for the Perl debugger
 lib/perl5db/t/rt-124203		Test threads in the Perl debugger
+lib/perl5db/t/rt-124203b	Test threads in the Perl debugger
 lib/perl5db/t/rt-61222		Tests for the Perl debugger
 lib/perl5db/t/rt-66110		Tests for the Perl debugger
 lib/perl5db/t/source-cmd-test.perldb		Tests for the Perl debugger
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index be2367c..e8a29da 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -4281,25 +4281,6 @@ sub DB::sub {
 
 sub lsub : lvalue {
 
-    no strict 'refs';
-
-    # lock ourselves under threads
-    lock($DBGR);
-
-    # Whether or not the autoloader was running, a scalar to put the
-    # sub's return value in (if needed), and an array to put the sub's
-    # return value in (if needed).
-    my ( $al, $ret, @ret ) = "";
-    if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
-        print "creating new thread\n";
-    }
-
-    # If the last ten characters are C'::AUTOLOAD', note we've traced
-    # into AUTOLOAD for $sub.
-    if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
-        $al = " for $$sub";
-    }
-
     # We stack the stack pointer and then increment it to protect us
     # from a situation that might unwind a whole bunch of call frames
     # at once. Localizing the stack pointer means that it will automatically
@@ -4317,12 +4298,32 @@ sub lsub : lvalue {
     # stack for us.
     local $single = $single & 1;
 
-    # If we've gotten really deeply recursed, turn on the flag that will
-    # make us stop with the 'deep recursion' message.
-    $single |= 4 if $stack_depth == $deep;
+    no strict 'refs';
+    {
+        # lock ourselves under threads
+        lock($DBGR);
+
+        # Whether or not the autoloader was running, a scalar to put the
+        # sub's return value in (if needed), and an array to put the sub's
+        # return value in (if needed).
+        my ( $al, $ret, @ret ) = "";
+        if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
+            print "creating new thread\n";
+        }
+
+        # If the last ten characters are C'::AUTOLOAD', note we've traced
+        # into AUTOLOAD for $sub.
+        if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+            $al = " for $$sub";
+        }
 
-    # If frame messages are on ...
-    _print_frame_message($al);
+        # If we've gotten really deeply recursed, turn on the flag that will
+        # make us stop with the 'deep recursion' message.
+        $single |= 4 if $stack_depth == $deep;
+
+        # If frame messages are on ...
+        _print_frame_message($al);
+    }
 
     # call the original lvalue sub.
     &$sub;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index cbfe077..450f4d0 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -2917,6 +2917,21 @@ SKIP:
     $wrapper->output_like(qr/In the thread/, "[perl #124203] the thread ran");
 
     $wrapper->output_like(qr/Finished/, "[perl #124203] debugger didn't deadlock");
+
+    $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'c',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/rt-124203b',
+        }
+    );
+
+    $wrapper->output_like(qr/In the thread/, "[perl #124203] the thread ran (lvalue)");
+
+    $wrapper->output_like(qr/Finished One/, "[perl #124203] debugger didn't deadlock (lvalue)");
 }
 
 done_testing();
diff --git a/lib/perl5db/t/rt-124203b b/lib/perl5db/t/rt-124203b
new file mode 100644
index 0000000..a599621
--- /dev/null
+++ b/lib/perl5db/t/rt-124203b
@@ -0,0 +1,13 @@
+use threads;
+print "PID $$\n";
+my $x;
+sub sub1 {
+  print("In the thread\n");
+}
+sub foo:lvalue {
+  my $thr = threads->create(\&sub1);
+  $thr->join;
+  $x;
+}
+foo() = "One";
+print "Finished $x\n";
-- 
1.8.3.1