This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid accessing a just-freed SV (keep ponie happy)
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 001b304..280b46c 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -260,14 +260,17 @@ Perl_pad_undef(pTHX_ CV* cv)
                && *SvPVX(namesv) == '&')
            {
                CV * const innercv = (CV*)curpad[ix];
+               U32 inner_rc = SvREFCNT(innercv);
+               assert(inner_rc);
                namepad[ix] = Nullsv;
                SvREFCNT_dec(namesv);
 
                if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
                    curpad[ix] = Nullsv;
                    SvREFCNT_dec(innercv);
+                   inner_rc--;
                }
-               if (SvREFCNT(innercv) /* in use, not just a prototype */
+               if (inner_rc /* in use, not just a prototype */
                    && CvOUTSIDE(innercv) == cv)
                {
                    assert(CvWEAKOUTSIDE(innercv));
@@ -337,7 +340,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
 
     if (typestash) {
        SvFLAGS(namesv) |= SVpad_TYPED;
-       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
+       SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
     }
     if (ourstash) {
        SvFLAGS(namesv) |= SVpad_OUR;
@@ -352,8 +355,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     }
     else {
        /* not yet introduced */
-       SvNVX(namesv) = (NV)PAD_MAX;    /* min */
-       SvIVX(namesv) = 0;              /* max */
+       SvNV_set(namesv, (NV)PAD_MAX);  /* min */
+       SvIV_set(namesv, 0);            /* max */
 
        if (!PL_min_intro_pending)
            PL_min_intro_pending = offset;
@@ -458,8 +461,8 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     name = NEWSV(1106, 0);
     sv_upgrade(name, SVt_PVNV);
     sv_setpvn(name, "&", 1);
-    SvIVX(name) = -1;
-    SvNVX(name) = 1;
+    SvIV_set(name, -1);
+    SvNV_set(name, 1);
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
@@ -822,15 +825,15 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
-       SvIVX(new_namesv) = *out_flags;
+       SvIV_set(new_namesv, *out_flags);
 
-       SvNVX(new_namesv) = (NV)0;
+       SvNV_set(new_namesv, (NV)0);
        if (SvFLAGS(new_namesv) & SVpad_OUR) {
           /* do nothing */
        }
        else if (CvLATE(cv)) {
            /* delayed creation - just note the offset within parent pad */
-           SvNVX(new_namesv) = (NV)offset;
+           SvNV_set(new_namesv, (NV)offset);
            CvCLONE_on(cv);
        }
        else {
@@ -959,8 +962,8 @@ Perl_intro_my(pTHX)
        if ((sv = svp[i]) && sv != &PL_sv_undef
                && !SvFAKE(sv) && !SvIVX(sv))
        {
-           SvIVX(sv) = PAD_MAX;        /* Don't know scope end yet. */
-           SvNVX(sv) = (NV)PL_cop_seqmax;
+           SvIV_set(sv, PAD_MAX);      /* Don't know scope end yet. */
+           SvNV_set(sv, (NV)PL_cop_seqmax);
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad intromy: %ld \"%s\", (%ld,%ld)\n",
                (long)i, SvPVX(sv),
@@ -1009,7 +1012,7 @@ Perl_pad_leavemy(pTHX)
        if ((sv = svp[off]) && sv != &PL_sv_undef
                && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
        {
-           SvIVX(sv) = PL_cop_seqmax;
+           SvIV_set(sv, PL_cop_seqmax);
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
                "Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
                (long)off, SvPVX(sv),
@@ -1119,6 +1122,7 @@ Tidy up a pad after we've finished compiling it:
 void
 Perl_pad_tidy(pTHX_ padtidy_type type)
 {
+    dVAR;
     PADOFFSET ix;
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
@@ -1368,6 +1372,7 @@ any outer lexicals.
 CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
+    dVAR;
     I32 ix;
     AV* protopadlist = CvPADLIST(proto);
     const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
@@ -1376,7 +1381,6 @@ Perl_cv_clone(pTHX_ CV *proto)
     SV** ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    AV* comppadlist;
     CV* cv;
     SV** outpad;
     CV* outside;
@@ -1423,7 +1427,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     if (SvPOK(proto))
        sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
 
-    CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+    CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
     for (ix = fname; ix >= 0; ix--)
@@ -1599,3 +1603,14 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        AvFILLp(padlist) = depth;
     }
 }
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+    SV** const av = av_fetch(PL_comppad_name, po, FALSE);
+    if ( SvFLAGS(*av) & SVpad_TYPED ) {
+        return SvSTASH(*av);
+    }
+    return Nullhv;
+}