Skip to content

Commit 708c734

Browse files
maukejkeenan
authored andcommitted
B::Deparse: retain () around ! if omitting them would warn
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.
1 parent a97e8c6 commit 708c734

File tree

2 files changed

+61
-11
lines changed

2 files changed

+61
-11
lines changed

lib/B/Deparse.pm

Lines changed: 49 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
# This is based on the module of the same name by Malcolm Beattie,
88
# but essentially none of his code remains.
99

10-
package B::Deparse 1.78;
10+
package B::Deparse 1.79;
1111
use strict;
1212
use Carp;
1313
use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -3034,6 +3034,25 @@ sub deparse_binop_right {
30343034
}
30353035
}
30363036

3037+
my %can_warn_about_lhs_not;
3038+
BEGIN {
3039+
%can_warn_about_lhs_not = map +($_ => 1), qw(
3040+
==
3041+
!=
3042+
<
3043+
<=
3044+
>
3045+
>=
3046+
eq
3047+
ne
3048+
lt
3049+
le
3050+
gt
3051+
ge
3052+
isa
3053+
);
3054+
}
3055+
30373056
sub binop {
30383057
my $self = shift;
30393058
my ($op, $cx, $opname, $prec, $flags) = (@_, 0);
@@ -3049,15 +3068,21 @@ sub binop {
30493068
}
30503069
my $leftop = $left;
30513070
$left = $self->deparse_binop_left($op, $left, $prec);
3052-
$left = "($left)" if $flags & LIST_CONTEXT
3053-
and $left !~ /^(my|our|local|state|)\s*[\@%\(]/
3054-
|| do {
3055-
# Parenthesize if the left argument is a
3056-
# lone repeat op.
3057-
my $left = $leftop->first->sibling;
3058-
$left->name eq 'repeat'
3059-
&& null($left->sibling);
3060-
};
3071+
$left = "($left)"
3072+
if $flags & LIST_CONTEXT
3073+
and $left !~ /^(my|our|local|state|)\s*[\@%\(]/
3074+
|| do {
3075+
# Parenthesize if the left argument is a
3076+
# lone repeat op.
3077+
my $left = $leftop->first->sibling;
3078+
$left->name eq 'repeat'
3079+
&& null($left->sibling);
3080+
}
3081+
or
3082+
$can_warn_about_lhs_not{$opname}
3083+
and $leftop->name eq 'not'
3084+
and $leftop->flags & OPf_PARENS
3085+
and $left !~ /\(/;
30613086
$right = $self->deparse_binop_right($op, $right, $prec);
30623087
return $self->maybe_parens("$left $opname$eq $right", $cx, $prec);
30633088
}
@@ -4214,7 +4239,12 @@ sub pp_null {
42144239
} elsif (!null($op->first->sibling) and
42154240
$op->first->sibling->name =~ /^transr?\z/ and
42164241
$op->first->sibling->flags & OPf_STACKED) {
4217-
return $self->maybe_parens($self->deparse($op->first, 20) . " =~ "
4242+
my $lhs = $self->deparse($op->first, 20);
4243+
$lhs = "($lhs)"
4244+
if $op->first->name eq 'not'
4245+
and $op->first->flags & OPf_PARENS
4246+
and $lhs !~ /\(/;
4247+
return $self->maybe_parens( "$lhs =~ "
42184248
. $self->deparse($op->first->sibling, 20),
42194249
$cx, 20);
42204250
} elsif ($op->flags & OPf_SPECIAL && $cx < 1 && !$op->targ) {
@@ -6362,6 +6392,10 @@ sub matchop {
63626392
if ($op->name ne 'split' && $op->flags & OPf_STACKED) {
63636393
$binop = 1;
63646394
$var = $self->deparse($kid, 20);
6395+
$var = "($var)"
6396+
if $kid->name eq 'not'
6397+
and $kid->flags & OPf_PARENS
6398+
and $var !~ /\(/;
63656399
$kid = $kid->sibling;
63666400
}
63676401
# not $name; $name will be 'm' for both match and split
@@ -6523,6 +6557,10 @@ sub pp_subst {
65236557
if ($op->flags & OPf_STACKED) {
65246558
$binop = 1;
65256559
$var = $self->deparse($kid, 20);
6560+
$var = "($var)"
6561+
if $kid->name eq 'not'
6562+
and $kid->flags & OPf_PARENS
6563+
and $var !~ /\(/;
65266564
$kid = $kid->sibling;
65276565
}
65286566
elsif (my $targ = $op->targ) {

lib/B/Deparse.t

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3344,3 +3344,15 @@ my $z = __PACKAGE__;
33443344
# CONTEXT use feature "state";
33453345
state sub FOO () { 42 }
33463346
print 42, "\n";
3347+
####
3348+
# CONTEXT use feature 'isa';
3349+
# GH #22661 ! vs comparisons
3350+
my $p;
3351+
$_ = (!$p) == 1;
3352+
$_ = (!$p) != 1;
3353+
$_ = (!$p) eq '';
3354+
$_ = (!$p) ne '';
3355+
$_ = (!$p) isa 'Some::Class';
3356+
$_ = (!$p) =~ tr/1//;
3357+
$_ = (!$p) =~ /1/;
3358+
$_ = (!$p) =~ s/1//r;

0 commit comments

Comments
 (0)