In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/843b15cc12d1b7f15c7624a8f097be474339d5a8?hp=2462c3ccada0e87002e4f7dc42bfcdfe36fe678a>
- Log ----------------------------------------------------------------- commit 843b15cc12d1b7f15c7624a8f097be474339d5a8 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 8 13:16:48 2011 -0800 [perl #74740] Deparse -(f()) correctly -(f()) was being deparsed as -f(), which is a filetest operator. Extra parens are needed for negation if the child op deparses with a single letter at the beginning. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 240d1b6fec0bdaf633ffc53476ade6401c251270 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 8 13:09:39 2011 -0800 Donât warn for open local *FH There is this ancient âPrecedence problemâ warning that warns for open followed by a bareword and then an operator that would have made open into a unary-precedence operator in Perl 4. It was not taking into account that the bareword might be a Perl keyword. In that case it shouldnât be warning. M t/lib/warnings/toke M toke.c commit 564cd6cb6e72228304bae646ccbe28cff6136367 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 8 12:51:19 2011 -0800 Deparse pipe(local *FH, local *FH) correctly This is a follow-up to commit 2462c3cca (bug #63558). I made it work with the first argument, but forgot the second. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 4d8ac5c735b4377aecb531044f04c9917054ba71 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 8 12:49:33 2011 -0800 Deparse (eof)+1 correctly If the parentheses are omitted, it means eof(1). To fix this, we surround the keyword with parentheses (if necessary according to precedence) if it is an unop, because a final () has a special meaning for some unops. For listops, we use surrounding parentheses only if the llafr does not apply. Otherwise we use a final (). M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/Deparse.pm | 27 ++++++++++++++++++++++----- dist/B-Deparse/t/deparse.t | 10 ++++++++++ t/lib/warnings/toke | 1 + toke.c | 1 + 4 files changed, 34 insertions(+), 5 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index 24b5606..10ab498 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -1629,7 +1629,13 @@ sub pfixop { my($op, $cx, $name, $prec, $flags) = (@_, 0); my $kid = $op->first; $kid = $self->deparse($kid, $prec); - return $self->maybe_parens(($flags & POSTFIX) ? "$kid$name" : "$name$kid", + return $self->maybe_parens(($flags & POSTFIX) + ? "$kid$name" + # avoid confusion with filetests + : $name eq '-' + && $kid =~ /^[a-zA-Z](?!\w)/ + ? "$name($kid)" + : "$name$kid", $cx, $prec); } @@ -1692,8 +1698,10 @@ sub unop { } return $self->maybe_parens_unop($name, $kid, $cx); } else { - return $self->keyword($name) - . ($op->flags & OPf_SPECIAL ? "()" : ""); + return $self->maybe_parens( + $self->keyword($name) . ($op->flags & OPf_SPECIAL ? "()" : ""), + $cx, 16, + ); } } @@ -2364,7 +2372,15 @@ sub listop { my(@exprs); my $parens = ($cx >= 5) || $self->{'parens'}; $kid ||= $op->first->sibling; - return $self->keyword($name) if null $kid; + # If there are no arguments, add final parentheses (or parenthesize the + # whole thing if the llafr does not apply) to account for cases like + # (return)+1 or setpgrp()+1. When the llafr does not apply, we use a + # precedence of 6 (< comma), as "return, 1" does not need parentheses. + if (null $kid) { + return $nollafr + ? $self->maybe_parens($self->keyword($name), $cx, 7) + : $self->keyword($name) . '()' x (7 < $cx); + } my $first; $name = "socketpair" if $name eq "sockpair"; my $fullname = $self->keyword($name); @@ -2384,7 +2400,8 @@ sub listop { if not $parens and not $nollafr and substr($first, 0, 1) eq "("; push @exprs, $first; $kid = $kid->sibling; - if (defined $proto && $proto =~ /^\*\*/ && $kid->name eq "rv2gv") { + if (defined $proto && $proto =~ /^\*\*/ && $kid->name eq "rv2gv" + && !($kid->private & OPpLVAL_INTRO)) { push @exprs, $self->deparse($kid->first, 6); $kid = $kid->sibling; } diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 52a20d9..d71eeaa 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -869,5 +869,15 @@ CORE::do({}); () = (-w $_) + 3; () = (-x $_) + 3; #### +# Precedence conundrums with argument-less function calls +() = (eof) + 1; +() = (return) + 1; +() = (return, 1); +() = setpgrp() + 1; +#### # [perl #63558] open local(*FH) open local *FH; +pipe local *FH, local *FH; +#### +# [perl #74740] -(f()) vs -f() +$_ = -(f()); diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 95612eb..25d53a0 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -644,6 +644,7 @@ Ambiguous use of -fred resolved as -&fred() at - line 11. ######## # toke.c open FOO || time; +open local *FOO; # should be ok EXPECT Precedence problem: open FOO should be open(FOO) at - line 2. ######## diff --git a/toke.c b/toke.c index e5da941..2c29c58 100644 --- a/toke.c +++ b/toke.c @@ -7672,6 +7672,7 @@ Perl_yylex(pTHX) if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) /* [perl #16184] */ && !(t[0] == '=' && t[1] == '>') + && !keyword(s, d-s, 0) ) { int parms_len = (int)(d-s); Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), -- Perl5 Master Repository
