This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix CxFOREACH
authorDavid Mitchell <davem@iabyn.com>
Mon, 21 Dec 2015 15:45:57 +0000 (15:45 +0000)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 09:18:36 +0000 (09:18 +0000)
It wasn't detecting CXt_LOOP_LAZYIV as a 'for' loop type. This only
affected 'given' and 'break' (which need to distinguish between being
in a 'given' block and being in a 'for' block).

cop.h
t/op/switch.t

diff --git a/cop.h b/cop.h
index ceb19ef..5ef01d1 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -983,7 +983,7 @@ struct subst {
     U8         sbu_rflags;
     U16                sbu_rxtainted;
     I32                sbu_oldsaveix; /* same as blku_oldsaveix */
-    /* all the fields above must be aligned with same-sized fields as blku * */
+    /* all the fields above must be aligned with same-sized fields as blk_u */
     SSize_t    sbu_iters;
     SSize_t    sbu_maxiters;
     char *     sbu_orig;
@@ -1108,7 +1108,7 @@ struct context {
                         == (CXt_EVAL|CXp_REAL))
 #define CxTRYBLOCK(c)  (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK))     \
                         == (CXt_EVAL|CXp_TRYBLOCK))
-#define CxFOREACH(c)   (   CxTYPE(cx) >= CXt_LOOP_LAZYSV               \
+#define CxFOREACH(c)   (   CxTYPE(cx) >= CXt_LOOP_LAZYIV               \
                          && CxTYPE(cx) <= CXt_LOOP_ARY)
 
 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
index 8e3851c..8b43ef6 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 no warnings 'experimental::smartmatch';
 
-plan tests => 189;
+plan tests => 193;
 
 # The behaviour of the feature pragma should be tested by lib/feature.t
 # using the tests in t/lib/feature/*. This file tests the behaviour of
@@ -1305,6 +1305,48 @@ unreified_check(undef,"");
     f2();
 }
 
+# check that 'when' handles all 'for' loop types
+
+{
+    my $i;
+
+    $i = 0;
+    for (1..3) {
+        when (1) {$i +=    1 }
+        when (2) {$i +=   10 }
+        when (3) {$i +=  100 }
+        default { $i += 1000 }
+    }
+    is($i, 111, "when in for 1..3");
+
+    $i = 0;
+    for ('a'..'c') {
+        when ('a') {$i +=    1 }
+        when ('b') {$i +=   10 }
+        when ('c') {$i +=  100 }
+        default { $i += 1000 }
+    }
+    is($i, 111, "when in for a..c");
+
+    $i = 0;
+    for (1,2,3) {
+        when (1) {$i +=    1 }
+        when (2) {$i +=   10 }
+        when (3) {$i +=  100 }
+        default { $i += 1000 }
+    }
+    is($i, 111, "when in for 1,2,3");
+
+    $i = 0;
+    my @a = (1,2,3);
+    for (@a) {
+        when (1) {$i +=    1 }
+        when (2) {$i +=   10 }
+        when (3) {$i +=  100 }
+        default { $i += 1000 }
+    }
+    is($i, 111, 'when in for @a');
+}
 
 
 # Okay, that'll do for now. The intricacies of the smartmatch