This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Don’t leak the /(?[])/ parsing stack on error
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 057af94..70519e4 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -29,40 +29,40 @@
 
 =for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
 
 
 =for apidoc Amx|PADLIST *|CvPADLIST|CV *cv
 
-CV's can have CvPADLIST(cv) set to point to an AV.  This is the CV's
+CV's can have CvPADLIST(cv) set to point to a PADLIST.  This is the CV's
 scratchpad, which stores lexical variables and opcode temporary and
 per-thread values.
 
 scratchpad, which stores lexical variables and opcode temporary and
 per-thread values.
 
-For these purposes "forms" are a kind-of CV, eval""s are too (except they're
+For these purposes "formats" are a kind-of CV; eval""s are too (except they're
 not callable at will and are always thrown away after the eval"" is done
 not callable at will and are always thrown away after the eval"" is done
-executing). Require'd files are simply evals without any outer lexical
+executing).  Require'd files are simply evals without any outer lexical
 scope.
 
 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
 but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
 scope.
 
 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
 but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
-The CvPADLIST AV has the REFCNT of its component items managed "manually"
-(mostly in pad.c) rather than by normal av.c rules.  So we turn off AvREAL
-just before freeing it, to let av.c know not to touch the entries.
-The items in the AV are not SVs as for a normal AV, but other AVs:
+The PADLIST has a C array where pads are stored.
 
 
-0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
-the "static type information" for lexicals.
+The 0th entry of the PADLIST is a PADNAMELIST (which is actually just an
+AV, but that may change) which represents the "names" or rather
+the "static type information" for lexicals.  The individual elements of a
+PADNAMELIST are PADNAMEs (just SVs; but, again, that may change).  Future
+refactorings might stop the PADNAMELIST from being stored in the PADLIST's
+array, so don't rely on it.  See L</PadlistNAMES>.
 
 
-The CvDEPTH'th entry of CvPADLIST AV is an AV which is the stack frame at that
-depth of recursion into the CV.
-The 0'th slot of a frame AV is an AV which is @_.
-other entries are storage for variables and op targets.
+The CvDEPTH'th entry of a PADLIST is a PAD (an AV) which is the stack frame
+at that depth of recursion into the CV.  The 0th slot of a frame AV is an
+AV which is @_.  Other entries are storage for variables and op targets.
 
 
-Iterating over the names AV iterates over all possible pad
-items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
+Iterating over the PADNAMELIST iterates over all possible pad
+items.  Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
 &PL_sv_undef "names" (see pad_alloc()).
 
 &PL_sv_undef "names" (see pad_alloc()).
 
-Only my/our variable (SVs_PADMY/SVs_PADOUR) slots get valid names.
+Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
 or resolved at compile time.  These don't have names by which they
 The rest are op targets/GVs/constants which are statically allocated
 or resolved at compile time.  These don't have names by which they
-can be looked up from Perl code at run time through eval"" like
+can be looked up from Perl code at run time through eval"" the way
 my/our variables can be.  Since they can't be looked up by "name"
 but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 my/our variables can be.  Since they can't be looked up by "name"
 but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
@@ -85,7 +85,8 @@ SvOURSTASH slot pointing at the stash of the associated global (so that
 duplicate C<our> declarations in the same package can be detected).  SvUVX is
 sometimes hijacked to store the generation number during compilation.
 
 duplicate C<our> declarations in the same package can be detected).  SvUVX is
 sometimes hijacked to store the generation number during compilation.
 
-If SvFAKE is set on the name SV, then that slot in the frame AV is
+If PADNAME_OUTER (SvFAKE) is set on the
+name SV, then that slot in the frame AV is
 a REFCNT'ed reference to a lexical from "outside". In this case,
 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
 in scope throughout. Instead xhigh stores some flags containing info about
 a REFCNT'ed reference to a lexical from "outside". In this case,
 the name SV does not use xlow and xhigh to store a cop_seq range, since it is
 in scope throughout. Instead xhigh stores some flags containing info about
@@ -94,28 +95,30 @@ instantiated multiple times?), and for fake ANONs, xlow contains the index
 within the parent's pad where the lexical's value is stored, to make
 cloning quicker.
 
 within the parent's pad where the lexical's value is stored, to make
 cloning quicker.
 
-If the 'name' is '&' the corresponding entry in frame AV
+If the 'name' is '&' the corresponding entry in the PAD
 is a CV representing a possible closure.
 is a CV representing a possible closure.
-(SvFAKE and name of '&' is not a meaningful combination currently but could
+(PADNAME_OUTER and name of '&' is not a
+meaningful combination currently but could
 become so if C<my sub foo {}> is implemented.)
 
 Note that formats are treated as anon subs, and are cloned each time
 write is called (if necessary).
 
 The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
 become so if C<my sub foo {}> is implemented.)
 
 Note that formats are treated as anon subs, and are cloned each time
 write is called (if necessary).
 
 The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
-and set on scope exit. This allows the 'Variable $x is not available' warning
+and set on scope exit.  This allows the
+'Variable $x is not available' warning
 to be generated in evals, such as 
 
     { my $x = 1; sub f { eval '$x'} } f();
 
 to be generated in evals, such as 
 
     { my $x = 1; sub f { eval '$x'} } f();
 
-For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
+For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'.
 
 
-=for apidoc AmxU|AV *|PL_comppad_name
+=for apidoc AmxU|PADNAMELIST *|PL_comppad_name
 
 During compilation, this points to the array containing the names part
 of the pad for the currently-compiling code.
 
 
 During compilation, this points to the array containing the names part
 of the pad for the currently-compiling code.
 
