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).

diff --git a/cop.h b/cop.h
index c91e9a4..86a67d0 100644 (file)
--- 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 b2c68d3..155313e 100644 (file)
--- 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 93ef4b3..046b338 100644 (file)
--- 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 7df44b6..6cef091 100644 (file)
--- 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 d8faec1..6b4e5c6 100644 (file)
--- 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");
+}