From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 26 Feb 2010 09:18:44 +0000 (+0000)
Subject: Set PADSTALE on all lexicals at the end of sub creation.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=adf8f095c5881bce;p=p5sagit%2Fp5-mst-13.2.git

Set PADSTALE on all lexicals at the end of sub creation.

The PADSTALEness of lexicals between the 0th and 1st call to a subroutine is now
consistent with the state between the nth and (n + 1)th call.

This permits a work around in Perl_padlist_dup() to avoid leaking active pad
data into a new thread, whilst still correctly bodging the external references
needed by the current ?{} implementation. Fix that, and this can be removed.
---

diff --git a/pad.c b/pad.c
index cc2ade2..8015154 100644
--- a/pad.c
+++ b/pad.c
@@ -1305,12 +1305,32 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     }
 
     if (type == padtidy_SUB || type == padtidy_FORMAT) {
+	SV * const * const namep = AvARRAY(PL_comppad_name);
 	PADOFFSET ix;
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
-	    if (!SvPADMY(PL_curpad[ix]))
+	    if (!SvPADMY(PL_curpad[ix])) {
 		SvPADTMP_on(PL_curpad[ix]);
+	    } else if (!SvFAKE(namep[ix])) {
+		/* This is a work around for how the current implementation of
+		   ?{ } blocks in regexps interacts with lexicals.
+
+		   One of our lexicals.
+		   Can't do this on all lexicals, otherwise sub baz() won't
+		   compile in
+
+		   my $foo;
+
+		   sub bar { ++$foo; }
+
+		   sub baz { ++$foo; }
+
+		   because completion of compiling &bar calling pad_tidy()
+		   would cause (top level) $foo to be marked as stale, and
+		   "no longer available".  */
+		SvPADSTALE_on(PL_curpad[ix]);
+	    }
 	}
     }
     PL_curpad = AvARRAY(PL_comppad);
@@ -1816,7 +1836,10 @@ Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
 			    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
 			}
 		    else {		/* our own lexical */
-			if(SvREFCNT(oldpad[ix]) > 1) {
+			if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) {
+			    /* This is a work around for how the current
+			       implementation of ?{ } blocks in regexps
+			       interacts with lexicals.  */
 			    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
 			} else {
 			    SV *sv; 
diff --git a/t/op/threads.t b/t/op/threads.t
index 8fa6025..d8bab5b 100644
--- a/t/op/threads.t
+++ b/t/op/threads.t
@@ -16,7 +16,7 @@ BEGIN {
        exit 0;
      }
 
-     plan(21);
+     plan(22);
 }
 
 use strict;
@@ -274,4 +274,22 @@ EOI
     curr_test(curr_test() + 1);
 }
 
+{
+    my $got;
+    sub more_stuff {
+	my $a;
+	$::b = \$a;
+	if (@_) {
+	    $a = "More leakage";
+	    threads->create(\&more_stuff)->join();
+	} else {
+	    is ($a, undef, 'Just special casing lexicals in ?{ ... }');
+	}
+    }
+
+    more_stuff(1);
+
+    curr_test(curr_test() + 1);
+}
+
 # EOF