-=for apidoc AmxU|AV *|PL_comppad
+=for apidoc AmxU|PAD *|PL_comppad
 
 During compilation, this points to the array containing the values
 part of the pad for the currently-compiling code.  (At runtime a CV may
 
 During compilation, this points to the array containing the values
 part of the pad for the currently-compiling code.  (At runtime a CV may
@@ -126,7 +129,7 @@ values for the pad for the currently-executing code.
 =for apidoc AmxU|SV **|PL_curpad
 
 Points directly to the body of the L</PL_comppad> array.
 =for apidoc AmxU|SV **|PL_curpad
 
 Points directly to the body of the L</PL_comppad> array.
-(I.e., this is C<AvARRAY(PL_comppad)>.)
+(I.e., this is C<PAD_ARRAY(PL_comppad)>.)
 
 =cut
 */
 
 =cut
 */
@@ -193,7 +196,7 @@ sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U3
                   sv_recode_to_utf8(svrecode, PL_encoding);
                   pv1      = SvPV_const(svrecode, cur1);
              }
                   sv_recode_to_utf8(svrecode, PL_encoding);
                   pv1      = SvPV_const(svrecode, cur1);
              }
-              SvREFCNT_dec(svrecode);
+              SvREFCNT_dec_NN(svrecode);
         }
         if (flags & SVf_UTF8)
             return (bytes_cmp_utf8(
         }
         if (flags & SVf_UTF8)
             return (bytes_cmp_utf8(
@@ -244,8 +247,8 @@ Perl_pad_new(pTHX_ int flags)
 
     if (flags & padnew_SAVE) {
        SAVECOMPPAD();
 
     if (flags & padnew_SAVE) {
        SAVECOMPPAD();
-       SAVESPTR(PL_comppad_name);
        if (! (flags & padnew_CLONE)) {
        if (! (flags & padnew_CLONE)) {
+           SAVESPTR(PL_comppad_name);
            SAVEI32(PL_padix);
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
            SAVEI32(PL_padix);
            SAVEI32(PL_comppad_name_fill);
            SAVEI32(PL_min_intro_pending);
@@ -262,7 +265,6 @@ Perl_pad_new(pTHX_ int flags)
     /* ... create new pad ... */
 
     Newxz(padlist, 1, PADLIST);
     /* ... create new pad ... */
 
     Newxz(padlist, 1, PADLIST);
-    padname    = newAV();
     pad                = newAV();
 
     if (flags & padnew_CLONE) {
     pad                = newAV();
 
     if (flags & padnew_CLONE) {
@@ -274,9 +276,12 @@ Perl_pad_new(pTHX_ int flags)
         AV * const a0 = newAV();                       /* will be @_ */
        av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
         AV * const a0 = newAV();                       /* will be @_ */
        av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
+
+       padname = (PAD *)SvREFCNT_inc_simple_NN(PL_comppad_name);
     }
     else {
        av_store(pad, 0, NULL);
     }
     else {
        av_store(pad, 0, NULL);
+       padname = newAV();
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -284,18 +289,18 @@ Perl_pad_new(pTHX_ int flags)
        0..3, and even an explicit call to av_extend() with <3 will be rounded
        up, so we inline the allocation of the array here.  */
     Newx(ary, 2, PAD *);
        0..3, and even an explicit call to av_extend() with <3 will be rounded
        up, so we inline the allocation of the array here.  */
     Newx(ary, 2, PAD *);
-    PADLIST_MAX(padlist) = 1;
-    PADLIST_ARRAY(padlist) = ary;
+    PadlistMAX(padlist) = 1;
+    PadlistARRAY(padlist) = ary;
     ary[0] = padname;
     ary[1] = pad;
 
     /* ... then update state variables */
 
     ary[0] = padname;
     ary[1] = pad;
 
     /* ... then update state variables */
 
-    PL_comppad_name    = padname;
     PL_comppad         = pad;
     PL_curpad          = AvARRAY(pad);
 
     if (! (flags & padnew_CLONE)) {
     PL_comppad         = pad;
     PL_curpad          = AvARRAY(pad);
 
     if (! (flags & padnew_CLONE)) {
+       PL_comppad_name      = padname;
        PL_comppad_name_fill = 0;
        PL_min_intro_pending = 0;
        PL_padix             = 0;
        PL_comppad_name_fill = 0;
        PL_min_intro_pending = 0;
        PL_padix             = 0;
@@ -365,6 +370,8 @@ Perl_cv_undef(pTHX_ CV *cv)
        PAD_SAVE_SETNULLPAD();
 
        /* discard any leaked ops */
        PAD_SAVE_SETNULLPAD();
 
        /* discard any leaked ops */
+       if (PL_parser)
+           parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
        opslab_force_free((OPSLAB *)CvSTART(cv));
        CvSTART(cv) = NULL;
 
        opslab_force_free((OPSLAB *)CvSTART(cv));
        CvSTART(cv) = NULL;
 
@@ -375,7 +382,8 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
-    CvGV_set(cv, NULL);
+    if (CvNAMED(cv)) CvNAME_HEK_set(cv, NULL);
+    else            CvGV_set(cv, NULL);
 
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
 
     /* This statement and the subsequence if block was pad_undef().  */
     pad_peg("pad_undef");
@@ -403,9 +411,9 @@ Perl_cv_undef(pTHX_ CV *cv)
        if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
            CV * const outercv = CvOUTSIDE(cv);
            const U32 seq = CvOUTSIDE_SEQ(cv);
        if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
            CV * const outercv = CvOUTSIDE(cv);
            const U32 seq = CvOUTSIDE_SEQ(cv);
-           PAD * const comppad_name = PADLIST_ARRAY(padlist)[0];
+           PAD * const comppad_name = PadlistARRAY(padlist)[0];
            SV ** const namepad = AvARRAY(comppad_name);
            SV ** const namepad = AvARRAY(comppad_name);
-           PAD * const comppad = PADLIST_ARRAY(padlist)[1];
+           PAD * const comppad = PadlistARRAY(padlist)[1];
            SV ** const curpad = AvARRAY(comppad);
            for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
                SV * const namesv = namepad[ix];
            SV ** const curpad = AvARRAY(comppad);
            for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
                SV * const namesv = namepad[ix];
@@ -416,12 +424,10 @@ Perl_cv_undef(pTHX_ CV *cv)
                        U32 inner_rc = SvREFCNT(innercv);
                        assert(inner_rc);
                        assert(SvTYPE(innercv) != SVt_PVFM);
                        U32 inner_rc = SvREFCNT(innercv);
                        assert(inner_rc);
                        assert(SvTYPE(innercv) != SVt_PVFM);
-                       namepad[ix] = NULL;
-                       SvREFCNT_dec(namesv);
 
                        if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
                            curpad[ix] = NULL;
 
                        if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
                            curpad[ix] = NULL;
-                           SvREFCNT_dec(innercv);
+                           SvREFCNT_dec_NN(innercv);
                            inner_rc--;
                        }
 
                            inner_rc--;
                        }
 
@@ -443,24 +449,24 @@ Perl_cv_undef(pTHX_ CV *cv)
            }
        }
 
            }
        }
 
-       ix = PADLIST_MAX(padlist);
+       ix = PadlistMAX(padlist);
        while (ix > 0) {
        while (ix > 0) {
-           PAD * const sv = PADLIST_ARRAY(padlist)[ix--];
+           PAD * const sv = PadlistARRAY(padlist)[ix--];
            if (sv) {
                if (sv == PL_comppad) {
                    PL_comppad = NULL;
                    PL_curpad = NULL;
                }
            if (sv) {
                if (sv == PL_comppad) {
                    PL_comppad = NULL;
                    PL_curpad = NULL;
                }
-               SvREFCNT_dec(sv);
+               SvREFCNT_dec_NN(sv);
            }
        }
        {
            }
        }
        {
-           PAD * const sv = PADLIST_ARRAY(padlist)[0];
-           if (sv == PL_comppad_name)
+           PAD * const sv = PadlistARRAY(padlist)[0];
+           if (sv == PL_comppad_name && SvREFCNT(sv) == 1)
                PL_comppad_name = NULL;
            SvREFCNT_dec(sv);
        }
                PL_comppad_name = NULL;
            SvREFCNT_dec(sv);
        }
-       if (PADLIST_ARRAY(padlist)) Safefree(PADLIST_ARRAY(padlist));
+       if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
        Safefree(padlist);
        CvPADLIST(cv) = NULL;
     }
        Safefree(padlist);
        CvPADLIST(cv) = NULL;
     }
@@ -501,9 +507,7 @@ void
 Perl_cv_forget_slab(pTHX_ CV *cv)
 {
     const bool slabbed = !!CvSLABBED(cv);
 Perl_cv_forget_slab(pTHX_ CV *cv)
 {
     const bool slabbed = !!CvSLABBED(cv);
-#ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = NULL;
     OPSLAB *slab = NULL;
-#endif
 
     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
 
     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
@@ -511,25 +515,21 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
 
     CvSLABBED_off(cv);
 
 
     CvSLABBED_off(cv);
 
-#ifdef PERL_DEBUG_READONLY_OPS
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
-#else
-    if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
-    else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
-#endif
 #ifdef DEBUGGING
     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
 #endif
 
 #ifdef DEBUGGING
     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
 #endif
 
-#ifdef PERL_DEBUG_READONLY_OPS
     if (slab) {
     if (slab) {
-       size_t refcnt;
-       refcnt = slab->opslab_refcnt;
+#ifdef PERL_DEBUG_READONLY_OPS
+       const size_t refcnt = slab->opslab_refcnt;
+#endif
        OpslabREFCNT_dec(slab);
        OpslabREFCNT_dec(slab);
+#ifdef PERL_DEBUG_READONLY_OPS
        if (refcnt > 1) Slab_to_ro(slab);
        if (refcnt > 1) Slab_to_ro(slab);
-    }
 #endif
 #endif
+    }
 }
 
 /*
 }
 
 /*
@@ -627,8 +627,12 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
         flags &= ~padadd_UTF8_NAME;
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
         flags &= ~padadd_UTF8_NAME;
 
     if ((flags & padadd_NO_DUP_CHECK) == 0) {
+       ENTER;
+       SAVEFREESV(namesv); /* in case of fatal warnings */
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
        /* check for duplicate declaration */
        pad_check_dup(namesv, flags & padadd_OUR, ourstash);
+       SvREFCNT_inc_simple_void_NN(namesv);
+       LEAVE;
     }
 
     offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
     }
 
     offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
@@ -647,6 +651,8 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
     else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
        sv_upgrade(PL_curpad[offset], SVt_PVAV);
     else if (namelen != 0 && *namepv == '%')
        sv_upgrade(PL_curpad[offset], SVt_PVHV);
+    else if (namelen != 0 && *namepv == '&')
+       sv_upgrade(PL_curpad[offset], SVt_PVCV);
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
     assert(SvPADMY(PL_curpad[offset]));
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                           "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
@@ -824,7 +830,7 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
     if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
        assert(!CvWEAKOUTSIDE(func));
        CvWEAKOUTSIDE_on(func);
     if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
        assert(!CvWEAKOUTSIDE(func));
        CvWEAKOUTSIDE_on(func);
-       SvREFCNT_dec(CvOUTSIDE(func));
+       SvREFCNT_dec_NN(CvOUTSIDE(func));
     }
     return ix;
 }
     }
     return ix;
 }
@@ -876,9 +882,11 @@ S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
        {
            if (is_our && (SvPAD_OUR(sv)))
                break; /* "our" masking "our" */
+           /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
            Perl_warner(aTHX_ packWARN(WARN_MISC),
-               "\"%s\" variable %"SVf" masks earlier declaration in same %s",
+               "\"%s\" %s %"SVf" masks earlier declaration in same %s",
                (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
                (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
+               *SvPVX(sv) == '&' ? "subroutine" : "variable",
                sv,
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
                    ? "scope" : "statement"));
                sv,
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
                    ? "scope" : "statement"));
@@ -963,7 +971,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
      *    our $foo = 0 unless defined $foo;
      * to not give a warning. (Yes, this is a hack) */
 
      *    our $foo = 0 unless defined $foo;
      * to not give a warning. (Yes, this is a hack) */
 
-    nameav = PADLIST_ARRAY(CvPADLIST(PL_compcv))[0];
+    nameav = PadlistARRAY(CvPADLIST(PL_compcv))[0];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
         const SV * const namesv = name_svp[offset];
@@ -1080,7 +1088,7 @@ Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
        return DEFSV;
 
     if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
        return DEFSV;
 
-    return AvARRAY(PADLIST_ARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
+    return AvARRAY(PadlistARRAY(CvPADLIST(cv))[CvDEPTH(cv)])[po];
 }
 
 /*
 }
 
 /*
@@ -1111,8 +1119,19 @@ the parent pad.
 #define CvCOMPILED(cv) CvROOT(cv)
 
 /* the CV does late binding of its lexicals */
 #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 void
+S_unavailable(pTHX_ SV *namesv)
+{
+    /* diag_listed_as: Variable "%s" is not available */
+    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                       "%se \"%"SVf"\" is not available",
+                        *SvPVX_const(namesv) == '&'
+                                        ? "Subroutin"
+                                        : "Variabl",
+                        namesv);
+}
 
 STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
 
 STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
@@ -1143,7 +1162,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
-        const AV * const nameav = PADLIST_ARRAY(padlist)[0];
+        const AV * const nameav = PadlistARRAY(padlist)[0];
        SV * const * const name_svp = AvARRAY(nameav);
 
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
        SV * const * const name_svp = AvARRAY(nameav);
 
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
@@ -1235,8 +1254,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                    if (warn)
                        : *out_flags & PAD_FAKELEX_ANON)
                {
                    if (warn)
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1274,7 +1292,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        return offset;
                    }
 
                        return offset;
                    }
 
-                   *out_capture = AvARRAY(PADLIST_ARRAY(padlist)[
+                   *out_capture = AvARRAY(PadlistARRAY(padlist)[
                                    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                                    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
                    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
@@ -1284,8 +1302,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
                        && (!CvDEPTH(cv) || !staleok)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
-                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                      "Variable \"%"SVf"\" is not available",
+                       S_unavailable(aTHX_
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
                                        newSVpvn_flags(namepv, namelen,
                                            SVs_TEMP |
                                            (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
@@ -1297,6 +1314,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
                    else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
                        *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
                    else if (namelen != 0 && *namepv == '%')
                        *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
+                   else if (namelen != 0 && *namepv == '&')
+                       *out_capture = sv_2mortal(newSV_type(SVt_PVCV));
                    else
                        *out_capture = sv_newmortal();
                }
                    else
                        *out_capture = sv_newmortal();
                }
@@ -1338,8 +1357,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
        SV *new_namesv = newSVsv(*out_name_sv);
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
        SV *new_namesv = newSVsv(*out_name_sv);
        AV *  const ocomppad_name = PL_comppad_name;
        PAD * const ocomppad = PL_comppad;
-       PL_comppad_name = PADLIST_ARRAY(padlist)[0];
-       PL_comppad = PADLIST_ARRAY(padlist)[1];
+       PL_comppad_name = PadlistARRAY(padlist)[0];
+       PL_comppad = PadlistARRAY(padlist)[1];
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
        PL_curpad = AvARRAY(PL_comppad);
 
        new_offset
@@ -1369,6 +1388,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
        else {
            /* immediate creation - capture outer value right now */
            av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
        else {
            /* immediate creation - capture outer value right now */
            av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
+           /* But also note the offset, as newMYSUB needs it */
+           PARENT_PAD_INDEX_set(new_namesv, offset);
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
                PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
@@ -1530,11 +1551,12 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 =cut
 */
 
 =cut
 */
 
-void
+OP *
 Perl_pad_leavemy(pTHX)
 {
     dVAR;
     I32 off;
 Perl_pad_leavemy(pTHX)
 {
     dVAR;
     I32 off;
+    OP *o = NULL;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
@@ -1551,7 +1573,7 @@ Perl_pad_leavemy(pTHX)
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
-       const SV * const sv = svp[off];
+       SV * const sv = svp[off];
        if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
            && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
        {
        if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
            && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
        {
@@ -1562,6 +1584,12 @@ Perl_pad_leavemy(pTHX)
                (unsigned long)COP_SEQ_RANGE_LOW(sv),
                (unsigned long)COP_SEQ_RANGE_HIGH(sv))
            );
                (unsigned long)COP_SEQ_RANGE_LOW(sv),
                (unsigned long)COP_SEQ_RANGE_HIGH(sv))
            );
+           if (!PadnameIsSTATE(sv) && !PadnameIsOUR(sv)
+            && *PadnamePV(sv) == '&' && PadnameLEN(sv) > 1) {
+               OP *kid = newOP(OP_INTROCV, 0);
+               kid->op_targ = off;
+               o = op_prepend_elem(OP_LINESEQ, kid, o);
+           }
        }
     }
     PL_cop_seqmax++;
        }
     }
     PL_cop_seqmax++;
@@ -1569,6 +1597,7 @@ Perl_pad_leavemy(pTHX)
        PL_cop_seqmax++;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
        PL_cop_seqmax++;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
+    return o;
 }
 
 /*
 }
 
 /*
@@ -1646,7 +1675,7 @@ S_pad_reset(pTHX)
            )
     );
 
            )
     );
 
-    if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
+    if (!TAINTING_get) {       /* Can't mix tainted and non-tainted temporaries. */
         I32 po;
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
            if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
         I32 po;
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
            if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
@@ -1685,13 +1714,21 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
 
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
 
-    /* If this CV has had any 'eval-capable' ops planted in it
-     * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
-     * anon prototypes in the chain of CVs should be marked as cloneable,
-     * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
-     * the right CvOUTSIDE.
-     * If running with -d, *any* sub may potentially have an eval
-     * executed within it.
+    /* If this CV has had any 'eval-capable' ops planted in it:
+     * i.e. it contains any of:
+     *
+     *     * eval '...',
+     *     * //ee,
+     *     * use re 'eval'; /$var/
+     *     * /(?{..})/),
+     *
+     * Then any anon prototypes in the chain of CVs should be marked as
+     * cloneable, so that for example the eval's CV in
+     *
+     *    sub { eval '$x' }
+     *
+     * gets the right CvOUTSIDE.  If running with -d, *any* sub may
+     * potentially have an eval executed within it.
      */
 
     if (PL_cv_has_eval || PL_perldb) {
      */
 
     if (PL_cv_has_eval || PL_perldb) {
@@ -1703,8 +1740,8 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
                CvCLONE_on(cv);
                DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
                CvCLONE_on(cv);
-               CvHASEVAL_on(cv);
            }
            }
+           CvHASEVAL_on(cv);
        }
     }
 
        }
     }
 
