Stop op freeing from interfering with sub(){42} mutability

[perl5.git] / pad.c

diff --git a/pad.c b/pad.c
index 2bbf866..0bf65cd 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -715,7 +715,10 @@ which will be set in the value SV for the allocated pad entry:
     SVf_READONLY constant shared between recursion levels
 
 C<SVf_READONLY> has been supported here only since perl 5.20.  To work with
-earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>.
+earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>.  C<SVf_READONLY>
+does not cause the SV in the pad slot to be marked read-only, but simply
+tells C<pad_alloc> that it I<will> be made read-only (by the caller), or at
+least should be treated as such.
 
 I<optype> should be an opcode indicating the type of operation that the
 pad entry is to support.  This doesn't affect operational semantics,
@@ -765,7 +768,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
                continue;
            sv = *av_fetch(PL_comppad, PL_padix, TRUE);
            if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
-               !IS_PADGV(sv) && !IS_PADCONST(sv))
+               !IS_PADGV(sv))
                break;
        }
        if (tmptype & SVf_READONLY) {
@@ -1635,8 +1638,6 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
                "Pad 0x%"UVxf"[0x%"UVxf"] swipe:   %ld\n",
                PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
 
-    if (PL_curpad[po])
-       SvPADTMP_off(PL_curpad[po]);
     if (refadjust)
        SvREFCNT_dec(PL_curpad[po]);
 
@@ -1650,7 +1651,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     PL_curpad[po] = &PL_sv_undef;
 #endif
     if (PadnamelistMAX(PL_comppad_name) != -1
-     && PadnamelistMAX(PL_comppad_name) >= po) {
+     && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) {
        assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
        PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
     }
@@ -2180,25 +2181,6 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
        cv_dump(cv,      "To");
     );
 
-    if (CvCONST(cv)) {
-       /* Constant sub () { $x } closing over $x - see lib/constant.pm:
-        * The prototype was marked as a candiate for const-ization,
-        * so try to grab the current const value, and if successful,
-        * turn into a const sub:
-        */
-       SV* const const_sv = op_const_sv(CvSTART(cv), cv);
-       if (const_sv) {
-           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.  */
-           cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
-       }
-       else {
-           CvCONST_off(cv);
-       }
-    }
-
     return cv;
 }
 
@@ -2325,7 +2307,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                    SvPADMY_on(sv);
                }
            }
-           else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+           else if (IS_PADGV(oldpad[ix]) || PadnamePV(names[ix])) {
                av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
            }
            else {
@@ -2461,7 +2443,7 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
                        }
                    }
                }
-               else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+               else if (IS_PADGV(oldpad[ix]) || PadnamePV(names[ix])) {
                    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                }
                else {