From: Rafael Garcia-Suarez Date: Sat, 15 Dec 2001 23:21:43 +0000 (+0100) Subject: rcatline support ($_.=) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad8caead208db46a636808a4d2bb49d677c061a4;p=p5sagit%2Fp5-mst-13.2.git rcatline support ($_.=) Message-ID: <20011215232143.A11790@rafael> p4raw-id: //depot/perl@13705 --- diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 3789b81..7f7bf9b 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 , based on an earlier version by Malcolm Beattie , 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 12f3e9e..22bd782 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; +$_ .= . <$foo>;