[perl #118931] Fix line number bug

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 13265e1..362aa71 100644 (file)
--- 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 =
@@ -1753,37 +1753,16 @@ S_incline(pTHX_ const char *s)
 
     if (t - s > 0) {
        const STRLEN len = t - s;
-       SV *const temp_sv = CopFILESV(PL_curcop);
-       const char *cf;
-       STRLEN tmplen;
-
-       if (temp_sv) {
-           cf = SvPVX(temp_sv);
-           tmplen = SvCUR(temp_sv);
-       } else {
-           cf = NULL;
-           tmplen = 0;
-       }
 
        if (!PL_rsfp && !PL_parser->filtered) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
            /* However, the long form of evals is only turned on by the
               debugger - usually they're "(eval %lu)" */
-           char smallbuf[128];
-           char *tmpbuf;
-           GV **gvp;
-           STRLEN tmplen2 = len;
-           if (tmplen + 2 <= sizeof smallbuf)
-               tmpbuf = smallbuf;
-           else
-               Newx(tmpbuf, tmplen + 2, char);
-           tmpbuf[0] = '_';
-           tmpbuf[1] = '<';
-           memcpy(tmpbuf + 2, cf, tmplen);
-           tmplen += 2;
-           gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
-           if (gvp) {
+           GV * const cfgv = CopFILEGV(PL_curcop);
+           if (cfgv) {
+               char smallbuf[128];
+               STRLEN tmplen2 = len;
                char *tmpbuf2;
                GV *gv2;
 
@@ -1792,12 +1771,8 @@ S_incline(pTHX_ const char *s)
                else
                    Newx(tmpbuf2, tmplen2 + 2, char);
 
-               if (tmpbuf2 != smallbuf || tmpbuf != smallbuf) {
-                   /* Either they malloc'd it, or we malloc'd it,
-                      so no prefix is present in ours.  */
-                   tmpbuf2[0] = '_';
-                   tmpbuf2[1] = '<';
-               }
+               tmpbuf2[0] = '_';
+               tmpbuf2[1] = '<';
 
                memcpy(tmpbuf2 + 2, s, tmplen2);
                tmplen2 += 2;
@@ -1811,11 +1786,11 @@ S_incline(pTHX_ const char *s)
                       alias the saved lines that are in the array.
                       Otherwise alias the whole array. */
                    if (CopLINE(PL_curcop) == line_num) {
-                       GvHV(gv2) = MUTABLE_HV(SvREFCNT_inc(GvHV(*gvp)));
-                       GvAV(gv2) = MUTABLE_AV(SvREFCNT_inc(GvAV(*gvp)));
+                       GvHV(gv2) = MUTABLE_HV(SvREFCNT_inc(GvHV(cfgv)));
+                       GvAV(gv2) = MUTABLE_AV(SvREFCNT_inc(GvAV(cfgv)));
                    }
-                   else if (GvAV(*gvp)) {
-                       AV * const av = GvAV(*gvp);
+                   else if (GvAV(cfgv)) {
+                       AV * const av = GvAV(cfgv);
                        const I32 start = CopLINE(PL_curcop)+1;
                        I32 items = AvFILLp(av) - start;
                        if (items > 0) {
@@ -1830,7 +1805,6 @@ S_incline(pTHX_ const char *s)
 
                if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
            }
-           if (tmpbuf != smallbuf) Safefree(tmpbuf);
        }
        CopFILE_free(PL_curcop);
        CopFILE_setn(PL_curcop, s, len);
@@ -1895,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;
@@ -2576,7 +2548,7 @@ S_sublex_start(pTHX)
        return THING;
     }
     else if (op_type == OP_BACKTICK && PL_lex_op) {
-       /* readpipe() vas overriden */
+       /* readpipe() was overridden */
        cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
        pl_yylval.opval = PL_lex_op;
        PL_lex_op = NULL;
@@ -5626,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) {
@@ -5647,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
@@ -10073,7 +10054,7 @@ S_scan_heredoc(pTHX_ char *s)
            /* shared is only null if we have gone beyond the outermost
               lexing scope.  In a file, we will have broken out of the
               loop in the previous iteration.  In an eval, the string buf-
-              fer ends with "\n;", so the while condition below will have
+              fer ends with "\n;", so the while condition above will have
               evaluated to false.  So shared can never be null. */
            assert(shared);
            /* A LEXSHARED struct with a null ls_prev pointer is the outer-