bad things happened with for $x (...) { *x = *y }

fix for [perl #21469]:
since the GP may be pulled from under us and freed, coredumps and strange
things can happen.

Fix this by storing a pointer to the GV in the loop block, rather than a
pointer to the GvSV slot. The ITHREADS variant already stores GV rather
than than &GvSV; extend this to non-threaded builds too.

Also, for both threaded and non-threaded, it used to push &GvSV on the
save stack. Fix this by introducing a new save type, SAVEt_GVSV.
This behaves similarly to SAVEt_SV, but without magic get/set.

This means that

    for $package_var (...)

is now close in behaviour to

    local $package_var = ...

(except for the magic bit).

5 files changed, 35 insertions, 11 deletions

diff --git a/cop.h b/cop.h
index c91e9a4a09..86a67d001e 100644
--- a/cop.h
+++ b/cop.h
@@ -469,15 +469,19 @@ struct block_loop {
 };
 
 #ifdef USE_ITHREADS
-#  define CxITERVAR(c)							\
+#  define CxITERVAR_PADSV(c) \
+	&CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ)
+#else
+#  define CxITERVAR_PADSV(c) ((c)->blk_loop.itervar_u.svp)
+#endif
+
+#define CxITERVAR(c)							\
 	((c)->blk_loop.itervar_u.oldcomppad				\
 	 ? (CxPADLOOP(c) 						\
-	    ? &CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ) \
+	    ? CxITERVAR_PADSV(c)					\
 	    : &GvSV((c)->blk_loop.itervar_u.gv))			\
 	 : (SV**)NULL)
-#else
-#  define CxITERVAR(c)		((c)->blk_loop.itervar_u.svp)
-#endif
+
 #define CxLABEL(c)	(0 + CopLABEL((c)->blk_oldcop))
 #define CxHASARGS(c)	(((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
 #define CxLVAL(c)	(0 + (c)->blk_u16)
diff --git a/pp_ctl.c b/pp_ctl.c
index b2c68d360a..155313e295 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1967,13 +1967,10 @@ PP(pp_enteriter)
     }
     else {					/* symbol table variable */
 	GV * const gv = MUTABLE_GV(POPs);
-	SV** svp = &GvSV(gv);	SAVEGENERICSV(*svp);
+	SV** svp = &GvSV(gv);
+	save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
 	*svp = newSV(0);
-#ifdef USE_ITHREADS
 	itervar = (void *)gv;
-#else
-	itervar = (void *)svp;
-#endif
     }
 
     if (PL_op->op_private & OPpITER_DEF)
diff --git a/scope.c b/scope.c
index 93ef4b3fc9..046b3387d5 100644
--- a/scope.c
+++ b/scope.c
@@ -778,9 +778,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);
diff --git a/scope.h b/scope.h
index 7df44b6471..6cef09162e 100644
--- a/scope.h
+++ b/scope.h
@@ -57,6 +57,7 @@
 #define SAVEt_ADELETE		46
 #define SAVEt_I32_SMALL		47
 #define SAVEt_INT_SMALL		48
+#define SAVEt_GVSV		49
 
 #define SAVEf_SETMAGIC		1
 #define SAVEf_KEEPOLDELEM	2
diff --git a/t/op/loopctl.t b/t/op/loopctl.t
index d8faec1b66..6b4e5c6476 100644
--- a/t/op/loopctl.t
+++ b/t/op/loopctl.t
@@ -36,7 +36,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 47 );
+plan( tests => 54 );
 
 my $ok;
 
@@ -978,3 +978,19 @@ cmp_ok($ok,'==',1,'dynamically scoped');
     cmp_ok("@a37725",'eq',"5 4 3 2",'bug 27725: reverse with empty slots bug');
 }
 
+# [perl #21469] bad things happened with for $x (...) { *x = *y }
+
+{
+    my $i = 1;
+    $x_21469  = 'X';
+    $y1_21469 = 'Y1';
+    $y2_21469 = 'Y2';
+    $y3_21469 = 'Y3';
+    for $x_21469 (1,2,3) {
+	is($x_21469, $i, "bug 21469: correct at start of loop $i");
+	*x_21469 = (*y1_21469, *y2_21469, *y3_21469)[$i-1];
+	is($x_21469, "Y$i", "bug 21469: correct at tail of loop $i");
+	$i++;
+    }
+    is($x_21469, 'X', "bug 21469: X okay at end of loop");
+}