@@ -1787,6 +1824,7 @@ void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
     dVAR;
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
     dVAR;
+    SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
@@ -1801,9 +1839,11 @@ Perl_pad_free(pTHX_ PADOFFSET po)
            PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
            PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
     );
 
-    if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
-       SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
-    }
+
+    sv = PL_curpad[po];
+    if (sv && sv != &PL_sv_undef && !SvPADMY(sv))
+       SvFLAGS(sv) &= ~SVs_PADTMP;
+
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -1831,8 +1871,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     if (!padlist) {
        return;
     }
     if (!padlist) {
        return;
     }
-    pad_name = *PADLIST_ARRAY(padlist);
-    pad = PADLIST_ARRAY(padlist)[1];
+    pad_name = *PadlistARRAY(padlist);
+    pad = PadlistARRAY(padlist)[1];
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
     Perl_dump_indent(aTHX_ level, file,
@@ -1933,89 +1973,77 @@ the immediately surrounding code.
 =cut
 */
 
 =cut
 */
 
-CV *
-Perl_cv_clone(pTHX_ CV *proto)
+static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
+
+static void
+S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 {
     dVAR;
     I32 ix;
     PADLIST* const protopadlist = CvPADLIST(proto);
 {
     dVAR;
     I32 ix;
     PADLIST* const protopadlist = CvPADLIST(proto);
-    const PAD *const protopad_name = *PADLIST_ARRAY(protopadlist);
-    const PAD *const protopad = PADLIST_ARRAY(protopadlist)[1];
+    PAD *const protopad_name = *PadlistARRAY(protopadlist);
+    const PAD *const protopad = PadlistARRAY(protopadlist)[1];
     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
     SV** const pname = AvARRAY(protopad_name);
     SV** const ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    CV* cv;
     SV** outpad;
     SV** outpad;
-    CV* outside;
     long depth;
     long depth;
-
-    PERL_ARGS_ASSERT_CV_CLONE;
+    bool subclones = FALSE;
 
     assert(!CvUNIQUE(proto));
 
     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
      * reliable.  The currently-running sub is always the one we need to
      * close over.
 
     assert(!CvUNIQUE(proto));
 
     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
      * reliable.  The currently-running sub is always the one we need to
      * close over.
+     * For my subs, the currently-running sub may not be the one we want.
+     * We have to check whether it is a clone of CvOUTSIDE.
      * Note that in general for formats, CvOUTSIDE != find_runcv.
      * Since formats may be nested inside closures, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
      */
 
      * Note that in general for formats, CvOUTSIDE != find_runcv.
      * Since formats may be nested inside closures, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
      */
 
-    if (SvTYPE(proto) == SVt_PVCV)
+    if (!outside) {
+      if (CvWEAKOUTSIDE(proto))
        outside = find_runcv(NULL);
        outside = find_runcv(NULL);
-    else {
+      else {
        outside = CvOUTSIDE(proto);
        outside = CvOUTSIDE(proto);
-       if (CvCLONE(outside) && ! CvCLONED(outside)) {
-           CV * const runcv = find_runcv_where(
-               FIND_RUNCV_root_eq, (void *)CvROOT(outside), NULL
+       if ((CvCLONE(outside) && ! CvCLONED(outside))
+           || !CvPADLIST(outside)
+           || PadlistNAMES(CvPADLIST(outside))
+                != protopadlist->xpadl_outid) {
+           outside = find_runcv_where(
+               FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL
            );
            );
-           if (runcv) outside = runcv;
+           /* outside could be null */
        }
        }
+      }
     }
     }
-    depth = CvDEPTH(outside);
-    assert(depth || SvTYPE(proto) == SVt_PVFM);
+    depth = outside ? CvDEPTH(outside) : 0;
     if (!depth)
        depth = 1;
     if (!depth)
        depth = 1;
-    assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM);
 
     ENTER;
     SAVESPTR(PL_compcv);
 
     ENTER;
     SAVESPTR(PL_compcv);
+    PL_compcv = cv;
+    if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */
 
 
-    cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
-    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
-                                   |CVf_SLABBED);
-    CvCLONED_on(cv);
-
-    CvFILE(cv)         = CvDYNFILE(proto) ? savepv(CvFILE(proto))
-                                          : CvFILE(proto);
-    CvGV_set(cv,CvGV(proto));
-    CvSTASH_set(cv, CvSTASH(proto));
-    OP_REFCNT_LOCK;
-    CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
-    OP_REFCNT_UNLOCK;
-    CvSTART(cv)                = CvSTART(proto);
     if (CvHASEVAL(cv))
        CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
     if (CvHASEVAL(cv))
        CvOUTSIDE(cv)   = MUTABLE_CV(SvREFCNT_inc_simple(outside));
-    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
-
-    if (SvPOK(proto))
-       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
-    if (SvMAGIC(proto))
-       mg_copy((SV *)proto, (SV *)cv, 0, 0);
 
 
+    SAVESPTR(PL_comppad_name);
+    PL_comppad_name = protopad_name;
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
-    for (ix = fname; ix > 0; ix--)
-       av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
     PL_curpad = AvARRAY(PL_comppad);
 
 
     PL_curpad = AvARRAY(PL_comppad);
 
-    outpad = CvPADLIST(outside)
-       ? AvARRAY(PADLIST_ARRAY(CvPADLIST(outside))[depth])
+    outpad = outside && CvPADLIST(outside)
+       ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
        : NULL;
        : NULL;
-    assert(outpad || SvTYPE(cv) == SVt_PVFM);
+    if (outpad)
+       CvPADLIST(cv)->xpadl_outid = PadlistNAMES(CvPADLIST(outside));
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
 
     for (ix = fpad; ix > 0; ix--) {
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
@@ -2026,10 +2054,8 @@ Perl_cv_clone(pTHX_ CV *proto)
                   but state vars are always available. */
                if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
                 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
                   but state vars are always available. */
                if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
                 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
-                   && !CvDEPTH(outside))  ) {
-                   assert(SvTYPE(cv) == SVt_PVFM);
-                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
-                                  "Variable \"%"SVf"\" is not available", namesv);
+                   && (!outside || !CvDEPTH(outside)))  ) {
+                   S_unavailable(aTHX_ namesv);
                    sv = NULL;
                }
                else 
                    sv = NULL;
                }
                else 
@@ -2038,7 +2064,33 @@ Perl_cv_clone(pTHX_ CV *proto)
            if (!sv) {
                 const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
            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. */
+                   if (SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])) {
+                       assert(SvTYPE(ppad[ix]) == SVt_PVCV);
+                       subclones = 1;
+                       sv = newSV_type(SVt_PVCV);
+                   }
+                   else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv))
+                   {
+                       /* my sub */
+                       /* Just provide a stub, but name it.  It will be
+                          upgrade to the real thing on scope entry. */
+                       sv = newSV_type(SVt_PVCV);
+                       CvNAME_HEK_set(
+                           sv,
+                           share_hek(SvPVX_const(namesv)+1,
+                                     SvCUR(namesv) - 1
+                                        * (SvUTF8(namesv) ? -1 : 1),
+                                     0)
+                       );
+                   }
+                   else sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
                    sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
                 else if (sigil == '@')
                    sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
@@ -2047,7 +2099,7 @@ Perl_cv_clone(pTHX_ CV *proto)
                    sv = newSV(0);
                SvPADMY_on(sv);
                /* reset the 'assign only once' flag on each state var */
                    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);
            }
        }
                    SvPADSTALE_on(sv);
            }
        }
@@ -2061,15 +2113,57 @@ Perl_cv_clone(pTHX_ CV *proto)
        PL_curpad[ix] = sv;
     }
 
        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);
+       }
+
+    if (newcv) SvREFCNT_inc_simple_void_NN(cv);
+    LEAVE;
+}
+
+static CV *
+S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
+{
+    dVAR;
+    const bool newcv = !cv;
+
+    assert(!CvUNIQUE(proto));
+
+    if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
+    CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
+                                   |CVf_SLABBED);
+    CvCLONED_on(cv);
+
+    CvFILE(cv)         = CvDYNFILE(proto) ? savepv(CvFILE(proto))
+                                          : CvFILE(proto);
+    if (CvNAMED(proto))
+        CvNAME_HEK_set(cv, share_hek_hek(CvNAME_HEK(proto)));
+    else CvGV_set(cv,CvGV(proto));
+    CvSTASH_set(cv, CvSTASH(proto));
+    OP_REFCNT_LOCK;
+    CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
+    OP_REFCNT_UNLOCK;
+    CvSTART(cv)                = CvSTART(proto);
+    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
+
+    if (SvPOK(proto))
+       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
+    if (SvMAGIC(proto))
+       mg_copy((SV *)proto, (SV *)cv, 0, 0);
+
+    if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside, newcv);
+
     DEBUG_Xv(
        PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
     DEBUG_Xv(
        PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
-       cv_dump(outside, "Outside");
+       if (CvOUTSIDE(cv)) cv_dump(CvOUTSIDE(cv), "Outside");
        cv_dump(proto,   "Proto");
        cv_dump(cv,      "To");
     );
 
        cv_dump(proto,   "Proto");
        cv_dump(cv,      "To");
     );
 
-    LEAVE;
-
     if (CvCONST(cv)) {
        /* Constant sub () { $x } closing over $x - see lib/constant.pm:
         * The prototype was marked as a candiate for const-ization,
     if (CvCONST(cv)) {
        /* Constant sub () { $x } closing over $x - see lib/constant.pm:
         * The prototype was marked as a candiate for const-ization,
@@ -2078,7 +2172,7 @@ Perl_cv_clone(pTHX_ CV *proto)
         */
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
         */
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
-           SvREFCNT_dec(cv);
+           SvREFCNT_dec_NN(cv);
             /* For this calling case, op_const_sv returns a *copy*, which we
                donate to newCONSTSUB. Yes, this is ugly, and should be killed.
                Need to fix how lib/constant.pm works to eliminate this.  */
             /* For this calling case, op_const_sv returns a *copy*, which we
                donate to newCONSTSUB. Yes, this is ugly, and should be killed.
                Need to fix how lib/constant.pm works to eliminate this.  */
@@ -2092,6 +2186,24 @@ Perl_cv_clone(pTHX_ CV *proto)
     return cv;
 }
 
     return cv;
 }
 
