This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix here-doc body extraction in eval 's//<<END/'
authorFather Chrysostomos <sprout@cpan.org>
Wed, 29 Aug 2012 19:47:32 +0000 (12:47 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 31 Aug 2012 01:18:08 +0000 (18:18 -0700)
Outside of string eval, this:

s//<<END/e; print "a
END
b\n";

prints this:

a
b

But when we have string eval involved,

eval 's//<<END/e; print "a
END
b\n"';

we get this:

a

b

Amazing!

The buggy code in question goes back to commit 0244c3a403.

Since PL_linestr only contains the contents of the replacement
("<<END"), it peeks into the outer lexing scope‚Äôs linestr buffer, mod-
ifying it in place to remove the here-doc body, by copying everything
after the here-doc back to the spot where the body begins.

It was off by one, however, and left an extra line break.

When the code in question is reached, the variables are set as follows:

bufptr = "; print \"a"...  (just after the s///)
s      = "\nb\\n\""        (newline after the heredoc terminator)

The herewas variable already contains everything after the quote-
like operator containing the <<heredoc marker to the end of the line
including the \n ("; print \"a\n").

But then we concatenate everything from s onwards.  So we end up with
the \n before the here-doc body and the \n from after the here-doc
terminator juxtaposed.

So after using s to extract the re-eval string, we increment s so it
points afer the final newline.

t/base/lex.t
toke.c

index 9868d4c..17aee05 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
 #!./perl
 
-print "1..68\n";
+print "1..69\n";
 
 $x = 'x';
 
 
 $x = 'x';
 
@@ -338,3 +338,9 @@ END
 })/;
 print "not " unless /foo/;
 print "ok 68 - here-doc in quotes in multiline re-eval\n";
 })/;
 print "not " unless /foo/;
 print "ok 68 - here-doc in quotes in multiline re-eval\n";
+
+eval 's//<<END/e if 0; $_ = "a
+END
+b"';
+print "not " if $_ =~ /\n\n/;
+print "ok 69 - eval 's//<<END/' does not leave extra newlines\n";
diff --git a/toke.c b/toke.c
index c628a21..5f568b1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -9681,6 +9681,7 @@ S_scan_heredoc(pTHX_ register char *s)
        sv_setpvn(herewas,bufptr,d-bufptr+1);
        sv_setpvn(tmpstr,d+1,s-d);
        s += len - 1;
        sv_setpvn(herewas,bufptr,d-bufptr+1);
        sv_setpvn(tmpstr,d+1,s-d);
        s += len - 1;
+       shared->herelines++;    /* the preceding stmt passes a newline */
        /* See the Paranoia note in case LEX_INTERPEND in yylex, for why we
           check shared->re_eval_str. */
        if (shared->re_eval_start || shared->re_eval_str) {
        /* See the Paranoia note in case LEX_INTERPEND in yylex, for why we
           check shared->re_eval_str. */
        if (shared->re_eval_start || shared->re_eval_str) {
@@ -9696,6 +9697,7 @@ S_scan_heredoc(pTHX_ register char *s)
            cx->blk_eval.cur_text = newSVsv(linestr);
            SvSCREAM_on(cx->blk_eval.cur_text);
        }
            cx->blk_eval.cur_text = newSVsv(linestr);
            SvSCREAM_on(cx->blk_eval.cur_text);
        }
+       s++;
        sv_catpvn(herewas,s,bufend-s);
        Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
        SvCUR_set(linestr,
        sv_catpvn(herewas,s,bufend-s);
        Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
        SvCUR_set(linestr,