In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/452466a503257b1012694b0d3a3cbf260e409d18?hp=e5860534bf7ec7cb8c8e4b6211178d1d1369e13d>
- Log ----------------------------------------------------------------- commit 452466a503257b1012694b0d3a3cbf260e409d18 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 3 12:37:24 2014 -0800 perldelta for the prev. commit based on https://rt.perl.org/Ticket/Display.html?id=40565#txn-1321149 M pod/perldelta.pod commit 83a94553cbf9f2c11b3e9a63a44e7b9ce17ccb77 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>. M ext/XS-APItest/t/clone-with-stack.t M sv.c ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/t/clone-with-stack.t | 25 ++++++++++++++++++++++++- pod/perldelta.pod | 5 ++++- sv.c | 10 +++++++--- 3 files changed, 35 insertions(+), 5 deletions(-) diff --git a/ext/XS-APItest/t/clone-with-stack.t b/ext/XS-APItest/t/clone-with-stack.t index 3f68c93..179fba0 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(5); +plan(6); fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" ); use XS::APItest; @@ -78,3 +78,26 @@ f(); ==== } + +{ + 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/pod/perldelta.pod b/pod/perldelta.pod index 234e750..1fbca0d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -357,7 +357,10 @@ files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>. =item * -XXX +On Win32, restoring in a child pseudo-process a variable that was +C<local()>ed in a parent pseudo-process before the C<fork> happened caused +memory corruption and a crash in the child pseudo-process (and therefore OS +process). =item * diff --git a/sv.c b/sv.c index 04b8fa8..8637025 100644 --- a/sv.c +++ b/sv.c @@ -13980,14 +13980,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)); /* FALLTHROUGH */ 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; /* FALLTHROUGH */ case SAVEt_FREESV: case SAVEt_MORTALIZESV: @@ -14010,6 +14012,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; @@ -14162,7 +14166,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
