From bf1b738b6190342ba8d6c94bea457aa9c7c17d40 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 22 Aug 2013 10:01:58 -0700
Subject: [PATCH] [perl #118931] Fix line number bug
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Commit 2179133 (in 5.19.2) introduced this line number bug when it
modified the parser to look past newlines when searching for => after
a keyword:

$ perl5.19.3
1 unless
1;
warn;
^D
Warning: something's wrong at - line 2.

The warning should say line 3, not 2.

Before 2179133, the parser’s line-reading algorithm work strictly in
two modes:  From a file, one line would be read into PL_linestr at a
time.  In a string eval, PL_linestr would contain all the code.

To be able to look past a newline to find => after a keyword, the
parser’s former mode had to be adjusted:

• It has to be possible to append more lines of input to the buffer
  without incrementing the line number.
• When reading from a filehandle, the lexer should not assume when it
  sees "\n" that it has reached the end of the buffer.

Commit 2179133 did those two things.

It did not, however, make the lexer increment the line number when
encountering a newline in the middle of it (when reading from a han-
dle; string eval follows a different code path).

Fixing it to do that requires that lex_start be adjusted, too.  When
lexing begins, PL_linestr is set to "\n;" when there is no string to
eval.  This worked for file handles because the lexer, on seeing the
\n, would ignore the semicolon.

Now that it no longer ignores the semicolon, it will end up incre-
mented the line number erroneously at the outset, so set the buffer
to just "\n" instead.

In one place (skipspace2), the mad-specific code was setting PL_bufptr
to point at its previous location after calling skipspace.  skipspace
sets it to point after the newline to prevent incline() from being
called a second time for the same newline.  But this is exactly what
happens if skipspace2 resets PL_bufptr.  The callers of skipspace2
apparently don’t depend on this, so we can remove it.
---
 t/comp/parser.t |  7 ++++++-
 toke.c          | 15 +++++++++++----
 2 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/t/comp/parser.t b/t/comp/parser.t
index a9b044a..027d712 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -8,7 +8,7 @@ BEGIN {
     chdir 't';
 }
 
-print "1..158\n";
+print "1..160\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -506,6 +506,11 @@ sub check ($$$) {
 
 my $this_file = qr/parser\.t(?:\.[bl]eb?)?$/;
 #line 3
+1 unless
+1;
+check($this_file, 5, "[perl #118931]");
+
+#line 3
 check($this_file, 3, "bare line");
 
 # line 5
diff --git a/toke.c b/toke.c
index 4f3eee9..362aa71 100644
--- a/toke.c
+++ b/toke.c
@@ -753,9 +753,9 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 	parser->linestr = flags & LEX_START_COPIED
 			    ? SvREFCNT_inc_simple_NN(line)
 			    : newSVpvn_flags(s, len, SvUTF8(line));
-	sv_catpvs(parser->linestr, "\n;");
+	sv_catpvn(parser->linestr, "\n;", rsfp ? 1 : 2);
     } else {
-	parser->linestr = newSVpvs("\n;");
+	parser->linestr = newSVpvn("\n;", rsfp ? 1 : 2);
     }
     parser->oldoldbufptr =
 	parser->oldbufptr =
@@ -1869,13 +1869,11 @@ STATIC char *
 S_skipspace2(pTHX_ char *s, SV **svp)
 {
     char *start;
-    const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
     const I32 startoff = s - SvPVX(PL_linestr);
 
     PERL_ARGS_ASSERT_SKIPSPACE2;
 
     s = skipspace(s);
-    PL_bufptr = SvPVX(PL_linestr) + bufptroff;
     if (!PL_madskills || !svp)
 	return s;
     start = SvPVX(PL_linestr) + startoff;
@@ -5600,7 +5598,11 @@ Perl_yylex(pTHX)
 		    while (d < PL_bufend && *d != '\n')
 			d++;
 		    if (d < PL_bufend)
+		    {
 			d++;
+			if (d < PL_bufend)
+			    incline(s);
+		    }
 		    else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */
 		      Perl_croak(aTHX_ "panic: input overflow");
 		    if (PL_madskills && CopLINE(PL_curcop) >= 1) {
@@ -5621,7 +5623,12 @@ Perl_yylex(pTHX)
 	    while (s < PL_bufend && *s != '\n')
 		s++;
 	    if (s < PL_bufend)
+	    {
 		s++;
+		if (s < PL_bufend)
+		    incline(s);
+	    }
+		
 	    else if (s > PL_bufend) /* Found by Ilya: feed random input to Perl. */
 	      Perl_croak(aTHX_ "panic: input overflow");
 #endif
-- 
1.8.3.1