In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1bf8bbb0bf807751a3f992d960cc68740fd12a4b?hp=c306e834a2e7e21d20699178dd251b8b8171bc14>
- Log ----------------------------------------------------------------- commit 1bf8bbb0bf807751a3f992d960cc68740fd12a4b Author: Father Chrysostomos <[email protected]> Date: Wed Dec 7 08:39:59 2011 -0800 [perl #47359] Deparse method {$object} correctly The block is evaluated in list context, allowing things like SUPER::glelp{@_} to work, so deparsing it as do{...}->method is wrong, as it puts the block in scalar context. ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/Deparse.pm | 15 +++++++++++++-- dist/B-Deparse/t/deparse.t | 11 +++++++++++ 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index ed5493b..8aecf88 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -3305,7 +3305,8 @@ sub _method { } return { method => $meth, variable_method => ref($meth), - object => $obj, args => \@exprs }; + object => $obj, args => \@exprs }, + $cx; } # compat function only @@ -3316,12 +3317,22 @@ sub method { } sub e_method { - my ($self, $info) = @_; + my ($self, $info, $cx) = @_; my $obj = $self->deparse($info->{object}, 24); my $meth = $info->{method}; $meth = $self->deparse($meth, 1) if $info->{variable_method}; my $args = join(", ", map { $self->deparse($_, 6) } @{$info->{args}} ); + if ($info->{object}->name eq 'scope' && want_list $info->{object}) { + # method { $object } + # This must be deparsed this way to preserve list context + # of $object. + my $need_paren = $cx >= 6; + return '(' x $need_paren + . $meth . substr($obj,2) # chop off the "do" + . " $args" + . ')' x $need_paren; + } my $kid = $obj . "->" . $meth; if (length $args) { return $kid . "(" . $args . ")"; # parens mandatory diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index a4284ef..a81c86e 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -410,6 +410,17 @@ my $bar; # constants as method names without () 'Foo'->bar; #### +# "indirect" method call notation +our @bar; +foo{@bar}+1,->foo; +(foo{@bar}+1),foo(); +foo{@bar}1 xor foo(); +>>>> +our @bar; +(foo { @bar } 1)->foo; +(foo { @bar } 1), foo(); +foo { @bar } 1 xor foo(); +#### # SKIP ?$] < 5.010 && "say not implemented on this Perl version" # say say 'foo'; -- Perl5 Master Repository
