Skip to content

Commit

Permalink
B::Deparse: retain () around ! if omitting them would warn
Browse files Browse the repository at this point in the history
Since 570fa43, we emit precedence warnings if the LHS of a comparison
or binding op starts with an unparenthesized logical negation (`!`, as
in `!$x == $y`). Explicit parens can be used to avoid the warning
(`(!$x) == $y`).

Teach B::Deparse to keep these parentheses even if they're not strictly
required by operator precedence because we don't want the deparsed code
to generate more warnings than the original code.

Fixes #22661.
  • Loading branch information
mauke authored and jkeenan committed Oct 30, 2024
1 parent a97e8c6 commit 708c734
Show file tree
Hide file tree
Showing 2 changed files with 61 additions and 11 deletions.
60 changes: 49 additions & 11 deletions lib/B/Deparse.pm
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
# This is based on the module of the same name by Malcolm Beattie,
# but essentially none of his code remains.

package B::Deparse 1.78;
package B::Deparse 1.79;
use strict;
use Carp;
use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
Expand Down Expand Up @@ -3034,6 +3034,25 @@ sub deparse_binop_right {
}
}

my %can_warn_about_lhs_not;
BEGIN {
%can_warn_about_lhs_not = map +($_ => 1), qw(
==
!=
<
<=
>
>=
eq
ne
lt
le
gt
ge
isa
);
}

sub binop {
my $self = shift;
my ($op, $cx, $opname, $prec, $flags) = (@_, 0);
Expand All @@ -3049,15 +3068,21 @@ sub binop {
}
my $leftop = $left;
$left = $self->deparse_binop_left($op, $left, $prec);
$left = "($left)" if $flags & LIST_CONTEXT
and $left !~ /^(my|our|local|state|)\s*[\@%\(]/
|| do {
# Parenthesize if the left argument is a
# lone repeat op.
my $left = $leftop->first->sibling;
$left->name eq 'repeat'
&& null($left->sibling);
};
$left = "($left)"
if $flags & LIST_CONTEXT
and $left !~ /^(my|our|local|state|)\s*[\@%\(]/
|| do {
# Parenthesize if the left argument is a
# lone repeat op.
my $left = $leftop->first->sibling;
$left->name eq 'repeat'
&& null($left->sibling);
}
or
$can_warn_about_lhs_not{$opname}
and $leftop->name eq 'not'
and $leftop->flags & OPf_PARENS
and $left !~ /\(/;
$right = $self->deparse_binop_right($op, $right, $prec);
return $self->maybe_parens("$left $opname$eq $right", $cx, $prec);
}
Expand Down Expand Up @@ -4214,7 +4239,12 @@ sub pp_null {
} elsif (!null($op->first->sibling) and
$op->first->sibling->name =~ /^transr?\z/ and
$op->first->sibling->flags & OPf_STACKED) {
return $self->maybe_parens($self->deparse($op->first, 20) . " =~ "
my $lhs = $self->deparse($op->first, 20);
$lhs = "($lhs)"
if $op->first->name eq 'not'
and $op->first->flags & OPf_PARENS
and $lhs !~ /\(/;
return $self->maybe_parens( "$lhs =~ "
. $self->deparse($op->first->sibling, 20),
$cx, 20);
} elsif ($op->flags & OPf_SPECIAL && $cx < 1 && !$op->targ) {
Expand Down Expand Up @@ -6362,6 +6392,10 @@ sub matchop {
if ($op->name ne 'split' && $op->flags & OPf_STACKED) {
$binop = 1;
$var = $self->deparse($kid, 20);
$var = "($var)"
if $kid->name eq 'not'
and $kid->flags & OPf_PARENS
and $var !~ /\(/;
$kid = $kid->sibling;
}
# not $name; $name will be 'm' for both match and split
Expand Down Expand Up @@ -6523,6 +6557,10 @@ sub pp_subst {
if ($op->flags & OPf_STACKED) {
$binop = 1;
$var = $self->deparse($kid, 20);
$var = "($var)"
if $kid->name eq 'not'
and $kid->flags & OPf_PARENS
and $var !~ /\(/;
$kid = $kid->sibling;
}
elsif (my $targ = $op->targ) {
Expand Down
12 changes: 12 additions & 0 deletions lib/B/Deparse.t
Original file line number Diff line number Diff line change
Expand Up @@ -3344,3 +3344,15 @@ my $z = __PACKAGE__;
# CONTEXT use feature "state";
state sub FOO () { 42 }
print 42, "\n";
####
# CONTEXT use feature 'isa';
# GH #22661 ! vs comparisons
my $p;
$_ = (!$p) == 1;
$_ = (!$p) != 1;
$_ = (!$p) eq '';
$_ = (!$p) ne '';
$_ = (!$p) isa 'Some::Class';
$_ = (!$p) =~ tr/1//;
$_ = (!$p) =~ /1/;
$_ = (!$p) =~ s/1//r;

0 comments on commit 708c734

Please sign in to comment.