diff options
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B/Deparse.pm | 18 | ||||
| -rw-r--r-- | ext/B/t/deparse.t | 6 |
2 files changed, 21 insertions, 3 deletions
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 3789b813f9..7f7bf9b13e 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -942,7 +942,6 @@ sub maybe_my { # The following OPs don't have functions: # pp_padany -- does not exist after parsing -# pp_rcatline -- does not exist sub pp_enter { # see also leave cluck "unexpected OP_ENTER"; @@ -1668,6 +1667,12 @@ sub pp_readline { return $self->unop($op, $cx, "readline"); } +sub pp_rcatline { + my $self = shift; + my($op) = @_; + return "<" . $self->gv_name($op->gv) . ">"; +} + # Unary operators that can occur as pseudo-listops inside double quotes sub dq_unop { my $self = shift; @@ -2491,6 +2496,14 @@ sub pp_null { $cx, 20); } elsif ($op->flags & OPf_SPECIAL && $cx == 0 && !$op->targ) { return "do {\n\t". $self->deparse($op->first, $cx) ."\n\b};"; + } elsif (!null($op->first->sibling) and + $op->first->sibling->name eq "null" and + class($op->first->sibling) eq "UNOP" and + $op->first->sibling->first->flags & OPf_STACKED and + $op->first->sibling->first->name eq "rcatline") { + return $self->maybe_parens($self->deparse($op->first, 18) . " .= " + . $self->deparse($op->first->sibling, 18), + $cx, 18); } else { return $self->deparse($op->first, $cx); } @@ -4201,6 +4214,7 @@ There are probably many more bugs on non-ASCII platforms (EBCDIC). Stephen McCamant <smcc@CSUA.Berkeley.EDU>, based on an earlier version by Malcolm Beattie <mbeattie@sable.ox.ac.uk>, with contributions from Gisle Aas, James Duncan, Albert Dvornik, Robin -Houston, Hugo van der Sanden, Gurusamy Sarathy, and Nick Ing-Simmons. +Houston, Hugo van der Sanden, Gurusamy Sarathy, Nick Ing-Simmons, +and Rafael Garcia-Suarez. =cut diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t index 12f3e9e462..22bd782bf7 100644 --- a/ext/B/t/deparse.t +++ b/ext/B/t/deparse.t @@ -15,7 +15,7 @@ use warnings; use strict; use Config; -print "1..15\n"; +print "1..16\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; @@ -180,3 +180,7 @@ print $main::x[1]; # 12 my %x; $x{warn()}; +#### +# 13 +my $foo; +$_ .= <ARGV> . <$foo>; |