warn about !$x == $y, !$x =~ /abc/, and similar constructs

Commit 2f48e46b3f6d2d introduced a warning for logical negation as the
left operand of the `isa` operator, which likely indicates a precedence
problem (i.e. the programmer wrote `! $x isa $y` when they probably
meant `!($x isa $y)`).

This commit extends the warning to all (in)equality comparisons (`==`,
`!=`, `<`, `>`, `<=`, `>=`, `eq`, `ne`, `lt`, `gt`, `le`, `ge`) as well
as binding operations (`=~`, `!~`).

As an indication that such a warning is useful in the real world, the
core currently contains two files with (likely broken) code that
triggers this warning:

  - ./cpan/Test-Simple/lib/Test2/Hub.pm
  - ./cpan/Scalar-List-Utils/t/uniqnum.t

embed.h

@@ -1242,6 +1242,7 @@
 #     define ck_rfun(a)                         Perl_ck_rfun(aTHX_ a)
 #     define ck_rvconst(a)                      Perl_ck_rvconst(aTHX_ a)
 #     define ck_sassign(a)                      Perl_ck_sassign(aTHX_ a)
+#     define ck_scmp(a)                         Perl_ck_scmp(aTHX_ a)
 #     define ck_select(a)                       Perl_ck_select(aTHX_ a)
 #     define ck_shift(a)                        Perl_ck_shift(aTHX_ a)
 #     define ck_sort(a)                         Perl_ck_sort(aTHX_ a)

op.c

@@ -4297,6 +4297,11 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
             o = right;
         }
         else {
+            if (left->op_type == OP_NOT && !(left->op_flags & OPf_PARENS)) {
+                Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE),
+                    "Possible precedence problem between ! and %s", PL_op_desc[rtype]
+                );
+            }
             right->op_flags |= OPf_STACKED;
             if (rtype != OP_MATCH && rtype != OP_TRANSR &&
             ! (rtype == OP_TRANS &&
@@ -12104,6 +12109,18 @@ Perl_ck_bitop(pTHX_ OP *o)
     return o;
 }
 
+static void
+check_precedence_not_vs_cmp(pTHX_ const OP *const o)
+{
+    /* warn for !$x == 42, but not !$x == !$y */
+    const OP *const kid = cUNOPo->op_first;
+    if (kid->op_type == OP_NOT && !(kid->op_flags & OPf_PARENS) && OpSIBLING(kid)->op_type != OP_NOT) {
+        Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE),
+            "Possible precedence problem between ! and %s", OP_DESC(o)
+        );
+    }
+}
+
 PERL_STATIC_INLINE bool
 is_dollar_bracket(pTHX_ const OP * const o)
 {
@@ -12151,6 +12168,8 @@ Perl_ck_cmp(pTHX_ OP *o)
                         "$[ used in %s (did you mean $] ?)", OP_DESC(o));
     }
 
+    check_precedence_not_vs_cmp(aTHX_ o);
+
     /* convert (index(...) == -1) and variations into
      *   (r)index/BOOL(,NEG)
      */
@@ -12230,6 +12249,17 @@ Perl_ck_cmp(pTHX_ OP *o)
     return indexop;
 }
 
+/* for slt, sgt, sle, sge, seq, sne */
+
+OP *
+Perl_ck_scmp(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_CK_SCMP;
+
+    check_precedence_not_vs_cmp(aTHX_ o);
+
+    return o;
+}
 
 OP *
 Perl_ck_concat(pTHX_ OP *o)
@@ -15125,7 +15155,7 @@ Perl_ck_isa(pTHX_ OP *o)
     /* !$x isa Some::Class  # probably meant !($x isa Some::Class) */
     if (objop->op_type == OP_NOT && !(objop->op_flags & OPf_PARENS)) {
         Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE),
-            "Possible precedence problem on isa operator"
+            "Possible precedence problem between ! and %s", OP_DESC(o)
         );
     }
 

opcode.h

