back out change #22167 "freeing a CV reference that was currently

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index a64ec3e..2c2ce36 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,7 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-2003, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -154,6 +155,13 @@ Perl_savestack_grow(pTHX)
     Renew(PL_savestack, PL_savestack_max, ANY);
 }
 
+void
+Perl_savestack_grow_cnt(pTHX_ I32 need)
+{
+    PL_savestack_max = PL_savestack_ix + need;
+    Renew(PL_savestack, PL_savestack_max, ANY);
+}
+
 #undef GROW
 
 void
@@ -191,9 +199,9 @@ S_save_scalar_at(pTHX_ SV **sptr)
 
     sv = *sptr = NEWSV(0,0);
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+       MAGIC *mg;
        sv_upgrade(sv, SvTYPE(osv));
        if (SvGMAGICAL(osv)) {
-           MAGIC* mg;
            bool oldtainted = PL_tainted;
            mg_get(osv);                /* note, can croak! */
            if (PL_tainting && PL_tainted &&
@@ -206,6 +214,16 @@ S_save_scalar_at(pTHX_ SV **sptr)
            PL_tainted = oldtainted;
        }
        SvMAGIC(sv) = SvMAGIC(osv);
+       /* if it's a special scalar or if it has no 'set' magic,
+        * propagate the SvREADONLY flag. --rgs 20030922 */
+       for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+           if (SvMAGIC(sv)->mg_type == '\0'
+                   || !SvMAGIC(sv)->mg_virtual->svt_set)
+           {
+               SvFLAGS(sv) |= SvREADONLY(osv);
+               break;
+           }
+       }
        SvFLAGS(sv) |= SvMAGICAL(osv);
        /* XXX SvMAGIC() is *shared* between osv and sv.  This can
         * lead to coredumps when both SVs are destroyed without one
@@ -273,10 +291,22 @@ Perl_save_shared_pvref(pTHX_ char **str)
     SSPUSHINT(SAVEt_SHARED_PVREF);
 }
 
+/* set the SvFLAGS specified by mask to the values in val */
+
+void
+Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
+{
+    SSCHECK(4);
+    SSPUSHPTR(sv);
+    SSPUSHINT(mask);
+    SSPUSHINT(val);
+    SSPUSHINT(SAVEt_SET_SVFLAGS);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
-    SSCHECK(6);
+    SSGROW(6);
     SSPUSHIV((IV)SvLEN(gv));
     SvLEN(gv) = 0; /* forget that anything was allocated here */
     SSPUSHIV((IV)SvCUR(gv));
@@ -937,7 +967,7 @@ Perl_leave_scope(pTHX_ I32 base)
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
                /* preserve pad nature, but also mark as not live
                 * for any closure capturing */
-               SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE;
+               SvFLAGS(*(SV**)ptr) |= padflags | SVs_PADSTALE;
            }
            break;
        case SAVEt_DELETE:
@@ -1028,6 +1058,15 @@ Perl_leave_scope(pTHX_ I32 base)
                    AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR;
            }
            break;
+       case SAVEt_SET_SVFLAGS:
+           {
+               U32 val  = (U32)SSPOPINT;
+               U32 mask = (U32)SSPOPINT;
+               sv = (SV*)SSPOPPTR;
+               SvFLAGS(sv) &= ~mask;
+               SvFLAGS(sv) |= val;
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }