In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/27bca3226281a592aed848b7e68ea50f27381dac?hp=0111a78fcc993bdfaa4b46112924c3a9751ecfa5>
- Log -----------------------------------------------------------------
commit 27bca3226281a592aed848b7e68ea50f27381dac
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Dec 22 14:03:49 2009 +0100
[perl #70748] threads panic in del_backref
This was caused by change 34210/41fae7a, which simply reveals a bug that
already existed.
A sub returned from a thread brings a lot of baggage with it, including
some globs. There is this comment near the top of Perl_sv_dup in the
if(param->flags & CLONEf_JOIN_IN) block that reads:
/** don't clone stashes if they already exist **/
Then later on, under case SVt_PVGV:
/* Don't call sv_add_backref here as it's going to be
created as part of the magic cloning of the symbol
table. */
So whatâs happening is that there is a glob with no back-reference in its
stash, which glob is sometimes freed after the stash, so it induces the
panic.
-----------------------------------------------------------------------
Summary of changes:
sv.c | 15 ++++++++++++++-
t/op/threads.t | 30 +++++++++++++++++++++++-------
2 files changed, 37 insertions(+), 8 deletions(-)
diff --git a/sv.c b/sv.c
index b5cb17f..fb82caf 100644
--- a/sv.c
+++ b/sv.c
@@ -11035,10 +11035,23 @@ Perl_sv_dup(pTHX_ const SV *const sstr, CLONE_PARAMS
*const param)
GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
/* Don't call sv_add_backref here as it's going to be
created as part of the magic cloning of the symbol
- table. */
+ table--unless this is during a join and the stash
+ is not actually being cloned. */
/* Danger Will Robinson - GvGP(dstr) isn't initialised
at the point of this comment. */
GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param);
+ if(param->flags & CLONEf_JOIN_IN) {
+ const HEK * const hvname
+ = HvNAME_HEK(GvSTASH(dstr));
+ if( hvname
+ && GvSTASH(dstr) == gv_stashpvn(
+ HEK_KEY(hvname), HEK_LEN(hvname), 0
+ )
+ )
+ Perl_sv_add_backref(
+ aTHX_ MUTABLE_SV(GvSTASH(dstr)), dstr
+ );
+ }
GvGP(dstr) = gp_dup(GvGP(sstr), param);
(void)GpREFCNT_inc(GvGP(dstr));
} else
diff --git a/t/op/threads.t b/t/op/threads.t
index 7985688..c834d07 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -16,7 +16,7 @@ BEGIN {
exit 0;
}
- plan(15);
+ plan(17);
}
use strict;
@@ -192,13 +192,11 @@ threads->new(sub {})->join;
pass("undefing a typeglob doesn't cause a crash during cloning");
-TODO: {
- no strict 'vars'; # Accessing $TODO from test.pl
- local $TODO = 'perl #70748';
-
# Test we don't get:
# panic: del_backref during global destruction.
-fresh_perl_is(<<'EOI', 'ok', { }, 'No del_backref panic');
+# when returning a non-closure sub from a thread and subsequently starting
+# a new thread.
+fresh_perl_is(<<'EOI', 'ok', { }, 'No del_backref panic [perl #70748]');
use threads;
sub foo { return (sub { }); }
my $bar = threads->create(\&foo)->join();
@@ -206,6 +204,24 @@ threads->create(sub { })->join();
print "ok";
EOI
-} # TODO
+# Another, more reliable test for the same del_backref bug:
+fresh_perl_like(
+ <<' EOJ', qr/ok/, {}, 'No del_backref panic [perl #70748] (2)'
+ use threads;
+ push @bar, threads->create(sub{sub{}})->join() for 1...10;
+ print "ok";
+ EOJ
+);
+
+# Simple closure-returning test: At least this case works (though it
+# leaks), and we don't want to break it.
+fresh_perl_like(<<'EOJ', qr/^foo\n/, {}, 'returning a closure');
+use threads;
+print create threads sub {
+ my $x = "foo\n";
+ sub{sub{$x}}
+}=>->join->()()
+ //"undef"
+EOJ
# EOF
--
Perl5 Master Repository
