From 76f9939ee09e325216d1b8afce3e3d7183c5eeb8 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Wed, 29 Aug 2012 12:47:32 -0700
Subject: [PATCH] Fix here-doc body extraction in eval 's//<<END/'
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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 | 8 +++++++-
 toke.c       | 2 ++
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/t/base/lex.t b/t/base/lex.t
index 9868d4c..17aee05 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..68\n";
+print "1..69\n";
 
 $x = 'x';
 
@@ -338,3 +338,9 @@ END
 })/;
 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
--- 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;
+	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) {
@@ -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);
 	}
+	s++;
 	sv_catpvn(herewas,s,bufend-s);
 	Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
 	SvCUR_set(linestr,
-- 
2.7.4