X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=932390de0f086b99d8a36837fb947594c8b1cd64;hb=5cfbcfcdc45b1cdd758241f7f02495ded7acc722;hp=d3a4c3611aac9152929ebd147add2e94377110ee;hpb=235cc2e3b03f7c8478aa5ccdbe27e0aaf735bb46;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/scope.c b/scope.c
index d3a4c36..932390d 100644
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,7 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-2002, 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.
@@ -548,6 +549,7 @@ Perl_save_clearsv(pTHX_ SV **svp)
     SSCHECK(2);
     SSPUSHLONG((long)(svp-PL_curpad));
     SSPUSHINT(SAVEt_CLEARSV);
+    SvPADSTALE_off(*svp); /* mark lexical as active */
 }
 
 void
@@ -603,6 +605,9 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
     SSPUSHINT(idx);
     SSPUSHPTR(SvREFCNT_inc(*sptr));
     SSPUSHINT(SAVEt_AELEM);
+    /* if it gets reified later, the restore will have the wrong refcnt */
+    if (!AvREAL(av) && AvREIFY(av))
+	SvREFCNT_inc(*sptr);
     save_scalar_at(sptr);
     sv = *sptr;
     /* If we're localizing a tied array element, this new sv
@@ -685,7 +690,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    value = (SV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
 	    ptr = &GvSV(gv);
-	    SvREFCNT_dec(gv);
+	    av = (AV*)gv; /* what to refcnt_dec */
 	    goto restore_sv;
 	case SAVEt_GENERIC_PVREF:		/* generic pv */
 	    str = (char*)SSPOPPTR;
@@ -718,6 +723,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	case SAVEt_SVREF:			/* scalar reference */
 	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
+	    av = Nullav; /* what to refcnt_dec */
 	restore_sv:
 	    sv = *(SV**)ptr;
 	    DEBUG_S(PerlIO_printf(Perl_debug_log,
@@ -753,6 +759,8 @@ Perl_leave_scope(pTHX_ I32 base)
 	    SvSETMAGIC(value);
 	    PL_localizing = 0;
 	    SvREFCNT_dec(value);
+	    if (av) /* actually an av, hv or gv */
+		SvREFCNT_dec(av);
 	    break;
 	case SAVEt_AV:				/* array reference */
 	    av = (AV*)SSPOPPTR;
@@ -918,6 +926,7 @@ Perl_leave_scope(pTHX_ I32 base)
 		    (void)SvOOK_off(sv);
 		    break;
 		}
+		SvPADSTALE_on(sv); /* mark as no longer live */
 	    }
 	    else {	/* Someone has a claim on this, so abandon it. */
 		U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP);
@@ -927,7 +936,9 @@ Perl_leave_scope(pTHX_ I32 base)
 		default:	*(SV**)ptr = NEWSV(0,0);	break;
 		}
 		SvREFCNT_dec(sv);	/* Cast current value to the winds. */
-		SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
+		/* preserve pad nature, but also mark as not live
+		 * for any closure capturing */
+		SvFLAGS(*(SV**)ptr) |= padflags & SVs_PADSTALE;
 	    }
 	    break;
 	case SAVEt_DELETE:
@@ -959,13 +970,14 @@ Perl_leave_scope(pTHX_ I32 base)
 	    value = (SV*)SSPOPPTR;
 	    i = SSPOPINT;
 	    av = (AV*)SSPOPPTR;
+	    if (!AvREAL(av) && AvREIFY(av)) /* undo reify guard */
+		SvREFCNT_dec(value);
 	    ptr = av_fetch(av,i,1);
 	    if (ptr) {
 		sv = *(SV**)ptr;
 		if (sv && sv != &PL_sv_undef) {
 		    if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(sv);
-		    SvREFCNT_dec(av);
 		    goto restore_sv;
 		}
 	    }
@@ -983,8 +995,8 @@ Perl_leave_scope(pTHX_ I32 base)
 		    ptr = &HeVAL((HE*)ptr);
 		    if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(*(SV**)ptr);
-		    SvREFCNT_dec(hv);
 		    SvREFCNT_dec(sv);
+		    av = (AV*)hv; /* what to refcnt_dec */
 		    goto restore_sv;
 		}
 	    }