[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.

diff --git a/parser.h b/parser.h
index 1d5a7a8..bfb2480 100644 (file)
--- 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 (file)
--- 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/toke.c b/toke.c
index 89047c8..84685b0 100644 (file)
--- 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)
        {
@@ -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(',');