warn when using each on an anonymous hash or array

We've had three tickets over the years where the user has been confused
by the behaviour of each on an anonymous array or hash, there's no way
to tell if other users have been struck by the same issue, so make it
easier to diagnose by producing a warning.

3 files changed, 153 insertions, 1 deletions

diff --git a/op.c b/op.c
index aab97389f2..f25c6f518d 100644
--- a/op.c
+++ b/op.c
@@ -15350,6 +15350,22 @@ Perl_ck_tell(pTHX_ OP *o)
     return o;
 }
 
+PERL_STATIC_INLINE OP *
+S_last_non_null_kid(OP *o) {
+    OP *last = NULL;
+    if (cUNOPo->op_flags & OPf_KIDS) {
+        OP *k = cLISTOPo->op_first;
+        while (k) {
+            if (k->op_type != OP_NULL) {
+                last = k;
+            }
+            k = OpSIBLING(k);
+        }
+    }
+
+    return last;
+}
+
 OP *
 Perl_ck_each(pTHX_ OP *o)
 {
@@ -15361,10 +15377,60 @@ Perl_ck_each(pTHX_ OP *o)
     if (kid) {
         switch (kid->op_type) {
             case OP_PADHV:
+                break;
+
             case OP_RV2HV:
+                /* Catch out an anonhash here, since the behaviour might be
+                 * confusing.
+                 *
+                 * The typical tree is:
+                 *
+                 *     rv2hv
+                 *         scope
+                 *             null
+                 *             anonhash
+                 *
+                 * If the contents of the block is more complex you might get:
+                 *
+                 *     rv2hv
+                 *         leave
+                 *             enter
+                 *             ...
+                 *             anonhash
+                 *
+                 * Similarly for the anonlist version below.
+                 */
+                if (orig_type == OP_EACH &&
+                    ckWARN(WARN_SYNTAX) &&
+                    (cUNOPx(kid)->op_flags & OPf_KIDS) &&
+                    ( cUNOPx(kid)->op_first->op_type == OP_SCOPE ||
+                      cUNOPx(kid)->op_first->op_type == OP_LEAVE) &&
+                    (cUNOPx(kid)->op_first->op_flags & OPf_KIDS)) {
+                    /* look for last non-null kid, since we might have:
+                       each %{ some code ; +{ anon hash } }
+                    */
+                    OP *k = S_last_non_null_kid(cUNOPx(kid)->op_first);
+                    if (k && k->op_type == OP_ANONHASH) {
+                        /* diag_listed_as: each on anonymous %s will always start from the beginning */
+                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "each on anonymous hash will always start from the beginning");
+                    }
+                }
                 break;
-            case OP_PADAV:
             case OP_RV2AV:
+                if (orig_type == OP_EACH &&
+                    ckWARN(WARN_SYNTAX) &&
+                    (cUNOPx(kid)->op_flags & OPf_KIDS) &&
+                    (cUNOPx(kid)->op_first->op_type == OP_SCOPE ||
+                     cUNOPx(kid)->op_first->op_type == OP_LEAVE) &&
+                    (cUNOPx(kid)->op_first->op_flags & OPf_KIDS)) {
+                    OP *k = S_last_non_null_kid(cUNOPx(kid)->op_first);
+                    if (k && k->op_type == OP_ANONLIST) {
+                        /* diag_listed_as: each on anonymous %s will always start from the beginning */
+                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "each on anonymous array will always start from the beginning");
+                    }
+                }
+                /* FALLTHROUGH */
+	    case OP_PADAV:
                 OpTYPE_set(o, orig_type == OP_EACH ? OP_AEACH
                             : orig_type == OP_KEYS ? OP_AKEYS
                             :                        OP_AVALUES);
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index cb03322478..a799959b66 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2144,6 +2144,12 @@ already been freed.
 (W unpack) You have applied the same modifier more than once after a
 type in a pack template.  See L<perlfunc/pack>.
 
+=item each on anonymous %s will always start from the beginning
+
+(W syntax) You called L<each|perlfunc/each> on an anonymous hash or
+array.  Since a new hash or array is created each time, each() will
+restart iterating over your hash or array every time.
+
 =item elseif should be elsif
 
 (S syntax) There is no keyword "elseif" in Perl because Larry thinks
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 0012e74e52..20a5f0c2d2 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -2063,3 +2063,83 @@ Useless use of a constant (32) in void context at - line 11.
 Useless use of a constant (41) in void context at - line 14.
 Useless use of a constant (42) in void context at - line 14.
 Useless use of a constant (51) in void context at - line 16.
+########
+# NAME warn on each on anonymous hash (simple)
+{
+    while (my ($k, $v) = each %{ +{ a => 1 }}) {
+        print $k, "\n";
+        last;
+    }
+}
+use warnings;
+{
+    while (my ($k, $v) = each %{ +{ b => 1 }}) {
+        print $k, "\n";
+        last;
+    }
+}
+EXPECT
+each on anonymous hash will always start from the beginning at - line 9.
+a
+b
+########
+# NAME warn each on anonymous hash (more complex)
+{
+    while (my ($k, $v) = each %{; print "c\n"; +{ a => 1 } }) {
+        print $k, "\n";
+        last;
+    }
+}
+use warnings;
+{
+    while (my ($k, $v) = each %{; print "d\n"; +{ b => 1 } }) {
+        print $k, "\n";
+        last
+    }
+}
+EXPECT
+each on anonymous hash will always start from the beginning at - line 9.
+c
+a
+d
+b
+########
+# NAME warn on each on anonymous array (simple)
+{
+    while (my ($k, $v) = each @{ [ "a", "b" ] }) {
+        print $v, "\n";
+        last;
+    }
+}
+use warnings;
+{
+    while (my ($k, $v) = each @{ [ "b", "a" ] }) {
+        print $v, "\n";
+        last;
+    }
+}
+EXPECT
+each on anonymous array will always start from the beginning at - line 9.
+a
+b
+########
+# NAME warn on each on anonymous array (more complex)
+{
+    while (my ($k, $v) = each @{; print "c\n"; [ "a", "b" ] }) {
+        print $v, "\n";
+        last;
+    }
+}
+use warnings;
+{
+    while (my ($k, $v) = each @{; print "d\n"; [ "b", "a" ] }) {
+        print $v, "\n";
+        last;
+    }
+}
+EXPECT
+each on anonymous array will always start from the beginning at - line 9.
+c
+a
+d
+b