Clone state subs in anon subs

Since state variables are not shared between closures, but only
between invocations of the same closure, state subs should behave
the same way.

This was a little tricky.  When we clone a sub, we now clone inner
state subs at the same time.  When walking through the pad, cloning
items, we cannot simply clone the inner sub when we see it, because it
may close over things we haven’t cloned yet:

    sub {
        state sub foo;
        my $x
        sub foo { $x }
    }

We can’t just delay cloning it and do it afterwards, because they may
be multiple subs closing over each other:

    sub {
       state sub foo;
       state sub bar;
       sub foo { \&bar }
       sub bar { \&foo }
    }

So *all* the entries in the new pad must be filled before any inner
subs can be cloned.

So what we do is put a stub in place of the cloned sub.   And then
in a second pass clone the inner subs, reusing the stubs from the
first pass.

1 files changed, 38 insertions, 13 deletions

diff --git a/pad.c b/pad.c
index 3bd44b292e..e7252ff691 100644
--- a/pad.c
+++ b/pad.c
@@ -1112,7 +1112,7 @@ the parent pad.
 #define CvCOMPILED(cv)	CvROOT(cv)
 
 /* the CV does late binding of its lexicals */
-#define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
+#define CvLATE(cv) (CvANON(cv) || CvCLONE(cv) || SvTYPE(cv) == SVt_PVFM)
 
 
 STATIC PADOFFSET
@@ -1934,8 +1934,8 @@ the immediately surrounding code.
 =cut
 */
 
-CV *
-Perl_cv_clone(pTHX_ CV *proto)
+static CV *
+S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
 {
     dVAR;
     I32 ix;
@@ -1946,12 +1946,9 @@ Perl_cv_clone(pTHX_ CV *proto)
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    CV* cv;
     SV** outpad;
-    CV* outside;
     long depth;
-
-    PERL_ARGS_ASSERT_CV_CLONE;
+    bool subclones = FALSE;
 
     assert(!CvUNIQUE(proto));
 
@@ -1963,9 +1960,10 @@ Perl_cv_clone(pTHX_ CV *proto)
      * to a prototype; we instead want the cloned parent who called us.
      */
 
-    if (SvTYPE(proto) == SVt_PVCV)
+    if (!outside) {
+      if (SvTYPE(proto) == SVt_PVCV)
 	outside = find_runcv(NULL);
-    else {
+      else {
 	outside = CvOUTSIDE(proto);
 	if ((CvCLONE(outside) && ! CvCLONED(outside))
 	    || !CvPADLIST(outside)
@@ -1975,9 +1973,10 @@ Perl_cv_clone(pTHX_ CV *proto)
 	    );
 	    /* outside could be null */
 	}
+      }
     }
     depth = outside ? CvDEPTH(outside) : 0;
-    assert(depth || SvTYPE(proto) == SVt_PVFM);
+    assert(depth || cv || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
 	depth = 1;
     assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside));
@@ -1985,7 +1984,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     ENTER;
     SAVESPTR(PL_compcv);
 
-    cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
+    if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
+    PL_compcv = cv;
     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
 				    |CVf_SLABBED);
     CvCLONED_on(cv);
@@ -2045,7 +2045,16 @@ Perl_cv_clone(pTHX_ CV *proto)
 	    if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
-		    sv = SvREFCNT_inc(ppad[ix]);
+		    /* If there are state subs, we need to clone them, too.
+		       But they may need to close over variables we have
+		       not cloned yet.  So we will have to do a second
+		       pass.  Furthermore, there may be state subs clos-
+		       ing over other state subs’ entries, so we have
+		       to put a stub here and then clone into it on the
+		       second pass. */
+		    sv = SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])
+			? (subclones = 1, newSV_type(SVt_PVCV))
+			: SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
 		    sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
@@ -2054,7 +2063,7 @@ Perl_cv_clone(pTHX_ CV *proto)
 		    sv = newSV(0);
 		SvPADMY_on(sv);
 		/* reset the 'assign only once' flag on each state var */
-		if (SvPAD_STATE(namesv))
+		if (sigil != '&' && SvPAD_STATE(namesv))
 		    SvPADSTALE_on(sv);
 	    }
 	}
@@ -2068,6 +2077,14 @@ Perl_cv_clone(pTHX_ CV *proto)
 	PL_curpad[ix] = sv;
     }
 
+    if (subclones)
+	for (ix = fpad; ix > 0; ix--) {
+	    SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+	    if (namesv && namesv != &PL_sv_undef && !SvFAKE(namesv)
+	     && SvPVX_const(namesv)[0] == '&' && SvPAD_STATE(namesv))
+		S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv);
+	}
+
     DEBUG_Xv(
 	PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
 	if (outside) cv_dump(outside, "Outside");
@@ -2099,6 +2116,14 @@ Perl_cv_clone(pTHX_ CV *proto)
     return cv;
 }
 
+CV *
+Perl_cv_clone(pTHX_ CV *proto)
+{
+    PERL_ARGS_ASSERT_CV_CLONE;
+
+    return S_cv_clone(aTHX_ proto, NULL, NULL);
+}
+
 /*
 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv