Fix a nested package deletion bug

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 92e9523..9c1831c 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -77,7 +77,7 @@ Perl_cxinc(pTHX)
     dVAR;
     const IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
-    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
+    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
     PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
@@ -183,10 +183,8 @@ S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
 
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
        if (SvGMAGICAL(osv)) {
-           const bool oldtainted = PL_tainted;
            SvFLAGS(osv) |= (SvFLAGS(osv) &
               (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-           PL_tainted = oldtainted;
        }
        if (!(flags & SAVEf_KEEPOLDELEM))
            mg_localize(osv, sv, (flags & SAVEf_SETMAGIC) != 0);
@@ -600,17 +598,12 @@ void
 Perl_save_hints(pTHX)
 {
     dVAR;
-    if (PL_compiling.cop_hints_hash) {
-       HINTS_REFCNT_LOCK;
-           PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
-           HINTS_REFCNT_UNLOCK;
-    }
+    COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
     if (PL_hints & HINT_LOCALIZE_HH) {
-       save_pushptri32ptr(GvHV(PL_hintgv), PL_hints,
-                          PL_compiling.cop_hints_hash, SAVEt_HINTS);
-       GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv));
+       save_pushptri32ptr(GvHV(PL_hintgv), PL_hints, save_cophh, SAVEt_HINTS);
+       GvHV(PL_hintgv) = hv_copy_hints_hv(GvHV(PL_hintgv));
     } else {
-       save_pushi32ptr(PL_hints, PL_compiling.cop_hints_hash, SAVEt_HINTS);
+       save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
     }
 }
 
@@ -778,9 +771,15 @@ Perl_leave_scope(pTHX_ I32 base)
                *(char**)ptr = str;
            }
            break;
+       case SAVEt_GVSV:                        /* scalar slot in GV */
+           value = MUTABLE_SV(SSPOPPTR);
+           gv = MUTABLE_GV(SSPOPPTR);
+           ptr = &GvSV(gv);
+           goto restore_svp;
        case SAVEt_GENERIC_SVREF:               /* generic sv */
            value = MUTABLE_SV(SSPOPPTR);
            ptr = SSPOPPTR;
+       restore_svp:
            sv = *(SV**)ptr;
            *(SV**)ptr = value;
            SvREFCNT_dec(sv);
@@ -1015,8 +1014,8 @@ Perl_leave_scope(pTHX_ I32 base)
                SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
                GvHV(PL_hintgv) = NULL;
            }
-           Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
-           PL_compiling.cop_hints_hash = (struct refcounted_he *) SSPOPPTR;
+           cophh_free(CopHINTHASH_get(&PL_compiling));
+           CopHINTHASH_set(&PL_compiling, (COPHH*)SSPOPPTR);
            *(I32*)&PL_hints = (I32)SSPOPINT;
            if (PL_hints & HINT_LOCALIZE_HH) {
                SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
@@ -1232,8 +1231,6 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                (long)cx->blk_loop.resetsp);
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.my_op));
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
-               PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
        /* XXX: not accurate for LAZYSV/IV */
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.state_u.ary.ary));