diff options
| -rw-r--r-- | sv.c | 15 | ||||
| -rw-r--r-- | t/op/threads.t | 30 |
2 files changed, 37 insertions, 8 deletions
@@ -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 7985688e5c..c834d07524 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 |