[perl #123893] Fix hang with "@{"

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 3eb6bac..4910b6b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -503,6 +503,9 @@ S_ao(pTHX_ int toketype)
  * It prints "Missing operator before end of line" if there's nothing
  * after the missing operator, or "... before <...>" if there is something
  * after the missing operator.
+ *
+ * PL_bufptr is expected to point to the start of the thing that was found,
+ * and s after the next token or partial token.
  */
 
 STATIC void
@@ -1249,7 +1252,7 @@ buffer has reached the end of the input text.
 */
 
 #define LEX_FAKE_EOF 0x80000000
-#define LEX_NO_TERM  0x40000000
+#define LEX_NO_TERM  0x40000000 /* here-doc */
 
 bool
 Perl_lex_next_chunk(pTHX_ U32 flags)
@@ -1263,6 +1266,8 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     bool got_some;
     if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
+    if (!(flags & LEX_NO_TERM) && PL_lex_inwhat)
+       return FALSE;
     linestr = PL_parser->linestr;
     buf = SvPVX(linestr);
     if (!(flags & LEX_KEEP_PREVIOUS) &&
@@ -1517,6 +1522,8 @@ Perl_lex_read_space(pTHX_ U32 flags)
                incline(s);
                need_incline = 0;
            }
+       } else if (!c) {
+           s++;
        } else {
            break;
        }
@@ -1793,13 +1800,13 @@ S_skipspace_flags(pTHX_ char *s, U32 flags)
 {
     PERL_ARGS_ASSERT_SKIPSPACE_FLAGS;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
-       while (s < PL_bufend && SPACE_OR_TAB(*s))
+       while (s < PL_bufend && (SPACE_OR_TAB(*s) || !*s))
            s++;
     } else {
        STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
        PL_bufptr = s;
        lex_read_space(flags | LEX_KEEP_PREVIOUS |
-               (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+               (PL_lex_inwhat || PL_lex_state == LEX_FORMLINE ?
                    LEX_NO_NEXT_CHUNK : 0));
        s = PL_bufptr;
        PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
@@ -1902,6 +1909,7 @@ S_force_next(pTHX_ I32 type)
        tokereport(type, &NEXTVAL_NEXTTOKE);
     }
 #endif
+    assert(PL_nexttoke < C_ARRAY_LENGTH(PL_nexttype));
     PL_nexttype[PL_nexttoke] = type;
     PL_nexttoke++;
     if (PL_lex_state != LEX_KNOWNEXT) {
@@ -2478,7 +2486,6 @@ S_sublex_done(pTHX)
        PL_bufend = SvPVX(PL_linestr);
        PL_bufend += SvCUR(PL_linestr);
        PL_expect = XOPERATOR;
-       PL_sublex_info.sub_inwhat = 0;
        return ')';
     }
 }
@@ -4306,13 +4313,8 @@ Perl_yylex(pTHX)
        SvREFCNT_dec(tmp);
     } );
 
-    switch (PL_lex_state) {
-    case LEX_NORMAL:
-    case LEX_INTERPNORMAL:
-       break;
-
     /* when we've already built the next token, just pull it out of the queue */
-    case LEX_KNOWNEXT:
+    if (PL_nexttoke) {
        PL_nexttoke--;
        pl_yylval = PL_nextval[PL_nexttoke];
        if (!PL_nexttoke) {
@@ -4337,6 +4339,12 @@ Perl_yylex(pTHX)
            }
            return REPORT(next_type == 'p' ? pending_ident() : next_type);
        }
+    }
+
+    switch (PL_lex_state) {
+    case LEX_NORMAL:
+    case LEX_INTERPNORMAL:
+       break;
 
     /* interpolated case modifiers like \L \U, including \Q and \E.
        when we get here, PL_bufptr is at the \
@@ -4616,7 +4624,8 @@ Perl_yylex(pTHX)
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
     case 0:
-       if (!PL_rsfp && (!PL_parser->filtered || s+1 < PL_bufend)) {
+       if ((!PL_rsfp || PL_lex_inwhat)
+        && (!PL_parser->filtered || s+1 < PL_bufend)) {
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets &&
@@ -4955,7 +4964,6 @@ Perl_yylex(pTHX)
        }
        if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
            PL_lex_state = LEX_FORMLINE;
-           NEXTVAL_NEXTTOKE.ival = 0;
            force_next(FORMRBRACK);
            TOKEN(';');
        }
@@ -4998,7 +5006,6 @@ Perl_yylex(pTHX)
                 incline(s);
            if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
                PL_lex_state = LEX_FORMLINE;
-               NEXTVAL_NEXTTOKE.ival = 0;
                force_next(FORMRBRACK);
                TOKEN(';');
            }
@@ -5747,13 +5754,12 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '&';
        s = scan_ident(s - 1, PL_tokenbuf + 1,
                       sizeof PL_tokenbuf - 1, TRUE);
+       pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
        if (PL_tokenbuf[1]) {
-           PL_expect = XOPERATOR;
            force_ident_maybe_lex('&');
        }
        else
            PREREF('&');
-       pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
        TERM('&');
 
     case '|':
@@ -5994,8 +6000,14 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '$';
        s = scan_ident(s, PL_tokenbuf + 1,
                       sizeof PL_tokenbuf - 1, FALSE);
-       if (PL_expect == XOPERATOR)
-           no_op("Scalar", s);
+       if (PL_expect == XOPERATOR) {
+           d = s;
+           if (PL_bufptr > s) {
+               d = PL_bufptr-1;
+               PL_bufptr = PL_oldbufptr;
+           }
+           no_op("Scalar", d);
+       }
        if (!PL_tokenbuf[1]) {
            if (s == PL_bufend)
                yyerror("Final $ should be \\$ or $name");
@@ -7677,10 +7689,8 @@ Perl_yylex(pTHX)
            }
            if (!words)
                words = newNULLLIST();
-           if (PL_lex_stuff) {
-               SvREFCNT_dec(PL_lex_stuff);
-               PL_lex_stuff = NULL;
-           }
+           SvREFCNT_dec_NN(PL_lex_stuff);
+           PL_lex_stuff = NULL;
            PL_expect = XOPERATOR;
            pl_yylval.opval = sawparens(words);
            TOKEN(QWLIST);
@@ -8586,7 +8596,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
 
     PERL_ARGS_ASSERT_SCAN_IDENT;
 
-    if (isSPACE(*s))
+    if (isSPACE(*s) || !*s)
        s = skipspace(s);
     if (isDIGIT(*s)) {
        while (isDIGIT(*s)) {
@@ -8995,10 +9005,8 @@ S_scan_subst(pTHX_ char *start)
     first_line = CopLINE(PL_curcop);
     s = scan_str(s,FALSE,FALSE,FALSE,NULL);
     if (!s) {
-       if (PL_lex_stuff) {
-           SvREFCNT_dec(PL_lex_stuff);
-           PL_lex_stuff = NULL;
-       }
+       SvREFCNT_dec_NN(PL_lex_stuff);
+       PL_lex_stuff = NULL;
        Perl_croak(aTHX_ "Substitution replacement not terminated");
     }
     PL_multi_start = first_start;      /* so whole substitution is taken together */
@@ -9077,10 +9085,8 @@ S_scan_trans(pTHX_ char *start)
 
     s = scan_str(s,FALSE,FALSE,FALSE,NULL);
     if (!s) {
-       if (PL_lex_stuff) {
-           SvREFCNT_dec(PL_lex_stuff);
-           PL_lex_stuff = NULL;
-       }
+       SvREFCNT_dec_NN(PL_lex_stuff);
+       PL_lex_stuff = NULL;
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }