[perl #65838] Allow here-doc with no final newline

When reading a line of input while scanning a here-doc, if the line
does not end in \n, then we know we have reached the end of input.  By
simply tacking a \n on to the buffer, we can meet the expectations of
the rest of the here-doc parsing code.  If it turns out the delimiter
is not found on that line, it does not matter that we modified it, as
we will croak anyway.

I had to add a new flag to lex_next_chunk.  Before commit f0e67a1d2,
S_scan_heredoc would read from the stream itself, without closing any
handles.  So the next time through yylex, the eof code would supply
the final implicit semicolon.

Since f0e67a1d2, S_scan_heredoc has been calling lex_next_chunk, which
takes care of reading from the stream an supply any final ; at eof.
The here-doc parser will just get confused as a result (<<';' would
work without any terminator).  The new flag tells lex_next_chunk not
to do anything at eof (not even closing handles and resetting the
parser state), but to return false and leave everything as it was.

diff --git a/t/op/heredoc.t b/t/op/heredoc.t
index 7108c9a..5f48828 100644 (file)
--- a/t/op/heredoc.t
+++ b/t/op/heredoc.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use strict;
-plan(tests => 6);
+plan(tests => 7);
 
 
 # heredoc without newline (#65838)
@@ -39,6 +39,12 @@ HEREDOC
         { switches => ['-X'] },
         "blank-terminated heredoc at EOF"
     );
+    fresh_perl_is(
+        "print <<\n$string\n",
+        $string,
+        { switches => ['-X'] },
+        "blank-terminated heredoc at EOF and no semicolon"
+    );
 }
 
 

diff --git a/toke.c b/toke.c
index fc2635b..7592453 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1249,6 +1249,7 @@ buffer has reached the end of the input text.
 */
 
 #define LEX_FAKE_EOF 0x80000000
+#define LEX_NO_TERM  0x40000000
 
 bool
 Perl_lex_next_chunk(pTHX_ U32 flags)
@@ -1260,7 +1261,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     STRLEN linestart_pos, last_uni_pos, last_lop_pos;
     bool got_some_for_debugger = 0;
     bool got_some;
-    if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF))
+    if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
     linestr = PL_parser->linestr;
     buf = SvPVX(linestr);
@@ -1291,6 +1292,8 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     } else if (filter_gets(linestr, old_bufend_pos)) {
        got_some = 1;
        got_some_for_debugger = 1;
+    } else if (flags & LEX_NO_TERM) {
+       got_some = 0;
     } else {
        if (!SvPOK(linestr))   /* can get undefined by filter_gets */
            sv_setpvs(linestr, "");
@@ -9668,11 +9671,16 @@ S_scan_heredoc(pTHX_ register char *s)
 #endif
        PL_bufptr = s;
        CopLINE_inc(PL_curcop);
-       if (!lex_next_chunk(0)) {
+       if (!lex_next_chunk(LEX_NO_TERM)
+        && (!SvCUR(tmpstr) || SvEND(tmpstr)[-1] != '\n')) {
            CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            missingterm(PL_tokenbuf + 1);
        }
        CopLINE_dec(PL_curcop);
+       if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') {
+           lex_grow_linestr(SvCUR(PL_linestr) + 2);
+           sv_catpvs(PL_linestr, "\n\0");
+       }
        s = PL_bufptr;
 #ifdef PERL_MAD
        stuffstart = s - SvPVX(PL_linestr);