This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-Dmad minitest failure bisect
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 6b5ef4f..173ded4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1197,12 +1197,10 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     STRLEN old_bufend_pos, new_bufend_pos;
     STRLEN bufptr_pos, oldbufptr_pos, oldoldbufptr_pos;
     STRLEN linestart_pos, last_uni_pos, last_lop_pos;
+    bool got_some_for_debugger = 0;
     bool got_some;
     if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
-#ifdef PERL_MAD
-    flags |= LEX_KEEP_PREVIOUS;
-#endif /* PERL_MAD */
     linestr = PL_parser->linestr;
     buf = SvPVX(linestr);
     if (!(flags & LEX_KEEP_PREVIOUS) &&
@@ -1231,7 +1229,10 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
        got_some = 0;
     } else if (filter_gets(linestr, old_bufend_pos)) {
        got_some = 1;
+       got_some_for_debugger = 1;
     } else {
+       if (!SvPOK(linestr))   /* can get undefined by filter_gets */
+           sv_setpvs(linestr, "");
        eof:
        /* End of real input.  Close filehandle (unless it was STDIN),
         * then add implicit termination.
@@ -1268,7 +1269,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
        PL_parser->last_uni = buf + last_uni_pos;
     if (PL_parser->last_lop)
        PL_parser->last_lop = buf + last_lop_pos;
-    if (got_some && (PERLDB_LINE || PERLDB_SAVESRC) &&
+    if (got_some_for_debugger && (PERLDB_LINE || PERLDB_SAVESRC) &&
            PL_curstash != PL_debstash) {
        /* debugger active and we're not compiling the debugger code,
         * so store the line into the debugger's array of lines
@@ -3867,6 +3868,7 @@ Perl_yylex(pTHX)
     register char *d;
     STRLEN len;
     bool bof = FALSE;
+    U32 fake_eof = 0;
 
     /* orig_keyword, gvp, and gv are initialized here because
      * jump to the label just_a_word_zero can bypass their
@@ -4314,16 +4316,20 @@ Perl_yylex(pTHX)
            goto retry;
        }
        do {
-           U32 fake_eof = 0;
+           fake_eof = 0;
+           bof = PL_rsfp ? TRUE : FALSE;
            if (0) {
              fake_eof:
                fake_eof = LEX_FAKE_EOF;
            }
            PL_bufptr = PL_bufend;
+           CopLINE_inc(PL_curcop);
            if (!lex_next_chunk(fake_eof)) {
+               CopLINE_dec(PL_curcop);
                s = PL_bufptr;
                TOKEN(';');     /* not infinite loop because rsfp is NULL now */
            }
+           CopLINE_dec(PL_curcop);
 #ifdef PERL_MAD
            if (!PL_rsfp)
                PL_realtokenstart = -1;
@@ -4331,25 +4337,11 @@ Perl_yylex(pTHX)
            s = PL_bufptr;
            /* If it looks like the start of a BOM or raw UTF-16,
             * check if it in fact is. */
-           bof = PL_rsfp ? TRUE : FALSE;
-           if (bof &&
+           if (bof && PL_rsfp &&
                     (*s == 0 ||
                      *(U8*)s == 0xEF ||
                      *(U8*)s >= 0xFE ||
                      s[1] == 0)) {
-#ifdef PERLIO_IS_STDIO
-#  ifdef __GNU_LIBRARY__
-#    if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
-#      define FTELL_FOR_PIPE_IS_BROKEN
-#    endif
-#  else
-#    ifdef __GLIBC__
-#      if __GLIBC__ == 1 /* maybe some glibc5 release had it like this? */
-#        define FTELL_FOR_PIPE_IS_BROKEN
-#      endif
-#    endif
-#  endif
-#endif
                bof = PerlIO_tell(PL_rsfp) == (Off_t)SvCUR(PL_linestr);
                if (bof) {
                    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -4373,8 +4365,6 @@ Perl_yylex(pTHX)
            incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
-           update_debugger_info(PL_linestr, NULL, 0);
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = NULL;
        if (CopLINE(PL_curcop) == 1) {
@@ -5451,7 +5441,7 @@ Perl_yylex(pTHX)
        d = s;
        {
            const char tmp = *s;
-           if (PL_lex_state == LEX_NORMAL)
+           if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
                s = SKIPSPACE1(s);
 
            if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
@@ -12028,10 +12018,12 @@ S_scan_heredoc(pTHX_ register char *s)
        }
 #endif
        PL_bufptr = s;
+       CopLINE_inc(PL_curcop);
        if (!outer || !lex_next_chunk(0)) {
            CopLINE_set(PL_curcop, (line_t)PL_multi_start);
            missingterm(PL_tokenbuf);
        }
+       CopLINE_dec(PL_curcop);
        s = PL_bufptr;
 #ifdef PERL_MAD
        stuffstart = s - SvPVX(PL_linestr);
@@ -12054,8 +12046,6 @@ S_scan_heredoc(pTHX_ register char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
-           update_debugger_info(PL_linestr, NULL, 0);
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
            *(SvPVX(PL_linestr) + off ) = ' ';