+CV *
+Perl_cv_clone(pTHX_ CV *proto)
+{
+    PERL_ARGS_ASSERT_CV_CLONE;
+
+    if (!CvPADLIST(proto)) Perl_croak(aTHX_ "panic: no pad in cv_clone");
+    return S_cv_clone(aTHX_ proto, NULL, NULL);
+}
+
+/* Called only by pp_clonecv */
+CV *
+Perl_cv_clone_into(pTHX_ CV *proto, CV *target)
+{
+    PERL_ARGS_ASSERT_CV_CLONE_INTO;
+    cv_undef(target);
+    return S_cv_clone(aTHX_ proto, target, NULL);
+}
+
 /*
 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
 /*
 =for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
@@ -2107,8 +2219,8 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
     dVAR;
     I32 ix;
 {
     dVAR;
     I32 ix;
-    AV * const comppad_name = PADLIST_ARRAY(padlist)[0];
-    AV * const comppad = PADLIST_ARRAY(padlist)[1];
+    AV * const comppad_name = PadlistARRAY(padlist)[0];
+    AV * const comppad = PadlistARRAY(padlist)[1];
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
 
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
 
@@ -2117,14 +2229,22 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
 
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
-       if (namesv && namesv != &PL_sv_undef
+       if (namesv && namesv != &PL_sv_undef && !SvPAD_STATE(namesv)
            && *SvPVX_const(namesv) == '&')
        {
          if (SvTYPE(curpad[ix]) == SVt_PVCV) {
            && *SvPVX_const(namesv) == '&')
        {
          if (SvTYPE(curpad[ix]) == SVt_PVCV) {
-           CV * const innercv = MUTABLE_CV(curpad[ix]);
-           assert(CvWEAKOUTSIDE(innercv));
-           assert(CvOUTSIDE(innercv) == old_cv);
-           CvOUTSIDE(innercv) = new_cv;
+           MAGIC * const mg =
+               SvMAGICAL(curpad[ix])
+                   ? mg_find(curpad[ix], PERL_MAGIC_proto)
+                   : NULL;
+           CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
+           if (CvOUTSIDE(innercv) == old_cv) {
+               if (!CvWEAKOUTSIDE(innercv)) {
+                   SvREFCNT_dec(old_cv);
+                   SvREFCNT_inc_simple_void_NN(new_cv);
+               }
+               CvOUTSIDE(innercv) = new_cv;
+           }
          }
          else { /* format reference */
            SV * const rv = curpad[ix];
          }
          else { /* format reference */
            SV * const rv = curpad[ix];
@@ -2158,8 +2278,8 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 
     PERL_ARGS_ASSERT_PAD_PUSH;
 
 
     PERL_ARGS_ASSERT_PAD_PUSH;
 
-    if (depth > PADLIST_MAX(padlist) || !PADLIST_ARRAY(padlist)[depth]) {
-       PAD** const svp = PADLIST_ARRAY(padlist);
+    if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
+       PAD** const svp = PadlistARRAY(padlist);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
        I32 ix = AvFILLp((const AV *)svp[1]);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
        I32 ix = AvFILLp((const AV *)svp[1]);
@@ -2253,41 +2373,41 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
        return NULL;
 
     cloneall = param->flags & CLONEf_COPY_STACKS
        return NULL;
 
     cloneall = param->flags & CLONEf_COPY_STACKS
-       || SvREFCNT(PADLIST_ARRAY(srcpad)[1]) > 1;
-    assert (SvREFCNT(PADLIST_ARRAY(srcpad)[1]) == 1);
+       || SvREFCNT(PadlistARRAY(srcpad)[1]) > 1;
+    assert (SvREFCNT(PadlistARRAY(srcpad)[1]) == 1);
 
 
-    max = cloneall ? PADLIST_MAX(srcpad) : 1;
+    max = cloneall ? PadlistMAX(srcpad) : 1;
 
     Newx(dstpad, 1, PADLIST);
     ptr_table_store(PL_ptr_table, srcpad, dstpad);
 
     Newx(dstpad, 1, PADLIST);
     ptr_table_store(PL_ptr_table, srcpad, dstpad);
-    PADLIST_MAX(dstpad) = max;
-    Newx(PADLIST_ARRAY(dstpad), max + 1, PAD *);
+    PadlistMAX(dstpad) = max;
+    Newx(PadlistARRAY(dstpad), max + 1, PAD *);
 
     if (cloneall) {
        PADOFFSET depth;
        for (depth = 0; depth <= max; ++depth)
 
     if (cloneall) {
        PADOFFSET depth;
        for (depth = 0; depth <= max; ++depth)
-           PADLIST_ARRAY(dstpad)[depth] =
-               av_dup_inc(PADLIST_ARRAY(srcpad)[depth], param);
+           PadlistARRAY(dstpad)[depth] =
+               av_dup_inc(PadlistARRAY(srcpad)[depth], param);
     } else {
        /* CvDEPTH() on our subroutine will be set to 0, so there's no need
           to build anything other than the first level of pads.  */
     } else {
        /* CvDEPTH() on our subroutine will be set to 0, so there's no need
           to build anything other than the first level of pads.  */
-       I32 ix = AvFILLp(PADLIST_ARRAY(srcpad)[1]);
+       I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]);
        AV *pad1;
        AV *pad1;
-       const I32 names_fill = AvFILLp(PADLIST_ARRAY(srcpad)[0]);
-       const PAD *const srcpad1 = PADLIST_ARRAY(srcpad)[1];
+       const I32 names_fill = AvFILLp(PadlistARRAY(srcpad)[0]);
+       const PAD *const srcpad1 = PadlistARRAY(srcpad)[1];
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
        SV **pad1a;
        AV *args;
 
        SV **oldpad = AvARRAY(srcpad1);
        SV **names;
        SV **pad1a;
        AV *args;
 
-       PADLIST_ARRAY(dstpad)[0] =
-           av_dup_inc(PADLIST_ARRAY(srcpad)[0], param);
-       names = AvARRAY(PADLIST_ARRAY(dstpad)[0]);
+       PadlistARRAY(dstpad)[0] =
+           av_dup_inc(PadlistARRAY(srcpad)[0], param);
+       names = AvARRAY(PadlistARRAY(dstpad)[0]);
 
        pad1 = newAV();
 
        av_extend(pad1, ix);
 
        pad1 = newAV();
 
        av_extend(pad1, ix);
-       PADLIST_ARRAY(dstpad)[1] = pad1;
+       PadlistARRAY(dstpad)[1] = pad1;
        pad1a = AvARRAY(pad1);
 
        if (ix > -1) {
        pad1a = AvARRAY(pad1);
 
        if (ix > -1) {
@@ -2357,24 +2477,24 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
 #endif /* USE_ITHREADS */
 
 PAD **
 #endif /* USE_ITHREADS */
 
 PAD **
-Perl_padlist_store(pTHX_ register PADLIST *padlist, I32 key, PAD *val)
+Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
 {
     dVAR;
     PAD **ary;
 {
     dVAR;
     PAD **ary;
-    SSize_t const oldmax = PADLIST_MAX(padlist);
+    SSize_t const oldmax = PadlistMAX(padlist);
 
     PERL_ARGS_ASSERT_PADLIST_STORE;
 
     assert(key >= 0);
 
 
     PERL_ARGS_ASSERT_PADLIST_STORE;
 
     assert(key >= 0);
 
-    if (key > PADLIST_MAX(padlist)) {
-       av_extend_guts(NULL,key,&PADLIST_MAX(padlist),
-                      (SV ***)&PADLIST_ARRAY(padlist),
-                      (SV ***)&PADLIST_ARRAY(padlist));
-       Zero(PADLIST_ARRAY(padlist)+oldmax+1, PADLIST_MAX(padlist)-oldmax,
+    if (key > PadlistMAX(padlist)) {
+       av_extend_guts(NULL,key,&PadlistMAX(padlist),
+                      (SV ***)&PadlistARRAY(padlist),
+                      (SV ***)&PadlistARRAY(padlist));
+       Zero(PadlistARRAY(padlist)+oldmax+1, PadlistMAX(padlist)-oldmax,
             PAD *);
     }
             PAD *);
     }
-    ary = PADLIST_ARRAY(padlist);
+    ary = PadlistARRAY(padlist);
     SvREFCNT_dec(ary[key]);
     ary[key] = val;
     return &ary[key];
     SvREFCNT_dec(ary[key]);
     ary[key] = val;
     return &ary[key];
Unnamed repository; edit this file 'description' to name the repository.