debugging threaded perl hangs with perl-5.20.2 #14626
Comments
From @mblancheSince switching to perl v >5.18, I'have been having lots of issue with the debugger. Debugging a simple program like use threads; Using perl -dt hangs for ever, only way is to kill the terminal. I am currently running with perl 5.20.2 using Mac OS X 10.10.2. I think this is a bug, if not, help would be aprreciated Marco $ perl -V Characteristics of this binary (from libperl): |
From @mblancheOn Sat Mar 28 12:08:05 2015, marcoblanchette@icloud.com wrote:
Sorry, pasted the wrong output of perl -V (testing different config of perl using perlbrew...) here is the current multi-thread I used $ perl -V Characteristics of this binary (from libperl): |
From [Unknown Contact. See original ticket]On Sat Mar 28 12:08:05 2015, marcoblanchette@icloud.com wrote:
Sorry, pasted the wrong output of perl -V (testing different config of perl using perlbrew...) here is the current multi-thread I used $ perl -V Characteristics of this binary (from libperl): |
From @jkeenanOn Sat Mar 28 12:12:59 2015, marcoblanchette@icloud.com wrote:
This sounds a lot like https://rt-archive.perl.org/perl5/Ticket/Display.html?id=124127 -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @khwilliamsonOn 03/28/2015 08:00 PM, James E Keenan via RT wrote:
And since that ticket has a patch, the requester here could apply it and |
From vega.james@gmail.comOn Sat, Mar 28, 2015 at 07:00:16PM -0700, James E Keenan via RT wrote:
Well, the fact that "perl -dt" hangs has existed for a long time. I've It was just made more apparent by "perl -d" not working with threaded Cheers, |
From @mblancheThank you guys, patch from https://rt-archive.perl.org/perl5/Ticket/Display.html?id=124127 worked for me. Now, perl -d work fine and entering a thread does not hang the process. Is this patch expected to make it to a stable release soon? |
From @mblancheOn Sun Mar 29 09:16:39 2015, marcoblanchette@icloud.com wrote:
I talked to fast. The patches fix the perl -d to complain but introduces a weird behavior in my environment, using 'n' in the debugger does not step to the next step but roll over the full script, it acts like 'c'... |
From [Unknown Contact. See original ticket]On Sun Mar 29 09:16:39 2015, marcoblanchette@icloud.com wrote:
I talked to fast. The patches fix the perl -d to complain but introduces a weird behavior in my environment, using 'n' in the debugger does not step to the next step but roll over the full script, it acts like 'c'... |
From vega.james@gmail.comOn Sun, Mar 29, 2015 at 09:42:18AM -0700, Marco Blanchette via RT wrote:
I've sent an updated patch to #124127. Thanks for the feedback! Cheers, |
From @tonycozCreated by @tonycozperl blocks in pthread_cond_wait() when attemptting to debug a simple #!/usr/bin/perl sub foo my $thr = threads->create(\&foo); $thr->join(); exit; When run: tony@mars:.../git/perl$ PERL5DB_THREADED=1 ./perl -Ilib -d ../123127.pl Loading DB routines from perl5db.pl version 1.48 Enter h or 'h h' for help, or 'man perldebug' for more help. main::(../123127.pl:12): my $thr = threads->create(\&foo); Backtrace from an attached gdb: (gdb) bt Found while working on #124127. Perl Info |
From @tonycozOn Tue Apr 14 17:31:32 2015, tonyc wrote:
-dt is implemented as setting PERL5DB_THREADED=1 so this is the same as Note that the problem still occurred with both my AV fix and the dummy Tony |
From @tonycozOn Tue Apr 14 21:38:57 2015, tonyc wrote:
5.14.2 also locks up in the same place, this is an old issue. 5.8.9 locks up when cleaning up the old thread: #0 pthread_cond_wait@@GLIBC_2.3.2 () Tony |
From @tonycozOn Tue, 14 Apr 2015 23:26:52 -0700, tonyc wrote:
I tried bisecting this issue, and it found: commit 2cbb2ee Implement a new -dt command-line flag, to enable threads under the which is when the -dt switch and threads support in the debugger was added. The change from lock-up only during clean up vs lock up when starting the child thread was in: commit 9ca4d7f Race condition fix in threads.pm so unless there was a tool change (compiler, libc) that introduced this at some point, I don't see that it ever worked. Tony |
From @tonycozOn Mon, 25 Feb 2019 19:19:08 -0800, tonyc wrote:
Here's a fix for it. I won't repeat the commit message here. Tony |
From @tonycoz124203-db-sub-deadlock.patchFrom aecf6bfced0e94a750d0b64454a6472df33aee77 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Feb 2019 12:01:12 +1100
Subject: [PATCH 1/4] add extra lock tracing to threads::shared
This was useful in tracing the cause for the deadlock in #124203.
This can be enabled during a build of perl by adding:
-Accflags=-DSHARED_TRACE_LOCKS -DDEBUGGING
to the Configure command-line.
To see the trace at run-time add -DU or -DUv to the perl command-line.
The original DEBUG_LOCKS tracing using warn caused extra calls
confusing back traces when trying to debug this problem.
---
dist/threads-shared/shared.xs | 39 +++++++++++++++++++++++++++++++++++++++
1 file changed, 39 insertions(+)
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index d0f7d1e070..6cdf094d27 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -115,6 +115,17 @@
* without the prefix (e.g., sv, tmp or obj).
*/
+/* this is lower overhead than warn() and less likely to interfere
+ with other parts of perl (like with the debugger.)
+*/
+#ifdef SHARED_TRACE_LOCKS
+# define TRACE_LOCK(x) DEBUG_U(x)
+# define TRACE_LOCKv(x) DEBUG_Uv(x)
+#else
+# define TRACE_LOCK(x)
+# define TRACE_LOCKv(x)
+#endif
+
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
@@ -211,8 +222,24 @@ recursive_lock_release(pTHX_ recursive_lock_t *lock)
if (--lock->locks == 0) {
lock->owner = NULL;
COND_SIGNAL(&lock->cond);
+ TRACE_LOCK(
+ PerlIO_printf(Perl_debug_log, "shared lock released %p for %p at %s:%d\n",
+ lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
+ }
+ else {
+ TRACE_LOCKv(
+ PerlIO_printf(Perl_debug_log, "shared lock unbump %p for %p at %s:%d\n",
+ lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
}
}
+ else {
+ TRACE_LOCK(
+ PerlIO_printf(Perl_debug_log, "bad shared lock release %p for %p (owned by %p) at %s:%d\n",
+ lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
+ }
MUTEX_UNLOCK(&lock->mutex);
}
@@ -224,8 +251,16 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
assert(aTHX);
MUTEX_LOCK(&lock->mutex);
if (lock->owner == aTHX) {
+ TRACE_LOCKv(
+ PerlIO_printf(Perl_debug_log, "shared lock bump %p (%p) at %s:%d\n",
+ lock, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
lock->locks++;
} else {
+ TRACE_LOCK(
+ PerlIO_printf(Perl_debug_log, "shared lock try %p for %p (owned by %p) at %s:%d\n",
+ lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
while (lock->owner) {
#ifdef DEBUG_LOCKS
Perl_warn(aTHX_ " %p waiting - owned by %p %s:%d\n",
@@ -233,6 +268,10 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
#endif
COND_WAIT(&lock->cond,&lock->mutex);
}
+ TRACE_LOCK(
+ PerlIO_printf(Perl_debug_log, "shared lock got %p at %s:%d\n",
+ lock, CopFILE(PL_curcop), CopLINE(PL_curcop))
+ );
lock->locks = 1;
lock->owner = aTHX;
#ifdef DEBUG_LOCKS
--
2.11.0
From 1b1bd389060a079dcfa37e9b4ad6a417fee261a9 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Feb 2019 12:01:40 +1100
Subject: [PATCH 2/4] (perl #124203) avoid a deadlock in DB::sub
I don't know how this ever worked.
Previously, DB::sub() would hold a lock on $DB::DBGR for it's entire
body, including the call to the subroutine being called.
This could cause problems in two cases:
a) on creation of a new thread, CLONE() is called in the context of
the new interpreter before the new thread is created. So you'd have a
sequence like:
threads->new
DB::sub for threads::new (lock $DBGR)
call into threads::new which creates a new interpreter
Cwd::CLONE() (in the new interpreter)
DB::sub for Cwd::CLONE (in the new interpreter) (deadlock trying to lock $DBGR)
One workaround I tried for this was to prevent pp_entersub calling
DB::sub if we were cloning (by checking PL_ptr_table). This did
improve matters, but wasn't needed in the final patch.
Note that the recursive lock on $DBGR would have been fine if the new
code was executing in the same interpreter, since the locking code
simply bumps a reference count if the current interpreter already
holds the lock.
b) when the called subroutine blocks. For the test case this could
happen with the call to $thr->join. There would be a sequence like:
(parent) $thr->join
(parent) DB::sub for threads::join (lock $DBGR)
(parent) call threads::join and block
(child) try to call main::sub1
(child) DB::sub for main::sub1 (deadlock trying to lock $DBGR)
This isn't limited to threads::join obviously, one thread could be
waiting for input, sleeping, or performing a complex calculation.
The solution I chose here was the obvious one - don't hold the lock
for the actual call.
This required some rearrangement of the code and removed some
duplication too.
---
MANIFEST | 1 +
lib/perl5db.pl | 205 ++++++++++++++++++++++++------------------------
lib/perl5db.t | 24 +++++-
lib/perl5db/t/rt-124203 | 7 ++
4 files changed, 131 insertions(+), 106 deletions(-)
create mode 100644 lib/perl5db/t/rt-124203
diff --git a/MANIFEST b/MANIFEST
index 1bc8bc54f6..18b6c97153 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4653,6 +4653,7 @@ lib/perl5db/t/proxy-constants Tests for the Perl debugger
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-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 39f76f35fe..745b1173dc 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -4144,23 +4144,7 @@ sub _print_frame_message {
}
sub DB::sub {
- # 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 eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
- print "creating new thread\n";
- }
-
- # If the last ten characters are '::AUTOLOAD', note we've traced
- # into AUTOLOAD for $sub.
- if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
- no strict 'refs';
- $al = " for $$sub" if defined $$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
@@ -4168,40 +4152,49 @@ sub DB::sub {
# unwind the same amount when multiple stack frames are unwound.
local $stack_depth = $stack_depth + 1; # Protect from non-local exits
- # Expand @stack.
- $#stack = $stack_depth;
+ {
+ # lock ourselves under threads
+ # While lock() permits recursive locks, there's two cases where it's bad
+ # that we keep a hold on the lock while we call the sub:
+ # - during cloning, Package::CLONE might be called in the context of the new
+ # thread, which will deadlock if we hold the lock across the threads::new call
+ # - for any function that waits any significant time
+ # This also deadlocks if the parent thread joins(), since holding the lock
+ # will prevent any child threads passing this point.
+ # So release the lock for the function call.
+ lock($DBGR);
- # Save current single-step setting.
- $stack[-1] = $single;
+ # 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).
+ if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
+ print "creating new thread\n";
+ }
- # Turn off all flags except single-stepping.
- $single &= 1;
+ # If the last ten characters are '::AUTOLOAD', note we've traced
+ # into AUTOLOAD for $sub.
+ if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+ no strict 'refs';
+ $al = " for $$sub" if defined $$sub;
+ }
- # 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;
+ # Expand @stack.
+ $#stack = $stack_depth;
- # If frame messages are on ...
+ # Save current single-step setting.
+ $stack[-1] = $single;
- _print_frame_message($al);
- # standard frame entry message
+ # Turn off all flags except single-stepping.
+ $single &= 1;
- my $print_exit_msg = sub {
- # Check for exit trace messages...
- if ($frame & 2)
- {
- if ($frame & 4) # Extended exit message
- {
- _indent_print_line_info(0, "out ");
- print_trace( $LINEINFO, 0, 1, 1, "$sub$al" );
- }
- else
- {
- _indent_print_line_info(0, "exited $sub$al\n" );
- }
- }
- return;
- };
+ # 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);
+ }
# Determine the sub's return type, and capture appropriately.
if (wantarray) {
@@ -4209,77 +4202,81 @@ sub DB::sub {
# Called in array context. call sub and capture output.
# DB::DB will recursively get control again if appropriate; we'll come
# back here when the sub is finished.
- {
- no strict 'refs';
- @ret = &$sub;
- }
+ no strict 'refs';
+ @ret = &$sub;
+ }
+ elsif ( defined wantarray ) {
+ no strict 'refs';
+ # Save the value if it's wanted at all.
+ $ret = &$sub;
+ }
+ else {
+ no strict 'refs';
+ # Void return, explicitly.
+ &$sub;
+ undef $ret;
+ }
+
+ {
+ lock($DBGR);
# Pop the single-step value back off the stack.
$single |= $stack[ $stack_depth-- ];
- $print_exit_msg->();
+ if ($frame & 2) {
+ if ($frame & 4) { # Extended exit message
+ _indent_print_line_info(0, "out ");
+ print_trace( $LINEINFO, -1, 1, 1, "$sub$al" );
+ }
+ else {
+ _indent_print_line_info(0, "exited $sub$al\n" );
+ }
+ }
- # Print the return info if we need to.
- if ( $doret eq $stack_depth or $frame & 16 ) {
+ if (wantarray) {
+ # Print the return info if we need to.
+ if ( $doret eq $stack_depth or $frame & 16 ) {
- # Turn off output record separator.
- local $\ = '';
- my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+ # Turn off output record separator.
+ local $\ = '';
+ my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
- # Indent if we're printing because of $frame tracing.
- if ($frame & 16)
- {
- print {$fh} ' ' x $stack_depth;
- }
+ # Indent if we're printing because of $frame tracing.
+ if ($frame & 16)
+ {
+ print {$fh} ' ' x $stack_depth;
+ }
- # Print the return value.
- print {$fh} "list context return from $sub:\n";
- dumpit( $fh, \@ret );
+ # Print the return value.
+ print {$fh} "list context return from $sub:\n";
+ dumpit( $fh, \@ret );
- # And don't print it again.
- $doret = -2;
- } ## end if ($doret eq $stack_depth...
+ # And don't print it again.
+ $doret = -2;
+ } ## end if ($doret eq $stack_depth...
# And we have to return the return value now.
- @ret;
- } ## end if (wantarray)
-
- # Scalar context.
- else {
- if ( defined wantarray ) {
- no strict 'refs';
- # Save the value if it's wanted at all.
- $ret = &$sub;
- }
+ @ret;
+ } ## end if (wantarray)
+ # Scalar context.
else {
- no strict 'refs';
- # Void return, explicitly.
- &$sub;
- undef $ret;
- }
-
- # Pop the single-step value off the stack.
- $single |= $stack[ $stack_depth-- ];
-
- # If we're doing exit messages...
- $print_exit_msg->();
-
- # If we are supposed to show the return value... same as before.
- if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {
- local $\ = '';
- my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
- print $fh ( ' ' x $stack_depth ) if $frame & 16;
- print $fh (
- defined wantarray
- ? "scalar context return from $sub: "
- : "void context return from $sub\n"
- );
- dumpit( $fh, $ret ) if defined wantarray;
- $doret = -2;
- } ## end if ($doret eq $stack_depth...
-
- # Return the appropriate scalar value.
- $ret;
- } ## end else [ if (wantarray)
+ # If we are supposed to show the return value... same as before.
+ if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {
+ local $\ = '';
+ my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+ print $fh ( ' ' x $stack_depth ) if $frame & 16;
+ print $fh (
+ defined wantarray
+ ? "scalar context return from $sub: "
+ : "void context return from $sub\n"
+ );
+ dumpit( $fh, $ret ) if defined wantarray;
+ $doret = -2;
+ } ## end if ($doret eq $stack_depth...
+
+ # Return the appropriate scalar value.
+ $ret;
+ } ## end else [ if (wantarray)
+ }
} ## end sub _sub
sub lsub : lvalue {
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 3d432ad52e..cbfe07777b 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -31,8 +31,6 @@ BEGIN {
$ENV{PERL_RL} = 'Perl'; # Suppress system Term::ReadLine::Gnu
}
-plan(127);
-
my $rc_filename = '.perldb';
sub rc {
@@ -2901,6 +2899,28 @@ SKIP:
);
}
+SKIP:
+{
+ $Config{usethreads}
+ or skip "need threads to test debugging threads", 1;
+ my $wrapper = DebugWrap->new(
+ {
+ cmds =>
+ [
+ 'c',
+ 'q',
+ ],
+ prog => '../lib/perl5db/t/rt-124203',
+ }
+ );
+
+ $wrapper->output_like(qr/In the thread/, "[perl #124203] the thread ran");
+
+ $wrapper->output_like(qr/Finished/, "[perl #124203] debugger didn't deadlock");
+}
+
+done_testing();
+
END {
1 while unlink ($rc_filename, $out_fn);
}
diff --git a/lib/perl5db/t/rt-124203 b/lib/perl5db/t/rt-124203
new file mode 100644
index 0000000000..85ab7b0b27
--- /dev/null
+++ b/lib/perl5db/t/rt-124203
@@ -0,0 +1,7 @@
+use threads;
+my $thr = threads->create(\&sub1);
+sub sub1 {
+ print("In the thread\n");
+}
+$thr->join;
+print "Finished\n";
\ No newline at end of file
--
2.11.0
From 7e65dbc1023ce2834deaf1ce3202ca23997cc622 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Feb 2019 15:28:37 +1100
Subject: [PATCH 3/4] bump $threads::shared::VERSION to 1.60
---
dist/threads-shared/lib/threads/shared.pm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm
index f7e5ff8e73..45ad154979 100644
--- a/dist/threads-shared/lib/threads/shared.pm
+++ b/dist/threads-shared/lib/threads/shared.pm
@@ -8,7 +8,7 @@ use Config;
use Scalar::Util qw(reftype refaddr blessed);
-our $VERSION = '1.59'; # Please update the pod, too.
+our $VERSION = '1.60'; # Please update the pod, too.
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -196,7 +196,7 @@ threads::shared - Perl extension for sharing data structures between threads
=head1 VERSION
-This document describes threads::shared version 1.59
+This document describes threads::shared version 1.60
=head1 SYNOPSIS
--
2.11.0
From 0799b90d290ea3ea0d601e3cd6b6a724319bc5c1 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Feb 2019 15:29:23 +1100
Subject: [PATCH 4/4] bump $DB::VERSION for perl5db.pl to 1.55
---
lib/perl5db.pl | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 745b1173dc..be2367cde7 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -529,7 +529,7 @@ BEGIN {
use vars qw($VERSION $header);
# bump to X.XX in blead, only use X.XX_XX in maint
-$VERSION = '1.54';
+$VERSION = '1.55';
$header = "perl5db.pl version $VERSION";
--
2.11.0
|
From @tonycozOn Tue, 26 Feb 2019 20:51:31 -0800, tonyc wrote:
DB::lsub had the same problem. Fix attached. Tony |
From @tonycoz0001-perl-124203-fix-a-similar-problem-with-DB-lsub.patchFrom dcb4031b9cdafbb9856f0b1cd72ef58f087cb94d Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 28 Feb 2019 11:53:19 +1100
Subject: (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 18b6c97153..268dfcfebd 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 be2367cde7..e8a29da134 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 cbfe07777b..450f4d067b 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 0000000000..a599621566
--- /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";
--
2.11.0
|
From @tonycozOn Tue, 26 Feb 2019 20:51:31 -0800, tonyc wrote:
These were applied as d22170b through bf3e41f, including the DB::lsub fix. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.30.0, this and 160 other issues have been Perl 5.30.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#124203 (status was 'resolved')
Searchable as RT124203$
The text was updated successfully, but these errors were encountered: