diff options
| -rw-r--r-- | dist/threads-shared/shared.xs | 24 | ||||
| -rw-r--r-- | dist/threads-shared/t/object2.t | 43 |
2 files changed, 64 insertions, 3 deletions
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs index 8e41139b02..162a3d7028 100644 --- a/dist/threads-shared/shared.xs +++ b/dist/threads-shared/shared.xs @@ -1371,9 +1371,29 @@ void STORESIZE(SV *obj,IV count) CODE: dTHXc; - SV *sobj = SHAREDSV_FROM_OBJ(obj); + SV *ssv = SHAREDSV_FROM_OBJ(obj); + SHARED_EDIT; - av_fill((AV*) sobj, count - 1); + assert(SvTYPE(ssv) == SVt_PVAV); + if (!PL_dirty) { + SV **svp = AvARRAY((AV *)ssv); + I32 ix = AvFILLp((AV *)ssv); + for (;ix >= count; ix--) { + SV *sv = svp[ix]; + if (!sv) + continue; + if ( (SvOBJECT(sv) || (SvROK(sv) && (sv = SvRV(sv)))) + && SvREFCNT(sv) == 1 ) + { + SV *tmp = Perl_sv_newmortal(caller_perl); + PERL_SET_CONTEXT((aTHX = caller_perl)); + sv_upgrade(tmp, SVt_RV); + get_RV(tmp, sv); + PERL_SET_CONTEXT((aTHX = PL_sharedsv_space)); + } + } + } + av_fill((AV*) ssv, count - 1); SHARED_RELEASE; diff --git a/dist/threads-shared/t/object2.t b/dist/threads-shared/t/object2.t index f59bad8d27..3d795b9208 100644 --- a/dist/threads-shared/t/object2.t +++ b/dist/threads-shared/t/object2.t @@ -17,7 +17,7 @@ use ExtUtils::testlib; BEGIN { $| = 1; - print("1..122\n"); ### Number of tests that will be run ### + print("1..131\n"); ### Number of tests that will be run ### }; use threads; @@ -406,4 +406,45 @@ ok($destroyed[$ID], 'Scalar object removed from undef shared hash'); } ok($destroyed[$ID], 'Scalar object removed from shared scalar'); +# +# RT #122950 abandoning array elements (e.g. by setting $#ary) +# should trigger destructors + +{ + package rt122950; + + my $count = 0; + sub DESTROY { $count++ } + + my $n = 4; + + for my $type (0..1) { + my @a : shared; + $count = 0; + push @a, bless &threads::shared::share({}) for 1..$n; + for (1..$n) { + { # new scope to ensure tmps are freed, destructors called + if ($type) { + pop @a; + } + else { + $#a = $n - $_ - 1; + } + } + ::ok($count == $_, + "remove array object $_ by " . ($type ? "pop" : '$#a=N')); + } + } + + my @a : shared; + $count = 0; + push @a, bless &threads::shared::share({}) for 1..$n; + { + undef @a; # this is implemented internally as $#a = -01 + } + ::ok($count == $n, "remove array object by undef"); +} + + + # EOF |