This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stas' croak patch and then some
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 9c2b5a2..4d87758 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -75,7 +75,7 @@ The SVs in the names AV have their PV being the name of the variable.
 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
 valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
 type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> delarations in the
+stash of the associated global (so that duplicate C<our> declarations in the
 same package can be detected).  SvCUR is sometimes hijacked to
 store the generation number during compilation.
 
@@ -229,7 +229,7 @@ void
 Perl_pad_undef(pTHX_ CV* cv)
 {
     I32 ix;
-    const PADLIST *padlist = CvPADLIST(cv);
+    const PADLIST * const padlist = CvPADLIST(cv);
 
     if (!padlist)
        return;
@@ -344,7 +344,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     }
     if (ourstash) {
        SvFLAGS(namesv) |= SVpad_OUR;
-       GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
+       GvSTASH(namesv) = ourstash;
+       Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
@@ -385,7 +386,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
 
 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
-for a slot which has no name and and no active value.
+for a slot which has no name and no active value.
 
 =cut
 */
@@ -411,7 +412,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
        retval = AvFILLp(PL_comppad);
     }
     else {
-       SV ** const names = AvARRAY(PL_comppad_name);
+       SV * const * const names = AvARRAY(PL_comppad_name);
         const SSize_t names_fill = AvFILLp(PL_comppad_name);
        for (;;) {
            /*
@@ -456,9 +457,7 @@ PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
     PADOFFSET ix;
-    SV* name;
-
-    name = NEWSV(1106, 0);
+    SV* const name = NEWSV(1106, 0);
     sv_upgrade(name, SVt_PVNV);
     sv_setpvn(name, "&", 1);
     SvIV_set(name, -1);
@@ -502,7 +501,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
     PADOFFSET  top, off;
 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");
-    if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
+    if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
        return; /* nothing to check */
 
     svp = AvARRAY(PL_comppad_name);
@@ -516,10 +515,10 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
            && sv != &PL_sv_undef
            && !SvFAKE(sv)
            && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-           && (!is_our
-               || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
            && strEQ(name, SvPVX_const(sv)))
        {
+           if (is_our && (SvFLAGS(sv) & SVpad_OUR))
+               break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                "\"%s\" variable %s masks earlier declaration in same %s",
                (is_our ? "our" : "my"),
@@ -542,8 +541,9 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
            {
                Perl_warner(aTHX_ packWARN(WARN_MISC),
                    "\"our\" variable %s redeclared", name);
-               Perl_warner(aTHX_ packWARN(WARN_MISC),
-                   "\t(Did you mean \"local\" instead of \"our\"?)\n");
+               if ((I32)off <= PL_comppad_name_floor)
+                   Perl_warner(aTHX_ packWARN(WARN_MISC),
+                       "\t(Did you mean \"local\" instead of \"our\"?)\n");
                break;
            }
        } while ( off-- > 0 );
@@ -584,7 +584,7 @@ Perl_pad_findmy(pTHX_ const char *name)
     nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
-        const SV *namesv = name_svp[offset];
+        const SV * const namesv = name_svp[offset];
        if (namesv && namesv != &PL_sv_undef
            && !SvFAKE(namesv)
            && (SvFLAGS(namesv) & SVpad_OUR)
@@ -653,7 +653,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
-    const AV *padlist = CvPADLIST(cv);
+    const AV * const padlist = CvPADLIST(cv);
 
     *out_flags = 0;
 
@@ -665,11 +665,11 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     if (padlist) { /* not an undef CV */
        I32 fake_offset = 0;
-        const AV *nameav = (AV*)AvARRAY(padlist)[0];
-       SV **name_svp = AvARRAY(nameav);
+        const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+       SV * const * const name_svp = AvARRAY(nameav);
 
        for (offset = AvFILLp(nameav); offset > 0; offset--) {
-            const SV *namesv = name_svp[offset];
+            const SV * const namesv = name_svp[offset];
            if (namesv && namesv != &PL_sv_undef
                    && strEQ(SvPVX_const(namesv), name))
            {
@@ -754,7 +754,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                            "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
                            PTR2UV(cv)));
                        n = *out_name_sv;
-                       pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
+                       (void) pad_findlex(name, CvOUTSIDE(cv),
+                           CvOUTSIDE_SEQ(cv),
                            newwarn, out_capture, out_name_sv, out_flags);
                        *out_name_sv = n;
                        return offset;
@@ -993,7 +994,7 @@ void
 Perl_pad_leavemy(pTHX)
 {
     I32 off;
-    SV ** const svp = AvARRAY(PL_comppad_name);
+    SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
 
@@ -1054,8 +1055,15 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     if (refadjust)
        SvREFCNT_dec(PL_curpad[po]);
 
+
+    /* if pad tmps aren't shared between ops, then there's no need to
+     * create a new tmp when an existing op is freed */
+#ifdef USE_BROKEN_PAD_RESET
     PL_curpad[po] = NEWSV(1107,0);
     SvPADTMP_on(PL_curpad[po]);
+#else
+    PL_curpad[po] = &PL_sv_undef;
+#endif
     if ((I32)po < PL_padix)
        PL_padix = po - 1;
 }
@@ -1152,7 +1160,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
        av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
     if (type == padtidy_SUBCLONE) {
-       SV ** const namep = AvARRAY(PL_comppad_name);
+       SV * const * const namep = AvARRAY(PL_comppad_name);
        PADOFFSET ix;
 
        for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
@@ -1207,7 +1215,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 /*
 =for apidoc pad_free
 
-Free the SV at offet po in the current pad.
+Free the SV at offset po in the current pad.
 
 =cut
 */
@@ -1495,10 +1503,10 @@ Perl_cv_clone(pTHX_ CV *proto)
         * so try to grab the current const value, and if successful,
         * turn into a const sub:
         */
-       SV* const_sv = op_const_sv(CvSTART(cv), cv);
+       SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
            SvREFCNT_dec(cv);
-           cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
+           cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv);
        }
        else {
            CvCONST_off(cv);
@@ -1528,11 +1536,11 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-        const SV *namesv = namepad[ix];
+        const SV * const namesv = namepad[ix];
        if (namesv && namesv != &PL_sv_undef
            && *SvPVX_const(namesv) == '&')
        {
-           CV *innercv = (CV*)curpad[ix];
+           CV * const innercv = (CV*)curpad[ix];
            assert(CvWEAKOUTSIDE(innercv));
            assert(CvOUTSIDE(innercv) == old_cv);
            CvOUTSIDE(innercv) = new_cv;
@@ -1558,12 +1566,12 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        return;
 
     {
-       SV** svp = AvARRAY(padlist);
-       AV *newpad = newAV();
-       SV **oldpad = AvARRAY(svp[depth-1]);
+       SV** const svp = AvARRAY(padlist);
+       AV* const newpad = newAV();
+       SV** const oldpad = AvARRAY(svp[depth-1]);
        I32 ix = AvFILLp((AV*)svp[1]);
         const I32 names_fill = AvFILLp((AV*)svp[0]);
-       SV** names = AvARRAY(svp[0]);
+       SV** const names = AvARRAY(svp[0]);
        AV *av;
 
        for ( ;ix > 0; ix--) {
@@ -1590,7 +1598,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
            }
            else {
                /* save temporaries on recursion? */
-               SV *sv = NEWSV(0, 0);
+               SV * const sv = NEWSV(0, 0);
                av_store(newpad, ix, sv);
                SvPADTMP_on(sv);
            }
@@ -1609,7 +1617,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
-    SV** const av = av_fetch(PL_comppad_name, po, FALSE);
+    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
     if ( SvFLAGS(*av) & SVpad_TYPED ) {
         return SvSTASH(*av);
     }