diff --git a/op.c b/op.c index fa45c4baefea..abe428ec4316 100644 --- a/op.c +++ b/op.c @@ -4299,6 +4299,52 @@ Perl_invert(pTHX_ OP *o) return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o)); } +/* Warn about possible precedence issues if op is a control flow operator that + does not terminate normally (return, exit, next, etc). +*/ +static void +S_check_terminates(pTHX_ OP *op) +{ + assert(op != NULL); + + /* [perl #59802]: Warn about things like "return $a or $b", which + is parsed as "(return $a) or $b" rather than "return ($a or + $b)". + */ + switch (op->op_type) { + case OP_NEXT: + case OP_LAST: + case OP_REDO: + /* XXX: Perhaps we should emit a stronger warning for these. + Even with the high-precedence operator they don't seem to do + anything sensible. + + But until we do, fall through here. + */ + case OP_EXIT: + case OP_RETURN: + case OP_DIE: + case OP_GOTO: + /* XXX: Currently we allow people to "shoot themselves in the + foot" by explicitly writing "(return $a) or $b". + + Warn unless we are looking at the result from folding or if + the programmer explicitly grouped the operators like this. + The former can occur with e.g. + + use constant FEATURE => ( $] >= ... ); + sub { not FEATURE and return or do_stuff(); } + */ + if (!op->op_folded && !(op->op_flags & OPf_PARENS)) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Possible precedence issue with control flow operator"); + /* XXX: Should we optimze this to "return $a;" (i.e. remove + the "or $b" part)? + */ + break; + } +} + OP * Perl_cmpchain_start(pTHX_ I32 type, OP *left, OP *right) { @@ -4307,6 +4353,8 @@ Perl_cmpchain_start(pTHX_ I32 type, OP *left, OP *right) if (!left) left = newOP(OP_NULL, 0); + else + S_check_terminates(aTHX_ left); if (!right) right = newOP(OP_NULL, 0); scalar(left); @@ -5912,10 +5960,12 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP || type == OP_NULL || type == OP_CUSTOM); - NewOp(1101, binop, 1, BINOP); - if (!first) first = newOP(OP_NULL, 0); + else + S_check_terminates(aTHX_ first); + + NewOp(1101, binop, 1, BINOP); OpTYPE_set(binop, type); binop->op_first = first; @@ -8706,47 +8756,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) first = *firstp; other = *otherp; - /* [perl #59802]: Warn about things like "return $a or $b", which - is parsed as "(return $a) or $b" rather than "return ($a or - $b)". NB: This also applies to xor, which is why we do it - here. - */ - switch (first->op_type) { - case OP_NEXT: - case OP_LAST: - case OP_REDO: - /* XXX: Perhaps we should emit a stronger warning for these. - Even with the high-precedence operator they don't seem to do - anything sensible. - - But until we do, fall through here. - */ - case OP_RETURN: - case OP_EXIT: - case OP_DIE: - case OP_GOTO: - /* XXX: Currently we allow people to "shoot themselves in the - foot" by explicitly writing "(return $a) or $b". - - Warn unless we are looking at the result from folding or if - the programmer explicitly grouped the operators like this. - The former can occur with e.g. - - use constant FEATURE => ( $] >= ... ); - sub { not FEATURE and return or do_stuff(); } - */ - if (!first->op_folded && !(first->op_flags & OPf_PARENS)) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Possible precedence issue with control flow operator"); - /* XXX: Should we optimze this to "return $a;" (i.e. remove - the "or $b" part)? - */ - break; - } - if (type == OP_XOR) /* Not short circuit, but here by precedence. */ return newBINOP(type, flags, scalar(first), scalar(other)); + S_check_terminates(aTHX_ first); + assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP || type == OP_CUSTOM); @@ -8917,6 +8931,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) if (!trueop) return newLOGOP(OP_OR, 0, first, falseop); + S_check_terminates(aTHX_ first); scalarboolean(first); if ((cstop = search_const(first))) { /* Left or right arm of the conditional? */ diff --git a/t/lib/warnings/op b/t/lib/warnings/op index d9de0a441f4c..6a2c181b7c2e 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -1818,26 +1818,28 @@ sub do_warn_7 { exit $a or $b; } sub do_warn_8 { exit $a and $b; } sub do_warn_9 { exit $a xor $b; } -# Since exit is an unary operator, it is even stronger than -# || and &&. +# Since exit is a unary operator, it is even stronger than +# ||, &&, ?:, and !=. sub do_warn_10 { exit $a || $b; } sub do_warn_11 { exit $a && $b; } +sub do_warn_12 { exit $a ? 0 : $b; } +sub do_warn_13 { exit $a != $b; } -sub do_warn_12 { goto $a or $b; } -sub do_warn_13 { goto $a and $b; } -sub do_warn_14 { goto $a xor $b; } -sub do_warn_15 { next $a or $b while(1); } -sub do_warn_16 { next $a and $b while(1); } -sub do_warn_17 { next $a xor $b while(1); } -sub do_warn_18 { last $a or $b while(1); } -sub do_warn_19 { last $a and $b while(1); } -sub do_warn_20 { last $a xor $b while(1); } -sub do_warn_21 { redo $a or $b while(1); } -sub do_warn_22 { redo $a and $b while(1); } -sub do_warn_23 { redo $a xor $b while(1); } +sub do_warn_14 { goto $a or $b; } +sub do_warn_15 { goto $a and $b; } +sub do_warn_16 { goto $a xor $b; } +sub do_warn_17 { next $a or $b while(1); } +sub do_warn_18 { next $a and $b while(1); } +sub do_warn_19 { next $a xor $b while(1); } +sub do_warn_20 { last $a or $b while(1); } +sub do_warn_21 { last $a and $b while(1); } +sub do_warn_22 { last $a xor $b while(1); } +sub do_warn_23 { redo $a or $b while(1); } +sub do_warn_24 { redo $a and $b while(1); } +sub do_warn_25 { redo $a xor $b while(1); } # These get re-written to "(return/die $a) and $b" -sub do_warn_24 { $b if return $a; } -sub do_warn_25 { $b if die $a; } +sub do_warn_26 { $b if return $a; } +sub do_warn_27 { $b if die $a; } EXPECT Possible precedence issue with control flow operator at - line 3. Possible precedence issue with control flow operator at - line 4. @@ -1850,8 +1852,8 @@ Possible precedence issue with control flow operator at - line 10. Possible precedence issue with control flow operator at - line 11. Possible precedence issue with control flow operator at - line 15. Possible precedence issue with control flow operator at - line 16. +Possible precedence issue with control flow operator at - line 17. Possible precedence issue with control flow operator at - line 18. -Possible precedence issue with control flow operator at - line 19. Possible precedence issue with control flow operator at - line 20. Possible precedence issue with control flow operator at - line 21. Possible precedence issue with control flow operator at - line 22. @@ -1862,8 +1864,10 @@ Possible precedence issue with control flow operator at - line 26. Possible precedence issue with control flow operator at - line 27. Possible precedence issue with control flow operator at - line 28. Possible precedence issue with control flow operator at - line 29. +Possible precedence issue with control flow operator at - line 30. Possible precedence issue with control flow operator at - line 31. -Possible precedence issue with control flow operator at - line 32. +Possible precedence issue with control flow operator at - line 33. +Possible precedence issue with control flow operator at - line 34. ######## # op.c # (same as above, except these should not warn)