From @hvds

[Too late for 5.8.0, sorry.]

Nicholas Clark once wrote:
:I've got this as short as possible.

This script:
perl -we 'sub f { local $_[0] } f()'
coredumps in leave_scope, because (to try and take advantage of a goto)
it frees the av before restoring the sv into it.

Fixing that still leaves the 'attempt to free' problems in the original
code, which can be reduced to:
crypt% ./perl -we 'sub a { local($_[1],$_[2],$_[3]) } sub b { $x++ && a(0..2) for 1..2 } b() for 1..2'
Name "main::x" used only once: possible typo at -e line 1.
Attempt to free unreferenced scalar at -e line 1.
Attempt to free temp prematurely: SV 0x814b288 at -e line 1.
Attempt to free unreferenced scalar at -e line 1.
crypt%
.... which I haven't yet attempted to investigate.

I note that this test case still coredumps when run with '-Ds', though
it gets further than without the patch below. I suspect that's
a separate problem, probably due to bitrot in the rarely used -Ds code.

The patch below breaks out the code it wants to goto, so that we can
conveniently call it before the SvREFCNT_dec(av), and fixes up similar
problems in parallel branches.

This patch requires 'make regen_headers'.

Hugo

Inline Patch

--- embed.fnc.old	Tue Jul 16 05:02:57 2002
+++ embed.fnc	Thu Jul 18 15:30:20 2002
@@ -1190,6 +1190,7 @@
 #endif
 
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
+s	|void	|restore_sv	|SV *value|SV **ptr
 s	|SV*	|save_scalar_at	|SV **sptr
 #endif
 
--- scope.c.old	Sun May 19 02:32:24 2002
+++ scope.c	Thu Jul 18 15:32:35 2002
@@ -654,6 +654,43 @@
     return start;
 }
 
+void S_restore_sv(SV *value, SV **ptr) {
+    SV *sv = *ptr;
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
+			  "restore svref: %p %p:%s -> %p:%s\n",
+			  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
+	SvTYPE(sv) != SVt_PVGV)
+    {
+	(void)SvUPGRADE(value, SvTYPE(sv));
+	SvMAGIC(value) = SvMAGIC(sv);
+	SvFLAGS(value) |= SvMAGICAL(sv);
+	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_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);
+    *ptr = value;
+    PL_localizing = 2;
+    SvSETMAGIC(value);
+    PL_localizing = 0;
+    SvREFCNT_dec(value);
+}
+
 void
 Perl_leave_scope(pTHX_ I32 base)
 {
@@ -681,9 +718,9 @@
 	case SAVEt_SV:				/* scalar reference */
 	    value = (SV*)SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
-	    ptr = &GvSV(gv);
+	    restore_sv(value, (SV**)&GvSV(gv));
 	    SvREFCNT_dec(gv);
-	    goto restore_sv;
+	    break;
 	case SAVEt_GENERIC_PVREF:		/* generic pv */
 	    str = (char*)SSPOPPTR;
 	    ptr = SSPOPPTR;
@@ -714,42 +751,7 @@
 	    break;
 	case SAVEt_SVREF:			/* scalar reference */
 	    value = (SV*)SSPOPPTR;
-	    ptr = SSPOPPTR;
-	restore_sv:
-	    sv = *(SV**)ptr;
-	    DEBUG_S(PerlIO_printf(Perl_debug_log,
-				  "restore svref: %p %p:%s -> %p:%s\n",
-				  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
-	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
-		SvTYPE(sv) != SVt_PVGV)
-	    {
-		(void)SvUPGRADE(value, SvTYPE(sv));
-		SvMAGIC(value) = SvMAGIC(sv);
-		SvFLAGS(value) |= SvMAGICAL(sv);
-		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_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);
-	    *(SV**)ptr = value;
-	    PL_localizing = 2;
-	    SvSETMAGIC(value);
-	    PL_localizing = 0;
-	    SvREFCNT_dec(value);
+	    restore_sv(value, (SV**)SSPOPPTR);
 	    break;
 	case SAVEt_AV:				/* array reference */
 	    av = (AV*)SSPOPPTR;
@@ -951,8 +953,9 @@
 		if (sv && sv != &PL_sv_undef) {
 		    if (SvTIED_mg((SV*)av, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(sv);
+		    restore_sv(value, (SV**)ptr);
 		    SvREFCNT_dec(av);
-		    goto restore_sv;
+		    break;
 		}
 	    }
 	    SvREFCNT_dec(av);
@@ -969,9 +972,10 @@
 		    ptr = &HeVAL((HE*)ptr);
 		    if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
 			(void)SvREFCNT_inc(*(SV**)ptr);
-		    SvREFCNT_dec(hv);
 		    SvREFCNT_dec(sv);
-		    goto restore_sv;
+		    restore_sv(value, (SV**)ptr);
+		    SvREFCNT_dec(hv);
+		    break;
 		}
 	    }
 	    SvREFCNT_dec(hv);
--- t/op/local.t.old	Mon May  6 17:36:23 2002
+++ t/op/local.t	Thu Jul 18 15:38:00 2002
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..75\n";
+print "1..76\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -257,3 +257,10 @@
 print "not " if exists $h{'z'}; print "ok 73\n";
 print "not " if exists $ENV{_A_}; print "ok 74\n";
 print "not " if exists $ENV{_B_}; print "ok 75\n";
+
+{
+    # [perl #1176] Attempt to free unreferenced scalar (in 49 lines)
+    sub localiser { local $_[0] }
+    localiser();
+    print "ok 76\n";
+}

Attempt to free unreferenced scalar (in 49 lines) #344

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions