Properly return a syntax error instead of segfaulting if each/keys/values is used...

diff --git a/op.c b/op.c
index c3736fa..4d85e23 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8257,21 +8257,23 @@ OP *
 Perl_ck_each(pTHX_ OP *o)
 {
     dVAR;
-    OP *kid = cLISTOPo->op_first;
+    OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL;
 
     PERL_ARGS_ASSERT_CK_EACH;
 
-    if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
-       const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
-           : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
-       o->op_type = new_type;
-       o->op_ppaddr = PL_ppaddr[new_type];
-    }
-    else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV
-              || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE)
-              )) {
-       bad_type(1, "hash or array", PL_op_desc[o->op_type], kid);
-       return o;
+    if (kid) {
+       if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
+           const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
+               : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
+           o->op_type = new_type;
+           o->op_ppaddr = PL_ppaddr[new_type];
+       }
+       else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV
+                   || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE)
+                 )) {
+           bad_type(1, "hash or array", PL_op_desc[o->op_type], kid);
+           return o;
+       }
     }
     return ck_fun(o);
 }

diff --git a/t/op/each.t b/t/op/each.t
index 1bd529d..b88f1ea 100644 (file)
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 39;
+plan tests => 42;
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -187,3 +187,9 @@ for (keys %u) {
     is($u{$u1}, 3, "U+0100        -> 3 ");
     is($u{$b1}, 4, "U+00C4 U+0080 -> 4");
 }
+
+# test for syntax errors
+for my $k (qw(each keys values)) {
+    eval $k;
+    like($@, qr/^Not enough arguments for $k/, "$k demands argument");
+}