Don't clone the contents of lexicals in pads.

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. :-(

2 files changed, 63 insertions, 2 deletions

diff --git a/pad.c b/pad.c
index 207f475afd..cc2ade250e 100644
--- 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]) {
diff --git a/t/op/threads.t b/t/op/threads.t
index 95f5776bd3..8fa602528b 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -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