[perl.git] branch maint-5.20, updated. v5.20.1-51-gb8dda64

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 <sprout@cpan.org>
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

• [perl.git] branch maint-5.20, updated. v5.20.1-51-gb8dda64 by Tony Cook