This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta: Silence podchecker
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 3586b64..a034d09 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -58,7 +58,8 @@ AV which is @_.  Other entries are storage for variables and op targets.
 Iterating over the PADNAMELIST iterates over all possible pad
 items.  Pad slots for targets (SVs_PADTMP) and GVs end up having &PL_sv_no
 "names", while slots for constants have &PL_sv_no "names" (see
-pad_alloc()).
+pad_alloc()).  That &PL_sv_no is used is an implementation detail subject
+to change.  To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
 
 Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
 The rest are op targets/GVs/constants which are statically allocated
@@ -283,6 +284,8 @@ Perl_pad_new(pTHX_ int flags)
     else {
        av_store(pad, 0, NULL);
        padname = newAV();
+       AvPAD_NAMELIST_on(padname);
+       av_store(padname, 0, &PL_sv_undef);
     }
 
     /* Most subroutines never recurse, hence only need 2 entries in the padlist
@@ -573,6 +576,7 @@ S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
     }
 
     av_store(PL_comppad_name, offset, namesv);
+    PadnamelistMAXNAMED(PL_comppad_name) = offset;
     return offset;
 }
 
@@ -768,7 +772,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) {
@@ -1177,7 +1181,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv,
         const AV * const nameav = PadlistARRAY(padlist)[0];
        SV * const * const name_svp = AvARRAY(nameav);
 
-       for (offset = AvFILLp(nameav); offset > 0; offset--) {
+       for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
             const SV * const namesv = name_svp[offset];
            if (namesv && PadnameLEN(namesv) == namelen
                     && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
@@ -1638,8 +1642,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,11 +1652,13 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     PL_curpad[po] = newSV(0);
     SvPADTMP_on(PL_curpad[po]);
 #else
-    PL_curpad[po] = &PL_sv_undef;
+    PL_curpad[po] = NULL;
 #endif
     if (PadnamelistMAX(PL_comppad_name) != -1
-     && PadnamelistMAX(PL_comppad_name) >= po) {
-       assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
+     && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) {
+       if (PadnamelistARRAY(PL_comppad_name)[po]) {
+           assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
+       }
        PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
     }
     if ((I32)po < PL_padix)
@@ -1766,22 +1770,24 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
        av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
 
     if (type == padtidy_SUBCLONE) {
-       SV * const * const namep = AvARRAY(PL_comppad_name);
+       SV ** const namep = AvARRAY(PL_comppad_name);
        PADOFFSET ix;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
            SV *namesv;
+           if (!namep[ix]) namep[ix] = &PL_sv_undef;
 
-           if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
-               continue;
            /*
             * The only things that a clonable function needs in its
-            * pad are anonymous subs.
+            * pad are anonymous subs, constants and GVs.
             * The rest are created anew during cloning.
             */
-           if (!((namesv = namep[ix]) != NULL &&
-                 namesv != &PL_sv_undef &&
-                  *SvPVX_const(namesv) == '&'))
+           if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+                || IS_PADGV(PL_curpad[ix]))
+               continue;
+           namesv = namep[ix];
+           if (!(PadnamePV(namesv) &&
+                  (!PadnameLEN(namesv) || *SvPVX_const(namesv) == '&')))
            {
                SvREFCNT_dec(PL_curpad[ix]);
                PL_curpad[ix] = NULL;
@@ -1796,10 +1802,12 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     }
 
     if (type == padtidy_SUB || type == padtidy_FORMAT) {
-       SV * const * const namep = AvARRAY(PL_comppad_name);
+       SV ** 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]))
+           if (!namep[ix]) namep[ix] = &PL_sv_undef;
+           if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+                || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
                continue;
            if (!SvPADMY(PL_curpad[ix])) {
                SvPADTMP_on(PL_curpad[ix]);
@@ -2065,6 +2073,10 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
        SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
        SV *sv = NULL;
        if (namesv && PadnameLEN(namesv)) { /* lexical */
+         if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */
+               NOOP;
+         }
+         else {
            if (SvFAKE(namesv)) {   /* lexical from outside? */
                /* formats may have an inactive, or even undefined, parent;
                   but state vars are always available. */
@@ -2118,8 +2130,9 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
                if (sigil != '&' && SvPAD_STATE(namesv))
                    SvPADSTALE_on(sv);
            }
+         }
        }
-       else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+       else if (IS_PADGV(ppad[ix]) || (namesv && PadnamePV(namesv))) {
            sv = SvREFCNT_inc_NN(ppad[ix]);
        }
        else {
@@ -2183,25 +2196,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;
 }
 
@@ -2328,7 +2322,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 {
@@ -2435,7 +2429,8 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
            for ( ;ix > 0; ix--) {
                if (!oldpad[ix]) {
                    pad1a[ix] = NULL;
-               } else if (names_fill >= ix && PadnameLEN(names[ix])) {
+               } else if (names_fill >= ix && names[ix] &&
+                          PadnameLEN(names[ix])) {
                    const char sigil = SvPVX_const(names[ix])[0];
                    if ((SvFLAGS(names[ix]) & SVf_FAKE)
                        || (SvFLAGS(names[ix]) & SVpad_STATE)
@@ -2464,7 +2459,9 @@ 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])
+                     || (  names_fill >= ix && names[ix]
+                        && PadnamePV(names[ix])  )) {
                    pad1a[ix] = sv_dup_inc(oldpad[ix], param);
                }
                else {