@@ -1494,12 +1494,12 @@ INIT({
 	Perl_ck_cmp,		/* i_ne */
 	Perl_ck_null,		/* ncmp */
 	Perl_ck_null,		/* i_ncmp */
-	Perl_ck_null,		/* slt */
-	Perl_ck_null,		/* sgt */
-	Perl_ck_null,		/* sle */
-	Perl_ck_null,		/* sge */
-	Perl_ck_null,		/* seq */
-	Perl_ck_null,		/* sne */
+	Perl_ck_scmp,		/* slt */
+	Perl_ck_scmp,		/* sgt */
+	Perl_ck_scmp,		/* sle */
+	Perl_ck_scmp,		/* sge */
+	Perl_ck_scmp,		/* seq */
+	Perl_ck_scmp,		/* sne */
 	Perl_ck_null,		/* scmp */
 	Perl_ck_bitop,		/* bit_and */
 	Perl_ck_bitop,		/* bit_xor */

pod/perldiag.pod

@@ -5427,6 +5427,42 @@ Note this may be also triggered for constructs like:
 
     sub { 1 if die; }
 
+=item Possible precedence problem between ! and %s
+
+(W precedence) You wrote something like
+
+    !$x < $y               # parsed as: (!$x) < $y
+    !$x eq $y              # parsed as: (!$x) eq $y
+    !$x =~ /regex/         # parsed as: (!$x) =~ /regex/
+    !$obj isa Some::Class  # parsed as: (!$obj) isa Some::Class
+
+but because C<!> has higher precedence than comparison operators, C<=~>, and
+C<isa>, this is interpreted as comparing/matching the logical negation of the
+first operand, instead of negating the result of the comparison/match.
+
+To disambiguate, either use a negated comparison/binding operator:
+
+    $x >= $y
+    $x ne $y
+    $x !~ /regex/
+
+... or parentheses:
+
+    !($x < $y)
+    !($x eq $y)
+    !($x =~ /regex/)
+    !($obj isa Some::Class)
+
+... or the low-precedence C<not> operator:
+
+    not $x < $y
+    not $x eq $y
+    not $x =~ /regex/
+    not $obj isa Some::Class
+
+(If you did mean to compare the boolean result of negating the first operand,
+parenthesize as C<< (!$x) < $y >>, C<< (!$x) eq $y >>, etc.)
+
 =item Possible precedence problem on bitwise %s operator
 
 (W precedence) Your program uses a bitwise logical operator in conjunction
@@ -5453,19 +5489,6 @@ If instead you intended to match the word 'foo' at the end of the line
 followed by whitespace and the word 'bar' on the next line then you can use
 C<m/$(?)\/> (for example: C<m/foo$(?)\s+bar/>).
 
-=item Possible precedence problem on isa operator
-
-(W precedence) You wrote something like
-
-    !$obj isa Some::Class
-
-but because C<!> has higher precedence than C<isa>, this is interpreted as
-C<(!$obj) isa Some::Class>, which checks whether a boolean is an instance of
-C<Some::Class>. If you want to negate the result of C<isa> instead, use one of:
-
-    !($obj isa Some::Class)   # explicit parentheses
-    not $obj isa Some::Class  # low-precedence 'not' operator
-
 =item Possible unintended interpolation of %s in string
 
 (W ambiguous) You said something like '@foo' in a double-quoted string

proto.h

@@ -6465,6 +6465,13 @@ Perl_ck_sassign(pTHX_ OP *o)
 # define PERL_ARGS_ASSERT_CK_SASSIGN            \
         assert(o)
 
+PERL_CALLCONV OP *
+Perl_ck_scmp(pTHX_ OP *o)
+        __attribute__warn_unused_result__
+        __attribute__visibility__("hidden");
+# define PERL_ARGS_ASSERT_CK_SCMP               \
+        assert(o)
+
 PERL_CALLCONV OP *
 Perl_ck_select(pTHX_ OP *o)
         __attribute__warn_unused_result__

regen/opcodes

@@ -153,12 +153,12 @@ i_ne		integer ne (!=)		ck_cmp		ifs2	S S<
 ncmp		numeric comparison (<=>)	ck_null		Iifst2	S S<
 i_ncmp		integer comparison (<=>)	ck_null		ifst2	S S<
 
-slt		string lt		ck_null		ifs2	S S
-sgt		string gt		ck_null		ifs2	S S
-sle		string le		ck_null		ifs2	S S
-sge		string ge		ck_null		ifs2	S S
-seq		string eq		ck_null		ifs2	S S
-sne		string ne		ck_null		ifs2	S S
+slt		string lt		ck_scmp		ifs2	S S
+sgt		string gt		ck_scmp		ifs2	S S
+sle		string le		ck_scmp		ifs2	S S
+sge		string ge		ck_scmp		ifs2	S S
+seq		string eq		ck_scmp		ifs2	S S
+sne		string ne		ck_scmp		ifs2	S S
 scmp		string comparison (cmp)	ck_null		ifst2	S S
 
 bit_and		bitwise and (&)		ck_bitop	fst2	S S|

t/lib/warnings/op

@@ -1582,9 +1582,82 @@ $a = (!$b) isa Some::Class;
 $a = !($b) isa Some::Class;  # should warn
 $a = !($b isa Some::Class);
 $a = not $b isa Some::Class;
+
+my $code = "#line 1 [cmp]\n";
+for my $op (qw( == != < > <= >= eq ne lt gt le ge )) {
+    $code .= "\$a = !\$a $op \$b;\n";  # should warn
+    $code .= "\$a = (!\$a) $op \$b;\n";
+    $code .= "\$a = !(\$a) $op \$b;\n";  # should warn
+    $code .= "\$a = !(\$a $op \$b);\n";
+    $code .= "\$a = not \$a $op \$b;\n";
+}
+$a = $b = 0;
+eval $code;
+die $@ if $@;
+
+$_ = '';
+$a = !/x/;
+
+$code = "#line 1 [bind]\n";
+for my $rhs (qw( /x/ $b tr/x/x/ tr!x!y!r s!x!y!r )) {
+    for my $bind ('=~', $rhs =~ /!r\z/ ? () : '!~') {
+        $code .= "\$a = !\$a $bind $rhs;\n";  # should warn
+        $code .= "\$a = (!\$a) $bind $rhs;\n";
+        $code .= "\$a = !(\$a) $bind $rhs;\n";  # should warn
+        $code .= "\$a = !(\$a $bind $rhs);\n";
+        $code .= "\$a = not \$a $bind $rhs;\n";
+    }
+}
+$a = $b = 0;
+eval $code;
+die $@ if $@;
+
+# doesn't compile, but should warn anyway
+eval "#line 1 [extra]\n" . '$a = !$a =~ s/x/y/';
 EXPECT
-Possible precedence problem on isa operator at - line 4.
-Possible precedence problem on isa operator at - line 6.
+Possible precedence problem between ! and derived class test at - line 4.
+Possible precedence problem between ! and derived class test at - line 6.
+Possible precedence problem between ! and numeric eq (==) at [cmp] line 1.
+Possible precedence problem between ! and numeric eq (==) at [cmp] line 3.
+Possible precedence problem between ! and numeric ne (!=) at [cmp] line 6.
+Possible precedence problem between ! and numeric ne (!=) at [cmp] line 8.
+Possible precedence problem between ! and numeric lt (<) at [cmp] line 11.
+Possible precedence problem between ! and numeric lt (<) at [cmp] line 13.
+Possible precedence problem between ! and numeric gt (>) at [cmp] line 16.
+Possible precedence problem between ! and numeric gt (>) at [cmp] line 18.
+Possible precedence problem between ! and numeric le (<=) at [cmp] line 21.
+Possible precedence problem between ! and numeric le (<=) at [cmp] line 23.
+Possible precedence problem between ! and numeric ge (>=) at [cmp] line 26.
+Possible precedence problem between ! and numeric ge (>=) at [cmp] line 28.
+Possible precedence problem between ! and string eq at [cmp] line 31.
+Possible precedence problem between ! and string eq at [cmp] line 33.
+Possible precedence problem between ! and string ne at [cmp] line 36.
+Possible precedence problem between ! and string ne at [cmp] line 38.
+Possible precedence problem between ! and string lt at [cmp] line 41.
+Possible precedence problem between ! and string lt at [cmp] line 43.
+Possible precedence problem between ! and string gt at [cmp] line 46.
+Possible precedence problem between ! and string gt at [cmp] line 48.
+Possible precedence problem between ! and string le at [cmp] line 51.
+Possible precedence problem between ! and string le at [cmp] line 53.
+Possible precedence problem between ! and string ge at [cmp] line 56.
+Possible precedence problem between ! and string ge at [cmp] line 58.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 1.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 3.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 6.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 8.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 11.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 13.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 16.
+Possible precedence problem between ! and pattern match (m//) at [bind] line 18.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 21.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 23.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 26.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 28.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 31.
+Possible precedence problem between ! and transliteration (tr///) at [bind] line 33.
+Possible precedence problem between ! and substitution (s///) at [bind] line 36.
+Possible precedence problem between ! and substitution (s///) at [bind] line 38.
+Possible precedence problem between ! and substitution (s///) at [extra] line 1.
 ########
 # op.c
 use integer;