diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-08-06 08:38:28 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-08-06 14:04:03 -0700 |
commit | 583c9d5cccfe6eadf42350e2baa975576a360f02 (patch) | |
tree | 91dc5b7f31dfa5657961e48c06e34383d2a53d03 | |
parent | fbfa7c02afa6e3e6975eb25b333402cf754833e3 (diff) | |
download | perl-583c9d5cccfe6eadf42350e2baa975576a360f02.tar.gz |
[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.
-rw-r--r-- | parser.h | 1 | ||||
-rw-r--r-- | t/comp/parser.t | 11 | ||||
-rw-r--r-- | toke.c | 19 |
3 files changed, 21 insertions, 10 deletions
@@ -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 ac6742e103..8ada9ab720 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} @@ -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) { @@ -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(""); @@ -6026,6 +6027,9 @@ Perl_yylex(pTHX) s--; PL_expect = XBLOCK; formbrack = TRUE; + ENTER; + SAVEI8(PL_parser->form_lex_state); + PL_parser->form_lex_state = PL_lex_state; goto leftbracket; } } @@ -10641,13 +10645,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 +10672,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 +10700,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(','); |