Don't clone the contents of lexicals in pads.
authorNicholas Clark <nick@ccl4.org>
Thu, 25 Feb 2010 21:35:39 +0000 (21:35 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 24 May 2010 14:50:57 +0000 (15:50 +0100)
This stops the values of lexicals in active stack frames in the parent leaking
into the lexicals in the child thread.

With an exception for lexicals with a reference count of > 1, to cope with the
implementation of ?{{ ... }} blocks in regexps. :-(

pad.c
t/op/threads.t

diff --git a/pad.c b/pad.c
index 207f475..cc2ade2 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1772,6 +1772,7 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
 
        I32 ix = AvFILLp((const AV *)AvARRAY(srcpad)[1]);
        AV *pad1;
+       const I32 names_fill = AvFILLp((const AV *)(AvARRAY(srcpad)[0]));
        const AV *const srcpad1 = (const AV *) AvARRAY(srcpad)[1];
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
@@ -1803,7 +1804,50 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
            AvFILLp(pad1) = ix;
 
            for ( ;ix > 0; ix--) {
-               pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+               if (!oldpad[ix]) {
+                   pad1a[ix] = NULL;
+               } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+                   const char sigil = SvPVX_const(names[ix])[0];
+                   if ((SvFLAGS(names[ix]) & SVf_FAKE)
+                       || (SvFLAGS(names[ix]) & SVpad_STATE)
+                       || sigil == '&')
+                       {
+                           /* outer lexical or anon code */
+                           pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+                       }
+                   else {              /* our own lexical */
+                       if(SvREFCNT(oldpad[ix]) > 1) {
+                           pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+                       } else {
+                           SV *sv; 
+                           
+                           if (sigil == '@')
+                               sv = MUTABLE_SV(newAV());
+                           else if (sigil == '%')
+                               sv = MUTABLE_SV(newHV());
+                           else
+                               sv = newSV(0);
+                           pad1a[ix] = sv;
+                           SvPADMY_on(sv);
+                       }
+                   }
+               }
+               else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+                   pad1a[ix] = sv_dup_inc(oldpad[ix], param);
+               }
+               else {
+                   /* save temporaries on recursion? */
+                   SV * const sv = newSV(0);
+                   pad1a[ix] = sv;
+
+                   /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs
+                      FIXTHAT before merging this branch.
+                      (And I know how to) */
+                   if (SvPADMY(oldpad[ix]))
+                       SvPADMY_on(sv);
+                   else
+                       SvPADTMP_on(sv);
+               }
            }
 
            if (oldpad[0]) {
index 95f5776..8fa6025 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
        exit 0;
      }
 
-     plan(20);
+     plan(21);
 }
 
 use strict;
@@ -257,4 +257,21 @@ fresh_perl_is(<<'EOI', 'ok', { }, '0 refcnt neither on tmps stack nor in @_');
     print 'ok';
 EOI
 
+{
+    my $got;
+    sub stuff {
+       my $a;
+       if (@_) {
+           $a = "Leakage";
+           threads->create(\&stuff)->join();
+       } else {
+           is ($a, undef, 'RT #73086 - clone used to clone active pads');
+       }
+    }
+
+    stuff(1);
+
+    curr_test(curr_test() + 1);
+}
+
 # EOF