X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=a82c0f51db1cf1a1bb1776274f469fc3f63fc363;hb=466d6cd3e7b7bbd27604d839f967b18f16a935e5;hp=527593542cd455ad2acae71c4d9182c6bdac7590;hpb=578130200aea30eb8391e4d2a8f7bc5df24d3c3a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/scope.c b/scope.c
index 5275935..a82c0f5 100644
--- a/scope.c
+++ b/scope.c
@@ -196,17 +196,21 @@ S_save_scalar_at(pTHX_ SV **sptr)
 	if (SvGMAGICAL(osv)) {
 	    MAGIC* mg;
 	    bool oldtainted = PL_tainted;
-	    mg_get(osv);
-	    if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) {
+	    mg_get(osv);		/* note, can croak! */
+	    if (PL_tainting && PL_tainted &&
+			(mg = mg_find(osv, PERL_MAGIC_taint))) {
 		SAVESPTR(mg->mg_obj);
 		mg->mg_obj = osv;
 	    }
 	    SvFLAGS(osv) |= (SvFLAGS(osv) &
-		(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+               (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 	    PL_tainted = oldtainted;
 	}
 	SvMAGIC(sv) = SvMAGIC(osv);
 	SvFLAGS(sv) |= SvMAGICAL(osv);
+	/* XXX SvMAGIC() is *shared* between osv and sv.  This can
+	 * lead to coredumps when both SVs are destroyed without one
+	 * of their SvMAGIC() slots being NULLed. */
 	PL_localizing = 1;
 	SvSETMAGIC(sv);
 	PL_localizing = 0;
@@ -501,6 +505,14 @@ Perl_save_freesv(pTHX_ SV *sv)
 }
 
 void
+Perl_save_mortalizesv(pTHX_ SV *sv)
+{
+    SSCHECK(2);
+    SSPUSHPTR(sv);
+    SSPUSHINT(SAVEt_MORTALIZESV);
+}
+
+void
 Perl_save_freeop(pTHX_ OP *o)
 {
     SSCHECK(2);
@@ -678,12 +690,19 @@ Perl_leave_scope(pTHX_ I32 base)
 		SvMAGICAL_off(sv);
 		SvMAGIC(sv) = 0;
 	    }
+	    /* XXX This branch is pretty bogus.  This code irretrievably
+	     * clears(!) the magic on the SV (either to avoid further
+	     * croaking that might ensue when the SvSETMAGIC() below is
+	     * called, or to avoid two different SVs pointing at the same
+	     * SvMAGIC()).  This needs a total rethink.  --GSAR */
 	    else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) &&
 		     SvTYPE(value) != SVt_PVGV)
 	    {
 		SvFLAGS(value) |= (SvFLAGS(value) &
-				   (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+                                  (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 		SvMAGICAL_off(value);
+		/* XXX this is a leak when we get here because the
+		 * mg_get() in save_scalar_at() croaked */
 		SvMAGIC(value) = 0;
 	    }
             SvREFCNT_dec(sv);
@@ -793,6 +812,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    ptr = SSPOPPTR;
 	    SvREFCNT_dec((SV*)ptr);
 	    break;
+	case SAVEt_MORTALIZESV:
+	    ptr = SSPOPPTR;
+	    sv_2mortal((SV*)ptr);
+	    break;
 	case SAVEt_FREEOP:
 	    ptr = SSPOPPTR;
 	    if (PL_comppad)
@@ -879,7 +902,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    if (ptr) {
 		sv = *(SV**)ptr;
 		if (sv && sv != &PL_sv_undef) {
-		    if (SvTIED_mg((SV*)av, 'P'))
+		    if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(sv);
 		    SvREFCNT_dec(av);
 		    goto restore_sv;
@@ -897,7 +920,7 @@ Perl_leave_scope(pTHX_ I32 base)
 		SV *oval = HeVAL((HE*)ptr);
 		if (oval && oval != &PL_sv_undef) {
 		    ptr = &HeVAL((HE*)ptr);
-		    if (SvTIED_mg((SV*)hv, 'P'))
+		    if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(*(SV**)ptr);
 		    SvREFCNT_dec(hv);
 		    SvREFCNT_dec(sv);
@@ -912,10 +935,6 @@ Perl_leave_scope(pTHX_ I32 base)
 	    PL_op = (OP*)SSPOPPTR;
 	    break;
 	case SAVEt_HINTS:
-	    if (GvHV(PL_hintgv)) {
-		SvREFCNT_dec((SV*)GvHV(PL_hintgv));
-		GvHV(PL_hintgv) = NULL;
-	    }
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
 	    break;
 	case SAVEt_COMPPAD: