From e1d3ed996ab025cea38d04e4751ee57ac200de85 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 15 Mar 2021 17:17:13 +1100 Subject: [PATCH] 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. --- op.c | 68 +++++++++++++++++++++++++++++++++++++++- pod/perldiag.pod | 6 ++++ t/lib/warnings/op | 80 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 153 insertions(+), 1 deletion(-) diff --git a/op.c b/op.c index aab97389f2b4..f25c6f518d3a 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 cb0332247850..a799959b66b4 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. +=item each on anonymous %s will always start from the beginning + +(W syntax) You called L 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 0012e74e5293..20a5f0c2d27e 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