Merge 8739008 into facfab6

op.c

@@ -15342,6 +15342,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)
 {
@@ -15353,10 +15369,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);

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

pod/perlfunc.pod

@@ -2012,6 +2012,15 @@ the iterator state used by anything else that might execute during the
 loop body.  To avoid these problems, use a C<foreach> loop rather than
 C<while>-C<each>.
 
+This extends to using C<each> on the result of an anonymous hash or
+array constructor.  A new underlying array or hash is created each
+time so each will always start iterating from scratch, eg:
+
+  # loops forever
+  while (my ($key, $value) = each @{ +{ a => 1 } }) {
+      print "$key=$value\n";
+  }
+
 This prints out your environment like the L<printenv(1)> program,
 but in a different order:
 

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