In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1bd358614578efacd579635d85759fe8a501763e?hp=fbfa7c02afa6e3e6975eb25b333402cf754833e3>
- Log ----------------------------------------------------------------- commit 1bd358614578efacd579635d85759fe8a501763e Author: Father Chrysostomos <[email protected]> Date: Mon Aug 6 14:03:31 2012 -0700 cv.h: macro parentheses I forgot about -- having higher precedence than unary *. And then I forgot to test it, convincing myself I had. :-( M cv.h commit 64a408986cf3da7615062d0778e28cfa24288618 Author: Father Chrysostomos <[email protected]> Date: Mon Aug 6 09:48:07 2012 -0700 Nested formats Are nested formats a good idea? Probably not. But the only rea- son they donât work is that the parser becomes confused and loses track of where it is. And it would be nice to have some consistency. I can put sub defini- tions inside a format: format = @ ;sub foo { bar } . and: format = @ { sub foo { bar } } . so why not these? format foo = @ ;format bar = @ . . format foo = @ { format bar = @ . } . In perl 5.17.2 and earlier, you can nest formats, but, due to the parser being confused, the outer format must be terminated with } instead of a dot. That stopped working with commit 7c70caa5333. format = @<<<<<<<<<<<<<<< "Just another"; format STDERR = @<<<<<<<<<<<<<<< "Perl hacker" . } write; select STDERR; write; M t/op/write.t M toke.c commit eaf6a13dc1ee199aebc2ca608507bab3b8244655 Author: Father Chrysostomos <[email protected]> Date: Mon Aug 6 08:41:07 2012 -0700 toke.c: move leftbracket label The only code path that goesto leftbracket was precede by s--. The first thing leftbracket did was s++. We can simplify the code slighty by moving the label down one statement and not s--ing before goingto leftbracket. M toke.c commit 583c9d5cccfe6eadf42350e2baa975576a360f02 Author: Father Chrysostomos <[email protected]> Date: Mon Aug 6 08:38:28 2012 -0700 [perl #114040] Parse formats in interpolating constructs For re-evals, this is something that broke recently, post-5.16 (the jumbo fix). For other interpolating constructs, this has never worked, as far as I can tell. The lexer was losing track of PL_lex_state (aka PL_parser->lex_state) when parsing formats. Usually, the state alternates between LEX_FORMLINE (a picture line) and LEX_NORMAL (an argument line), but the LEX_NORMAL should actually be whatever the state was before the format started. This commit adds a new parser member to track the ânormalâ state when parsing a format. It also tweaks S_scan_formline to handle multi-line buffers outside of string eval (such as happens in interpolating constructs). That bufend assignment that is removed as a result is not necessary as of a0d0e21ea6ea (perl 5.000). That very commit added a bufend assign- ment after the sv_gets (later filter_gets; later lex_next_chunk) fur- ther down in the loop in scan_formline. M parser.h M t/comp/parser.t M toke.c ----------------------------------------------------------------------- Summary of changes: cv.h | 2 +- parser.h | 1 + t/comp/parser.t | 11 ++++++++++- t/op/write.t | 20 +++++++++++++++++++- toke.c | 30 +++++++++++++++--------------- 5 files changed, 46 insertions(+), 18 deletions(-) diff --git a/cv.h b/cv.h index a94d248..e8cb162 100644 --- a/cv.h +++ b/cv.h @@ -75,7 +75,7 @@ S_CvDEPTHp(const CV * const sv) S_CvDEPTHp(_cvdepth); \ })) #else -# define CvDEPTH(sv) *S_CvDEPTHp((const CV *)sv) +# define CvDEPTH(sv) (*S_CvDEPTHp((const CV *)sv)) #endif #define CvPADLIST(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist #define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside diff --git a/parser.h b/parser.h index 1d5a7a8..bfb2480 100644 --- a/parser.h +++ b/parser.h @@ -80,6 +80,7 @@ typedef struct yy_parser { HV *in_my_stash; /* declared class of this "my" declaration */ PerlIO *rsfp; /* current source file pointer */ AV *rsfp_filters; /* holds chain of active source filters */ + U8 form_lex_state; /* remember lex_state when parsing fmt */ #ifdef PERL_MAD SV *endwhite; diff --git a/t/comp/parser.t b/t/comp/parser.t index ac6742e..8ada9ab 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -3,7 +3,7 @@ # Checks if the parser behaves correctly in edge cases # (including weird syntax errors) -print "1..137\n"; +print "1..138\n"; sub failed { my ($got, $expected, $name) = @_; @@ -388,6 +388,15 @@ is $::{waru}, undef, 'sub w attr+proto ignored after compilation error'; is $::{iwa}, undef, 'non-empty sub decl ignored after compilation error'; is *BEGIN{CODE}, undef, 'BEGIN leaves no stub after compilation error'; +$test = $test + 1; +"ok $test - format inside re-eval" =~ /(?{ + format = +@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$_ +. +write +}).*/; + # Add new tests HERE (above this line) # bug #74022: Loop on characters in \p{OtherIDContinue} diff --git a/t/op/write.t b/t/op/write.t index 17b8869..2d5b0ac 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -61,7 +61,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 20; # number of tests in section 3 -my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 4; +my $bug_tests = 8 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 5; # number of tests in section 4 my $hmb_tests = 35; @@ -1017,6 +1017,24 @@ format = ;1 |, 'format = ... } is not allowed'; +open(NEST, '>Op_write.tmp') || die "Can't create Op_write.tmp"; +format NEST = +@<<< +{ + my $birds = "birds"; + local *NEST = *BIRDS{FORMAT}; + write NEST; + format BIRDS = +@<<<<< +$birds; +. + "nest" +} +. +write NEST; +close NEST or die "Could not close: $!"; +is cat('Op_write.tmp'), "birds\nnest\n", 'nested formats'; + ############################# ## Section 4 diff --git a/toke.c b/toke.c index 89047c8..f04dfd1 100644 --- a/toke.c +++ b/toke.c @@ -4771,7 +4771,7 @@ Perl_yylex(pTHX) return yylex(); case LEX_FORMLINE: - PL_lex_state = LEX_NORMAL; + PL_lex_state = PL_parser->form_lex_state; s = scan_formline(PL_bufptr); if (!PL_lex_formbrack) { @@ -5687,8 +5687,8 @@ Perl_yylex(pTHX) } TERM(']'); case '{': - leftbracket: s++; + leftbracket: if (PL_lex_brackets > 100) { Renew(PL_lex_brackstack, PL_lex_brackets + 10, char); } @@ -5894,6 +5894,7 @@ Perl_yylex(pTHX) CURMAD('_', PL_thiswhite); } force_next(formbrack ? '.' : '}'); + if (formbrack) LEAVE; #ifdef PERL_MAD if (!PL_thistoken) PL_thistoken = newSVpvs(""); @@ -6014,7 +6015,7 @@ Perl_yylex(pTHX) goto retry; } } - if (PL_lex_brackets < PL_lex_formbrack) { + if (PL_expect == XBLOCK) { const char *t = s; #ifdef PERL_STRICT_CR while (SPACE_OR_TAB(*t)) @@ -6023,9 +6024,13 @@ Perl_yylex(pTHX) #endif t++; if (*t == '\n' || *t == '#') { - s--; PL_expect = XBLOCK; formbrack = TRUE; + ENTER; + SAVEI8(PL_parser->form_lex_state); + SAVEI32(PL_lex_formbrack); + PL_parser->form_lex_state = PL_lex_state; + PL_lex_formbrack = PL_lex_brackets + 1; goto leftbracket; } } @@ -6384,7 +6389,6 @@ Perl_yylex(pTHX) #endif && (s == PL_linestart || s[-1] == '\n') ) { - PL_lex_formbrack = 0; PL_expect = XSTATE; formbrack = TRUE; goto rightbracket; @@ -8202,7 +8206,6 @@ Perl_yylex(pTHX) } if (key == KEY_format) { - PL_lex_formbrack = PL_lex_brackets + 1; #ifdef PERL_MAD PL_thistoken = subtoken; s = d; @@ -8211,7 +8214,7 @@ Perl_yylex(pTHX) (void) force_word(PL_oldbufptr + tboffset, WORD, FALSE, TRUE, TRUE); #endif - OPERATOR(FORMAT); + PREBLOCK(FORMAT); } /* Look for a prototype */ @@ -10641,13 +10644,9 @@ S_scan_formline(pTHX_ register char *s) break; } } - if (PL_in_eval && !PL_rsfp && !PL_parser->filtered) { - eol = (char *) memchr(s,'\n',PL_bufend-s); - if (!eol++) + eol = (char *) memchr(s,'\n',PL_bufend-s); + if (!eol++) eol = PL_bufend; - } - else - eol = PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); if (*s != '#') { for (t = s; t < eol; t++) { if (*t == '~' && t[1] == '~' && SvCUR(stuff)) { @@ -10672,7 +10671,8 @@ S_scan_formline(pTHX_ register char *s) break; } s = (char*)eol; - if (PL_rsfp || PL_parser->filtered) { + if ((PL_rsfp || PL_parser->filtered) + && PL_parser->form_lex_state == LEX_NORMAL) { bool got_some; #ifdef PERL_MAD if (PL_madskills) { @@ -10699,7 +10699,7 @@ S_scan_formline(pTHX_ register char *s) if (SvCUR(stuff)) { PL_expect = XTERM; if (needargs) { - PL_lex_state = LEX_NORMAL; + PL_lex_state = PL_parser->form_lex_state; start_force(PL_curforce); NEXTVAL_NEXTTOKE.ival = 0; force_next(','); -- Perl5 Master Repository
