In perl.git, the branch maint-5.20 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b8dda64c466687e73edc5b3090172f7e30752992?hp=26dc6d091d4df225b3dab6efcf9a74763189622e>
- Log ----------------------------------------------------------------- commit b8dda64c466687e73edc5b3090172f7e30752992 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 3 10:30:06 2014 -0800 [perl #40565] Fix localisation in pseudo-fork Several SAVEt_* types were giving the SVs the wrong reference counts in ss_dup, causing child process to lose SVs too soon. See <https://rt.perl.org/Ticket/Display.html?id=40565#txn-1180404> and <https://rt.perl.org/Ticket/Display.html?id=40565#txn-1277127>. ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/t/clone-with-stack.t | 25 ++++++++++++++++++++++++- sv.c | 10 +++++++--- 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/ext/XS-APItest/t/clone-with-stack.t b/ext/XS-APItest/t/clone-with-stack.t index 7a0cd29..3238e9f 100644 --- a/ext/XS-APItest/t/clone-with-stack.t +++ b/ext/XS-APItest/t/clone-with-stack.t @@ -17,7 +17,7 @@ if (not $Config{'useithreads'}) { skip_all("clone_with_stack requires threads"); } -plan(4); +plan(5); fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" ); use XS::APItest; @@ -65,3 +65,26 @@ X-Y-0:1:2:3:4-Z ==== } + +{ + fresh_perl_is( <<'----', <<'====', undef, "with localised stuff" ); +use XS::APItest; +$s = "outer"; +$a[0] = "anterior"; +$h{k} = "hale"; +{ + local $s = "inner"; + local $a[0] = 'posterior'; + local $h{k} = "halt"; + clone_with_stack(); +} +print "scl: $s\n"; +print "ary: $a[0]\n"; +print "hsh: $h{k}\n"; +---- +scl: outer +ary: anterior +hsh: hale +==== + +} diff --git a/sv.c b/sv.c index a4773f7..49d8f11 100644 --- a/sv.c +++ b/sv.c @@ -13093,14 +13093,16 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) case SAVEt_CLEARPADRANGE: break; case SAVEt_HELEM: /* hash element */ + case SAVEt_SV: /* scalar reference */ sv = (const SV *)POPPTR(ss,ix); - TOPPTR(nss,ix) = sv_dup_inc(sv, param); + TOPPTR(nss,ix) = SvREFCNT_inc(sv_dup_inc(sv, param)); /* fall through */ case SAVEt_ITEM: /* normal string */ case SAVEt_GVSV: /* scalar slot in GV */ - case SAVEt_SV: /* scalar reference */ sv = (const SV *)POPPTR(ss,ix); TOPPTR(nss,ix) = sv_dup_inc(sv, param); + if (type == SAVEt_SV) + break; /* fall through */ case SAVEt_FREESV: case SAVEt_MORTALIZESV: @@ -13118,6 +13120,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) case SAVEt_SVREF: /* scalar reference */ sv = (const SV *)POPPTR(ss,ix); TOPPTR(nss,ix) = sv_dup_inc(sv, param); + if (type == SAVEt_SVREF) + SvREFCNT_inc_simple_void((SV *)TOPPTR(nss,ix)); ptr = POPPTR(ss,ix); TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */ break; @@ -13270,7 +13274,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) break; case SAVEt_AELEM: /* array element */ sv = (const SV *)POPPTR(ss,ix); - TOPPTR(nss,ix) = sv_dup_inc(sv, param); + TOPPTR(nss,ix) = SvREFCNT_inc(sv_dup_inc(sv, param)); i = POPINT(ss,ix); TOPINT(nss,ix) = i; av = (const AV *)POPPTR(ss,ix); -- Perl5 Master Repository
