This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix line numbers in <<foo,<<bar
authorFather Chrysostomos <sprout@cpan.org>
Sat, 7 Sep 2013 07:27:28 +0000 (00:27 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Sep 2013 01:34:36 +0000 (18:34 -0700)
This used to print 9:

<<foo, <<bar
a
b
c
d
e
f
g
foo
${warn __LINE__ }
bar

even though the __LINE__ marker is on line 10.  In perl 5.18, I broke
it further, making it print 2.

This commit makes it print 10.  We just need to make sure
PL_multi_start is set correctly in scan_heredoc for a second here-doc
marker on the same line.

t/comp/parser.t
toke.c

index cca4966..a881d4c 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     chdir 't';
 }
 
-print "1..159\n";
+print "1..165\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -588,10 +588,23 @@ EOU
 s//<<EOV/e if 0;
 EOV
 check_line(535, 'after here-doc in quotes');
-<<EOW;
+<<EOW; <<EOX;
 ${check_line(537, 'first line of interp in here-doc');;
   check_line(538, 'second line of interp in here-doc');}
 EOW
+${check_line(540, 'first line of interp in second here-doc on same line');;
+  check_line(541, 'second line of interp in second heredoc on same line');}
+EOX
+eval <<'EVAL';
+#line 545
+"${<<EOY; <<EOZ}";
+${check_line(546, 'first line of interp in here-doc in quotes in eval');;
+  check_line(547, 'second line of interp in here-doc in quotes in eval');}
+EOY
+${check_line(549, '1st line of interp in 2nd hd, same line in q in eval');;
+  check_line(550, '2nd line of interp in 2nd hd, same line in q in eval');}
+EOZ
+EVAL
 
 time
 #line 42
diff --git a/toke.c b/toke.c
index 32a5a42..5282f87 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2655,7 +2655,7 @@ S_sublex_push(pTHX)
     PL_lex_starts = 0;
     PL_lex_state = LEX_INTERPCONCAT;
     if (is_heredoc)
-       CopLINE_inc(PL_curcop);
+       CopLINE_set(PL_curcop, (line_t)PL_multi_start);
     PL_copline = NOLINE;
     
     Newxz(shared, 1, LEXSHARED);
@@ -9935,6 +9935,7 @@ S_scan_heredoc(pTHX_ char *s)
     char *e;
     char *peek;
     const bool infile = PL_rsfp || PL_parser->filtered;
+    const line_t origline = CopLINE(PL_curcop);
     LEXSHARED *shared = PL_parser->lex_shared;
 #ifdef PERL_MAD
     I32 stuffstart = s - SvPVX(PL_linestr);
@@ -10036,7 +10037,7 @@ S_scan_heredoc(pTHX_ char *s)
        SvIV_set(tmpstr, '\\');
     }
 
-    PL_multi_start = CopLINE(PL_curcop) + 1;
+    PL_multi_start = origline + 1;
     PL_multi_open = PL_multi_close = '<';
     /* inside a string eval or quote-like operator */
     if (!infile || PL_lex_inwhat) {
@@ -10077,6 +10078,7 @@ S_scan_heredoc(pTHX_ char *s)
            s = (char*)memchr((void*)s, '\n', PL_bufend - s);
            assert(s);
        }
+       PL_multi_start += shared->herelines;
        linestr = shared->ls_linestr;
        bufend = SvEND(linestr);
        d = s;
@@ -10139,6 +10141,7 @@ S_scan_heredoc(pTHX_ char *s)
     {
       SV *linestr_save;
      streaming:
+      PL_multi_start += shared->herelines;
       sv_setpvs(tmpstr,"");   /* avoid "uninitialized" warning */
       term = PL_tokenbuf[1];
       len--;
@@ -10158,13 +10161,13 @@ S_scan_heredoc(pTHX_ char *s)
 #endif
        PL_bufptr = PL_bufend;
        CopLINE_set(PL_curcop,
-                   PL_multi_start + shared->herelines);
+                   origline + 1 + shared->herelines);
        if (!lex_next_chunk(LEX_NO_TERM)
         && (!SvCUR(tmpstr) || SvEND(tmpstr)[-1] != '\n')) {
            SvREFCNT_dec(linestr_save);
            goto interminable;
        }
-       CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
+       CopLINE_set(PL_curcop, origline);
        if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') {
             s = lex_grow_linestr(SvLEN(PL_linestr) + 3);
             /* ^That should be enough to avoid this needing to grow:  */
@@ -10222,7 +10225,7 @@ S_scan_heredoc(pTHX_ char *s)
 
   interminable:
     SvREFCNT_dec(tmpstr);
-    CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
+    CopLINE_set(PL_curcop, origline);
     missingterm(PL_tokenbuf + 1);
 }