In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5e5a163216c3593e94fd0a7d0b251dc6a82d8991?hp=af6a5d0ea1e02579009f9da9fc6444bbb2eb691d>
- Log ----------------------------------------------------------------- commit 5e5a163216c3593e94fd0a7d0b251dc6a82d8991 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 22:13:50 2011 -0800 Fix deparsing of "" =~ <any OPf_SPECIAL op> This is a regression in 5.14. $ ./perl -Ilib -MO=Deparse -e '"" =~ do{}' '' =~ ($_ =~ do { () }); -e syntax OK Commit a539498ab05 fixed the deparsing of "foo" =~ (1?/foo/:/bar/), in which /foo/ is implicitly bound to $_. Due to constant folding, the whole condition expression is reduced to "foo" =~ /foo/, but with /foo/ still bound to $_. /foo/ is marked OPf_SPECIAL, which allows us to distinguish the cases. The fix, which added "$_ =~" explic- itly, did not check that the op was a match op, so any op on the rhs with the OPf_SPECIAL flag set could trigger the same special case. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 41df74e3c36f10fc6ff6e27a5505709a5d21c1cc Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 22:40:28 2011 -0800 Deparse.pm: More functions that do not follow llafr See the previous commit. Again, whether we apply the llafr to loop exits shouldnât be about whether parentheses look nice, but whether the final code parses correctly. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 9c56d9eaa7e203a51ca598b9b5fdbbd3533c6b38 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 21:58:27 2011 -0800 [perl #77096] Deparse return and do without llafr âreturnâ and âdo-fileâ are exempt from the âlooks-like-a-function ruleâ (llafr). B::Deparse was intentionally ignoring that: While it might produce nice-looking code, the final code compiles dif- ferently in many cases, so we simply cannot ignore these opsâ disre- gard for that rule. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 28bfcb026871cec0c2dbfa689cf0b66898733459 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 12:52:05 2011 -0800 deparse.t: Add bug number M dist/B-Deparse/t/deparse.t commit 94bb57f91b6d1f334c87639d4c49de66eeddb3a7 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 12:41:56 2011 -0800 [perl #47361] Deparse do +{} and do({}) correctly These are both variants of do-file syntax. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/Deparse.pm | 51 ++++++++++++++++++++++++++++++------------- dist/B-Deparse/t/deparse.t | 29 ++++++++++++++++++++++++- 2 files changed, 63 insertions(+), 17 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index 8aecf88..c3ac5fa 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -1668,7 +1668,7 @@ sub pp_not { sub unop { my $self = shift; - my($op, $cx, $name) = @_; + my($op, $cx, $name, $nollafr) = @_; my $kid; if ($op->flags & OPf_KIDS) { $kid = $op->first; @@ -1684,6 +1684,12 @@ sub unop { $kid = $kid->first; } + if ($nollafr) { + ($kid = $self->deparse($kid, 16)) =~ s/^\cS//; + return $self->maybe_parens( + $self->keyword($name) . " $kid", $cx, 16 + ); + } return $self->maybe_parens_unop($name, $kid, $cx); } else { return $self->keyword($name) @@ -1762,7 +1768,11 @@ sub pp_gmtime { unop(@_, "gmtime") } sub pp_alarm { unop(@_, "alarm") } sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") } -sub pp_dofile { unop(@_, "do") } +sub pp_dofile { + my $code = unop(@_, "do", 1); # llafr does not apply + if ($code =~ s/^do \{/do({/) { $code .= ')' } + $code; +} sub pp_entereval { unop( @_, @@ -1867,9 +1877,13 @@ sub pp_require { my $name = $self->const_sv($op->first)->PV; $name =~ s[/][::]g; $name =~ s/\.pm//g; - return "$opname $name"; + return $self->maybe_parens("$opname $name", $cx, 16); } else { - $self->unop($op, $cx, $op->first->private & OPpCONST_NOVER ? "no" : $opname); + $self->unop( + $op, $cx, + $op->first->private & OPpCONST_NOVER ? "no" : $opname, + 1, # llafr does not apply + ); } } @@ -1999,14 +2013,14 @@ sub loopex { my $self = shift; my ($op, $cx, $name) = @_; if (class($op) eq "PVOP") { - return "$name " . $op->pv; + $name .= " " . $op->pv; } elsif (class($op) eq "OP") { - return $name; + # no-op } elsif (class($op) eq "UNOP") { - # Note -- loop exits are actually exempt from the - # looks-like-a-func rule, but a few extra parens won't hurt - return $self->maybe_parens_unop($name, $op->first, $cx); + (my $kid = $self->deparse($op->first, 16)) =~ s/^\cS//; + $name .= " $kid"; } + return $self->maybe_parens($name, $cx, 16); } sub pp_last { loopex(@_, "last") } @@ -2342,7 +2356,7 @@ sub pp_dorassign { logassignop(@_, "//=") } sub listop { my $self = shift; - my($op, $cx, $name, $kid) = @_; + my($op, $cx, $name, $kid, $nollafr) = @_; my(@exprs); my $parens = ($cx >= 5) || $self->{'parens'}; $kid ||= $op->first->sibling; @@ -2362,7 +2376,8 @@ sub listop { if ($name eq "chmod" && $first =~ /^\d+$/) { $first = sprintf("%#o", $first); } - $first = "+$first" if not $parens and substr($first, 0, 1) eq "("; + $first = "+$first" + 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") { @@ -2376,7 +2391,9 @@ sub listop { return "$exprs[0] = $fullname" . ($parens ? "($exprs[0])" : " $exprs[0]"); } - if ($parens) { + if ($parens && $nollafr) { + return "($fullname " . join(", ", @exprs) . ")"; + } elsif ($parens) { return "$fullname(" . join(", ", @exprs) . ")"; } else { return "$fullname " . join(", ", @exprs); @@ -2410,9 +2427,7 @@ sub pp_unshift { maybe_targmy(@_, \&listop, "unshift") } sub pp_reverse { listop(@_, "reverse") } sub pp_warn { listop(@_, "warn") } sub pp_die { listop(@_, "die") } -# Actually, return is exempt from the LLAFR (see examples in this very -# module!), but for consistency's sake, ignore that fact -sub pp_return { listop(@_, "return") } +sub pp_return { listop(@_, "return", undef, 1) } # llafr does not apply sub pp_open { listop(@_, "open") } sub pp_pipe_op { listop(@_, "pipe") } sub pp_tie { listop(@_, "tie") } @@ -4367,7 +4382,11 @@ sub matchop { carp("found ".$kid->name." where regcomp expected"); } else { ($re, $quote) = $self->regcomp($kid, 21, $extended); - $rhs_bound_to_defsv = 1 if $kid->first->first->flags & OPf_SPECIAL; + my $matchop = $kid->first->first; + if ($matchop->name =~ /^(?:match|transr?|subst)\z/ + && $matchop->flags & OPf_SPECIAL) { + $rhs_bound_to_defsv = 1; + } } my $flags = ""; $flags .= "c" if $op->pmflags & PMf_CONTINUE; diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index a81c86e..056c9cf 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -410,7 +410,7 @@ my $bar; # constants as method names without () 'Foo'->bar; #### -# "indirect" method call notation +# [perl #47359] "indirect" method call notation our @bar; foo{@bar}+1,->foo; (foo{@bar}+1),foo(); @@ -725,12 +725,17 @@ pop @_; #[perl #20444] "foo" =~ (1 ? /foo/ : /bar/); "foo" =~ (1 ? y/foo// : /bar/); +"foo" =~ (1 ? y/foo//r : /bar/); "foo" =~ (1 ? s/foo// : /bar/); >>>> 'foo' =~ ($_ =~ /foo/); 'foo' =~ ($_ =~ tr/fo//); +'foo' =~ ($_ =~ tr/fo//r); 'foo' =~ ($_ =~ s/foo//); #### +# The fix for [perl #20444] broke this. +'foo' =~ do { () }; +#### # Test @threadsv_names under 5005threads foreach $' (1, 2) { sleep $'; @@ -828,3 +833,25 @@ BEGIN { $^H{'a'} = 'b'; } print $_; } print $_; +#### +# [perl #47361] do({}) and do +{} (variants of do-file) +do({}); +do +{}; +>>>> +do({}); +do({}); +#### +# [perl #77096] functions that do not follow the llafr +() = (return 1) + time; +() = (return ($1 + $2) * $3) + time; +() = (return ($a xor $b)) + time; +() = (do 'file') + time; +() = (do ($1 + $2) * $3) + time; +() = (do ($1 xor $2)) + time; +() = (goto 1) + 3; +() = (require 'foo') + 3; +() = (require foo) + 3; +() = (dump 1) + 3; +() = (last 1) + 3; +() = (next 1) + 3; +() = (redo 1) + 3; -- Perl5 Master Repository
