In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1ebd3007591c91215bcc334318e0485e73e6f13f?hp=7ba8970dd3a78097012503f0c4b1900e36b571a9>
- Log ----------------------------------------------------------------- commit 1ebd3007591c91215bcc334318e0485e73e6f13f Author: Father Chrysostomos <[email protected]> Date: Fri Aug 10 13:35:42 2012 -0700 OptreeCheck.pm: typo M ext/B/t/OptreeCheck.pm commit 16f6be75abf32245e3192a0d44823f14bf0a4d75 Author: Father Chrysostomos <[email protected]> Date: Fri Aug 10 13:31:53 2012 -0700 coreamp: Fix test; correct test name M t/op/coreamp.t commit 167ee053a8ca9044a99aa214cd5abe0bab777e39 Author: Father Chrysostomos <[email protected]> Date: Wed Aug 8 23:18:22 2012 -0700 toke.c: Remove unnecessary assignment S_scan_formline never needs to do PL_bufptr = s, because it returns s, and all the code paths that follow the one spot that calls it them- selves assign s to PL_bufptr. M toke.c commit 5c9ae74dcaf4a16d67145fc3ea876a42aeb5c0b3 Author: Father Chrysostomos <[email protected]> Date: Wed Aug 8 23:12:59 2012 -0700 toke.c: Set PL_lex_state less when scanning formats This (in yylex) is the only code that calls scan_formline: case LEX_FORMLINE: PL_lex_state = PL_parser->form_lex_state; s = scan_formline(PL_bufptr); if (!PL_lex_formbrack) { formbrack = 1; goto rightbracket; } PL_bufptr = s; return yylex(); } It is only reached when PL_lex_state is LEX_FORMLINE. scan_formline itself does not even look at PL_lex_state. It does set it, though, unless it has reached the end of the format (setting PL_lex_formbrack to 0) or the end of input. This means we end up flipping it back and forth between two values. We donât have to set PL_lex_state before scan_formline() at all. Hav- ing scan_formline only set it when it does not need to be LEX_FORMLINE simplifies things, resulting in less code and fewer assignments. M toke.c commit 96f9b7829bf7acfe4d793430f9fd6ca003f6d481 Author: Father Chrysostomos <[email protected]> Date: Wed Aug 8 22:49:17 2012 -0700 toke.c: One less token for missing format args In commit 705fe0e5f8a, when I made the parser understand format syntax itself, I had to add special handling for a terminating dot where for- mat arguments were expected: format = @ . The parser expects every format argument line to look like this: formarg : /* NULL */ { $$ = NULL; } | FORMLBRACK stmtseq FORMRBRACK { $$ = op_unscope($2); } ; When the line break is encountered after the @, the FORMLBRACK token is emitted, and the lexer switches into ânormalâ (as opposed to for- mat picture) mode. When the final dot is encountered, since the FORMLBRACK has already been emitted, the lexer has to conjure up a FORMRBRACK as well, to avoid a syntax error. I had it producing a semicolon before the FORMRBRACK, but that is not necessary, because stmtseq can be null. So this commit removes it. M toke.c commit 93a8ff62dea3b24a5cafff9474c37a38a367f2da Author: Father Chrysostomos <[email protected]> Date: Wed Aug 8 13:59:03 2012 -0700 Deparse multiple stmts in format line correctly They were being output on separate lines, resulting in the second statement being treated as a format picture, etc. This affected cases like this: format = @ $x; $y . M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit b9047c8b171545cf46e0ca8aa52551308ddd1e86 Author: Father Chrysostomos <[email protected]> Date: Wed Aug 8 12:50:03 2012 -0700 B::Concise: Two unused vars One was made unnecessary by 35f7559499. The other was added by 35f7559499 and never used. I forgot to clean up once I had things working. M ext/B/B/Concise.pm ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/Deparse.pm | 18 ++++++++++-------- dist/B-Deparse/t/deparse.t | 14 +++++++++++++- ext/B/B/Concise.pm | 2 -- ext/B/t/OptreeCheck.pm | 2 +- t/op/coreamp.t | 4 ++-- toke.c | 10 +++------- 6 files changed, 29 insertions(+), 21 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index 0bbcbee..34fc38c 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -301,6 +301,7 @@ BEGIN { # 1 statement modifiers # 0.5 statements, but still print scopes as do { ... } # 0 statement level +# -1 format body # Nonprinting characters with special meaning: # \cS - steal parens (see maybe_parens_unop) @@ -895,7 +896,7 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); for(my$o=$lineseq->first; $$o; $o=$o->sibling) { push @ops, $o; } - $body = $self->lineseq(undef, @ops).";"; + $body = $self->lineseq(undef, 0, @ops).";"; my $scope_en = $self->find_scope_en($lineseq); if (defined $scope_en) { my $subs = join"", $self->seq_subs($scope_en); @@ -939,7 +940,7 @@ sub deparse_format { push @text, "\f".$self->const_sv($kid)->PV; $kid = $kid->sibling; for (; not null $kid; $kid = $kid->sibling) { - push @exprs, $self->deparse($kid, 0); + push @exprs, $self->deparse($kid, -1); } push @text, "\f".join(", ", @exprs)."\n" if @exprs; $op = $op->sibling; @@ -1139,7 +1140,7 @@ sub DESTROY {} # Do not AUTOLOAD # any subroutine declarations to the deparsed ops, otherwise we # append appropriate declarations. sub lineseq { - my($self, $root, @ops) = @_; + my($self, $root, $cx, @ops) = @_; my($expr, @exprs); my $out_cop = $self->{'curcop'}; @@ -1160,12 +1161,13 @@ sub lineseq { $self->walk_lineseq($root, \@ops, sub { push @exprs, $_[0]} ); - my $body = join(";\n", grep {length} @exprs); + my $sep = $cx ? '; ' : ";\n"; + my $body = join($sep, grep {length} @exprs); my $subs = ""; if (defined $root && defined $limit_seq && !$self->{'in_format'}) { $subs = join "\n", $self->seq_subs($limit_seq); } - return join(";\n", grep {length} $body, $subs); + return join($sep, grep {length} $body, $subs); } sub scopeop { @@ -1200,9 +1202,9 @@ sub scopeop { push @kids, $kid; } if ($cx > 0) { # inside an expression, (a do {} while for lineseq) - return "do {\n\t" . $self->lineseq($op, @kids) . "\n\b}"; + return "do {\n\t" . $self->lineseq($op, 0, @kids) . "\n\b}"; } else { - my $lineseq = $self->lineseq($op, @kids); + my $lineseq = $self->lineseq($op, $cx, @kids); return (length ($lineseq) ? "$lineseq;" : ""); } } @@ -3011,7 +3013,7 @@ sub loop_common { for (; $$state != $$cont; $state = $state->sibling) { push @states, $state; } - $body = $self->lineseq(undef, @states); + $body = $self->lineseq(undef, 0, @states); if (defined $cond and not is_scope $cont and $self->{'expand'} < 3) { $head = "for ($init; $cond; " . $self->deparse($cont, 1) .") "; $cont = "\cK"; diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 811adb6..841d531 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -13,7 +13,7 @@ use warnings; use strict; use Test::More; -my $tests = 17; # not counting those in the __DATA__ section +my $tests = 18; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -243,6 +243,18 @@ SKIP: { `; } +# multiple statements on format lines +$a = `$^X $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`; +$a =~ s/-e syntax OK\n//g; +$a =~ s/z\(\);/z()/; +is($a, <<'EOCODH', 'multiple statements on format lines'); +format STDOUT = +@ +x(); z() +. +EOCODH + + done_testing($tests); __DATA__ diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 946b489..f0a1b44 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -356,8 +356,6 @@ sub compile { } else { # convert function names to subrefs - my $objref; - my $objref2; if (ref $objname) { print $walkHandle "B::Concise::compile($objname)\n" if $banner; diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm index 73446b9..9bb7088 100644 --- a/ext/B/t/OptreeCheck.pm +++ b/ext/B/t/OptreeCheck.pm @@ -180,7 +180,7 @@ If name property is not provided, it is synthesized from these params: bcopts, note, prog, code. This is more convenient than trying to do it manually. -=head2 code or prog or profile +=head2 code or prog or progfile Either code or prog or progfile must be present. diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 11ddc79..477325d 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -632,9 +632,9 @@ test_proto 'quotemeta', '$', '\$'; test_proto 'rand'; $tests += 3; -like &CORE::rand, qr/^0[.\d]*\z/, '&rand'; +like &CORE::rand, qr/^0[.\d+-e]*\z/, '&rand'; unlike join(" ", &CORE::rand), qr/ /, '&rand in list context'; -&cmp_ok(&CORE::rand(78), qw '< 78', '&rand with 2 args'); +&cmp_ok(&CORE::rand(78), qw '< 78', '&rand with 1 arg'); test_proto 'read'; { diff --git a/toke.c b/toke.c index 2b8c2a9..aecd7f1 100644 --- a/toke.c +++ b/toke.c @@ -4783,7 +4783,6 @@ Perl_yylex(pTHX) return yylex(); case LEX_FORMLINE: - PL_lex_state = PL_parser->form_lex_state; s = scan_formline(PL_bufptr); if (!PL_lex_formbrack) { @@ -5915,8 +5914,7 @@ Perl_yylex(pTHX) if (formbrack == 2) { /* means . where arguments were expected */ start_force(PL_curforce); force_next(';'); - start_force(PL_curforce); - force_next(FORMRBRACK); + TOKEN(FORMRBRACK); } TOKEN(';'); case '&': @@ -10714,16 +10712,15 @@ S_scan_formline(pTHX_ register char *s) incline(s); } enough: + if (!SvCUR(stuff) || needargs) + PL_lex_state = PL_parser->form_lex_state; if (SvCUR(stuff)) { PL_expect = XSTATE; if (needargs) { - PL_lex_state = PL_parser->form_lex_state; start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next(FORMLBRACK); } - else - PL_lex_state = LEX_FORMLINE; if (!IN_BYTES) { if (UTF && is_utf8_string((U8*)SvPVX_const(stuff), SvCUR(stuff))) SvUTF8_on(stuff); @@ -10738,7 +10735,6 @@ S_scan_formline(pTHX_ register char *s) SvREFCNT_dec(stuff); if (eofmt) PL_lex_formbrack = 0; - PL_bufptr = s; } #ifdef PERL_MAD if (PL_madskills) { -- Perl5 Master Repository
