In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ddb555489955f48649cfd58f4f43830d9203728a?hp=9b2457c186d2257f3ef7f3d7faca0bfdc74c6c98>
- Log ----------------------------------------------------------------- commit ddb555489955f48649cfd58f4f43830d9203728a Author: Father Chrysostomos <[email protected]> Date: Thu Dec 4 08:39:28 2014 -0800 [perl #123357] Fix deparsing of $; at stmt end Instead of sometimes appending ; to statements and then removing it later, to avoid doubling it up, *only* append ; to a statement when actually joining them together or emitting them. That fixes bugs with do{$;} becoming do {$} and â$_=$;; $;=7;â becoming â$_=$; $;=7;â. I also removed the boilerplate from pp_stub, since it was redundant (and slow) and also partially wrong. The $name var was bogus. M lib/B/Deparse.pm M lib/B/Deparse.t commit 97d78f940231c64e8e86325f5339c2d125556a64 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 4 05:45:01 2014 -0800 Deparse.pm: Remove temp pre-PADNAME code added in d4f1bfe749f, which got merged before the PADNAME changes. M lib/B/Deparse.pm commit 5e617af5c5f0d228c969f5effffe643307a47669 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 4 05:43:23 2014 -0800 Deparse.pm: Remove special \0 marker In 4b1385ee6 I did not realise we already had \cK, which served almost the same purpose. M lib/B/Deparse.pm ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.pm | 51 +++++++++++++++++++-------------------------------- lib/B/Deparse.t | 17 ++++++++++++++++- 2 files changed, 35 insertions(+), 33 deletions(-) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 3d3fbcb..1974414 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -322,6 +322,15 @@ BEGIN { # \f - flush left (no indent) # \cK - kill following semicolon, if any +# Semicolon handling: +# - Individual statements are not deparsed with trailing semicolons. +# (If necessary, \cK is tacked on to the end.) +# - Whatever code joins statements together or emits them (lineseq, +# scopeop, deparse_root) is responsible for adding semicolons where +# necessary. +# - use statements are deparsed with trailing semicolons because they are +# immediately concatenated with the following statement. +# - indent() removes semicolons wherever it sees \cK. BEGIN { for (qw[ const stringify rv2sv list glob pushmark null aelem @@ -1051,17 +1060,9 @@ sub deparse { sub indent { my $self = shift; my $txt = shift; - # Handle semicolons after sub declarations. There will be a \0 marker - # after each sequence of subs. This: - # sub { - # .... - # } - # \0; - # needs to have the "\n\0;" removed, but the \n should be left if the - # semicolon is not followed by one. - $txt =~ s/(?<=\})(\n?)\0;(\n?)/$1 || $2 ? "\n" : ""/egg; - # Remove any remaining markers - $txt =~ y/\0//d; + # \cK also swallows a preceding line break when followed by a + # semicolon. + $txt =~ s/\n\cK;//g; my @lines = split(/\n/, $txt); my $leader = ""; my $level = 0; @@ -1109,9 +1110,7 @@ sub pad_subs { } my $protocv = $flags & SVpad_STATE ? $values[$ix] - # XXX temporary future-compatibility; B::PADNAME will - # have a PROTOCV method and no MAGIC method - : $_->can("MAGIC") ? $_->MAGIC->OBJ : $_->PROTOCV; + : $_->PROTOCV; my $outseq = $protocv->OUTSIDE_SEQ; if ($outseq <= $low) { # defined before its name is visible, so itâs gotta be @@ -1546,11 +1545,9 @@ sub deparse_root { } $self->walk_lineseq($op, \@kids, sub { return unless length $_[0]; - print $self->indent($_[0] =~ s/\0\z// - ? $_[0] - : $_[0].';'); + print $self->indent($_[0].';'); print "\n" - unless $_[1] == $#kids or $_[0] =~ /\n\z/; + unless $_[1] == $#kids; }); } @@ -1574,7 +1571,6 @@ sub walk_lineseq { my $expr2 = $self->deparse($kids[$i], (@kids != 1)/2); $expr2 =~ s/^sub :(?!:)/+sub :/; # statement label otherwise $expr .= $expr2; - $expr =~ s/;\n?\z//; $callback->($expr, $i); } } @@ -1815,7 +1811,7 @@ sub pp_nextstate { push @text, $self->cop_subs($op); if (@text) { # Special marker to swallow up the semicolon - push @text, "\0"; + push @text, "\cK"; } my $stash = $op->stashpv; if ($stash ne $self->{'curstash'}) { @@ -1916,7 +1912,7 @@ sub declare_warnings { elsif (($to & WARN_MASK) eq ("\0"x length($to) & WARN_MASK)) { return $self->keyword("no") . " warnings;\n"; } - return "BEGIN {\${^WARNING_BITS} = ".perlstring($to)."}\n\0"; + return "BEGIN {\${^WARNING_BITS} = ".perlstring($to)."}\n\cK"; } sub declare_hints { @@ -1993,7 +1989,7 @@ sub declare_hinthash { } @decls and push @ret, - join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n\0"; + join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n\cK"; return @ret; } @@ -2093,16 +2089,7 @@ sub baseop { return $self->keyword($name); } -sub pp_stub { - my $self = shift; - my($op, $cx, $name) = @_; - if ($cx >= 1) { - return "()"; - } - else { - return "();"; - } -} +sub pp_stub { "()" } sub pp_wantarray { baseop(@_, "wantarray") } sub pp_fork { baseop(@_, "fork") } sub pp_wait { maybe_targmy(@_, \&baseop, "wait") } diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index f354b9d..1e8d545 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -13,7 +13,7 @@ BEGIN { use warnings; use strict; -my $tests = 31; # not counting those in the __DATA__ section +my $tests = 32; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -283,6 +283,15 @@ x(); z() . EOCODH +is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], + prog => "format =\n\@\n\$;\n.\n"), + <<'EOCODM', '$; on format line'; +format STDOUT = +@ +$; +. +EOCODM + # CORE::format $a = readpipe qq`$^X $path "-MO=Deparse" -e "use feature q|:all|;` .qq` my sub format; CORE::format =" -e. 2>&1`; @@ -1742,6 +1751,12 @@ print f(); # Elements of %# should not be confused with $#{ array } () = ${#}{'foo'}; #### +# $; [perl #12335] +$_ = $;; +do { + $; +}; +#### # [perl #121050] Prototypes with whitespace sub _121050(\$ \$) { } _121050($a,$b); -- Perl5 Master Repository
