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 (file)
--- 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 (file)
--- 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