here-doc in quotes in multiline s//.../e in eval

When <<END occurs on the last line of a quote-like operator inside a
string eval ("${\<<END}"), it peeks into the linestr buffer of the
parent lexing scope (quote-like operators start a new lexing scope
with the linestr buffer containing what is between the quotes) to find
the body of the here-doc.  It modifies that buffer, stealing however
much it needs.

It was not leaving things in the consistent state that s///e checks
for when it finishes parsing the replacement (to make sure s//}+{/
doesn’t ‘work’).  Specifically, it was not shrinking the parent buf-
fer, so when PL_bufend was reset in sublex_done to the end of the par-
ent buffer, it was pointing to the wrong spot.

diff --git a/perl.h b/perl.h
index 47f642f..ed9889e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3450,7 +3450,7 @@ struct _sublex_info {
     U16 sub_inwhat;    /* "lex_inwhat" to use */
     OP *sub_op;                /* "lex_op" to use */
     char *super_bufptr;        /* PL_parser->bufptr that was */
-    char *super_bufend;        /* PL_parser->bufend that was */
+    SV *super_linestr; /* PL_parser->linestr that was */
     char *re_eval_start;/* start of "(?{..." text */
 };
 

diff --git a/t/base/lex.t b/t/base/lex.t
index d55b189..559cc30 100644 (file)
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..58\n";
+print "1..59\n";
 
 $x = 'x';
 
@@ -280,3 +280,11 @@ ok 58 - heredoc after "" in s/// in eval
 END
 ';
 print $_ || "not ok 58\n";
+
+$_ = "";
+eval 's|(?:)|"${\<<\END}"
+ok 59 - heredoc in "" in multiline s///e in eval
+END
+|e
+';
+print $_ || "not ok 59\n";

diff --git a/toke.c b/toke.c
index f24fbca..6b1a8ae 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2461,7 +2461,7 @@ S_sublex_push(pTHX)
     SAVEI8(PL_lex_state);
     SAVEPPTR(PL_sublex_info.re_eval_start);
     SAVEPPTR(PL_sublex_info.super_bufptr);
-    SAVEPPTR(PL_sublex_info.super_bufend);
+    SAVEPPTR(PL_sublex_info.super_linestr);
     SAVEVPTR(PL_lex_inpat);
     SAVEI16(PL_lex_inwhat);
     SAVECOPLINE(PL_curcop);
@@ -2476,11 +2476,11 @@ S_sublex_push(pTHX)
     SAVEGENERICPV(PL_lex_brackstack);
     SAVEGENERICPV(PL_lex_casestack);
 
+    PL_sublex_info.super_linestr = PL_linestr;
     PL_linestr = PL_lex_stuff;
     PL_lex_stuff = NULL;
     PL_sublex_info.re_eval_start = NULL;
     PL_sublex_info.super_bufptr = PL_bufptr;
-    PL_sublex_info.super_bufend = PL_bufend;
 
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
@@ -9602,7 +9602,7 @@ S_scan_heredoc(pTHX_ register char *s)
     PL_multi_open = PL_multi_close = '<';
     if (!infile && PL_lex_inwhat && !found_newline) {
        char * const bufptr = PL_sublex_info.super_bufptr;
-       char * const bufend = PL_sublex_info.super_bufend;
+       char * const bufend = SvEND(PL_sublex_info.super_linestr);
        char * const olds = s - SvCUR(herewas);
        term = *PL_tokenbuf;
        s = strchr(bufptr, '\n');
@@ -9623,6 +9623,9 @@ S_scan_heredoc(pTHX_ register char *s)
        s += len - 1;
        sv_catpvn(herewas,s,bufend-s);
        Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
+       SvCUR_set(PL_sublex_info.super_linestr,
+                 bufptr-SvPVX_const(PL_sublex_info.super_linestr)
+                  + SvCUR(herewas));
 
        s = olds;
        goto retval;