This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
toke.c: Skip PL_expect assignment under KEY_require
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 4620c10..36d41f4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -114,6 +114,11 @@ static const char* const ident_too_long = "Identifier too long";
 
 #define SPACE_OR_TAB(c) isBLANK_A(c)
 
+#define HEXFP_PEEK(s)     \
+    (((s[0] == '.') && \
+      (isXDIGIT(s[1]) || isALPHA_FOLD_EQ(s[1], 'p'))) || \
+     isALPHA_FOLD_EQ(s[0], 'p'))
+
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
@@ -212,7 +217,11 @@ static const char* const lex_state_names[] = {
 #define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
 #define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
 #define POSTDEREF(f) return (PL_bufptr = s, S_postderef(aTHX_ REPORT(f),s[1]))
-#define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define LOOPX(f) return (PL_expect = XOPERATOR, \
+                        PL_bufptr = force_word(s,WORD,TRUE,FALSE), \
+                        pl_yylval.ival=f, \
+                        (void)(PL_nexttoke || (PL_expect = XTERM)), \
+                        REPORT((int)LOOPEX))
 #define FTST(f)  return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
 #define FUN0(f)  return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
 #define FUN0OP(f)  return (pl_yylval.opval=f, CLINE, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0OP))
@@ -1843,7 +1852,10 @@ S_check_uni(pTHX)
 /*
  * S_lop
  * Build a list operator (or something that might be one).  The rules:
- *  - if we have a next token, then it's a list operator [why?]
+ *  - if we have a next token, then it's a list operator (no parens) for
+ *    which the next token has already been parsed; e.g.,
+ *       sort foo @args
+ *       sort foo (@args)
  *  - if the next thing is an opening paren, then it's a function
  *  - else it's a list operator
  */
@@ -1855,12 +1867,12 @@ S_lop(pTHX_ I32 f, int x, char *s)
 
     pl_yylval.ival = f;
     CLINE;
-    PL_expect = x;
     PL_bufptr = s;
     PL_last_lop = PL_oldbufptr;
     PL_last_lop_op = (OPCODE)f;
     if (PL_nexttoke)
        goto lstop;
+    PL_expect = x;
     if (*s == '(')
        return REPORT(FUNC);
     s = PEEKSPACE(s);
@@ -3496,7 +3508,7 @@ S_scan_const(pTHX_ char *start)
                *d++ = '\t';
                break;
            case 'e':
-               *d++ = ASCII_TO_NATIVE('\033');
+               *d++ = ESC_NATIVE;
                break;
            case 'a':
                *d++ = '\a';
@@ -4154,7 +4166,8 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
 #ifdef DEBUGGING
     static const char* const exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
-         "ATTRTERM", "TERMBLOCK", "POSTDEREF", "TERMORDORDOR"
+         "ATTRTERM", "TERMBLOCK", "XBLOCKTERM", "POSTDEREF",
+         "TERMORDORDOR"
        };
 #endif
 
@@ -4787,7 +4800,7 @@ Perl_yylex(pTHX)
                     * line contains "Perl" rather than "perl" */
                    if (!d) {
                        for (d = ipathend-4; d >= ipath; --d) {
-                           if ((*d == 'p' || *d == 'P')
+                           if (isALPHA_FOLD_EQ(*d, 'p')
                                && !ibcmp(d, "perl", 4))
                            {
                                break;
@@ -4869,7 +4882,7 @@ Perl_yylex(pTHX)
                                    != PL_unicode)
                                    baduni = TRUE;
                            }
-                           if (baduni || *d1 == 'M' || *d1 == 'm') {
+                           if (baduni || isALPHA_FOLD_EQ(*d1, 'M')) {
                                const char * const m = d1;
                                while (*d1 && !isSPACE(*d1))
                                    d1++;
@@ -5373,7 +5386,8 @@ Perl_yylex(pTHX)
            TOKEN(0);
        CLINE;
        s++;
-       OPERATOR(';');
+       PL_expect = XSTATE;
+       TOKEN(';');
     case ')':
        if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_CLOSING)
            TOKEN(0);
@@ -7074,8 +7088,6 @@ Perl_yylex(pTHX)
            UNI(OP_DBMCLOSE);
 
        case KEY_dump:
-           PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_DUMP);
 
        case KEY_else:
@@ -7199,8 +7211,6 @@ Perl_yylex(pTHX)
            LOP(OP_GREPSTART, XREF);
 
        case KEY_goto:
-           PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_GOTO);
 
        case KEY_gmtime:
@@ -7325,8 +7335,6 @@ Perl_yylex(pTHX)
            LOP(OP_KILL,XTERM);
 
        case KEY_last:
-           PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_LAST);
        
        case KEY_lc:
@@ -7425,8 +7433,6 @@ Perl_yylex(pTHX)
            OPERATOR(MY);
 
        case KEY_next:
-           PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_NEXT);
 
        case KEY_ne:
@@ -7436,7 +7442,7 @@ Perl_yylex(pTHX)
 
        case KEY_no:
            s = tokenize_use(0, s);
-           TERM(USE);
+           TOKEN(USE);
 
        case KEY_not:
            if (*s == '(' || (s = SKIPSPACE1(s), *s == '('))
@@ -7626,7 +7632,7 @@ Perl_yylex(pTHX)
            }
            else 
                pl_yylval.ival = 0;
-           PL_expect = XTERM;
+           if (!PL_nexttoke) PL_expect = XTERM;
            PL_bufptr = s;
            PL_last_uni = PL_oldbufptr;
            PL_last_lop_op = OP_REQUIRE;
@@ -7637,8 +7643,6 @@ Perl_yylex(pTHX)
            UNI(OP_RESET);
 
        case KEY_redo:
-           PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_REDO);
 
        case KEY_rename:
@@ -7999,7 +8003,7 @@ Perl_yylex(pTHX)
 
        case KEY_use:
            s = tokenize_use(1, s);
-           OPERATOR(USE);
+           TOKEN(USE);
 
        case KEY_values:
            UNI(OP_VALUES);
@@ -9780,9 +9784,10 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
 
   \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*)     12 12.34 12.
   \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*)                    .34
-  0b[01](_?[01])*
-  0[0-7](_?[0-7])*
-  0x[0-9A-Fa-f](_?[0-9A-Fa-f])*
+  0b[01](_?[01])*                                       binary integers
+  0[0-7](_?[0-7])*                                      octal integers
+  0x[0-9A-Fa-f](_?[0-9A-Fa-f])*                         hexadecimal integers
+  0x[0-9A-Fa-f](_?[0-9A-Fa-f])*(?:\.\d*)?p[+-]?[0-9]+   hexadecimal floats
 
   Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the
   thing it reads.
@@ -9805,16 +9810,18 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     static const char* const number_too_long = "Number too long";
     /* Hexadecimal floating point.
      *
-     * In many places (where UV is quad and NV is IEEE 754 double)
-     * we can fit the mantissa bits of a NV into a UV.  This will not
-     * work everywhere, though (either no quads, or using long doubles),
-     * in which case we have to resort to NV, which will probably mean
-     * horrible loss of precision due to multiple fp operations. */
+     * In many places (where we have quads and NV is IEEE 754 double)
+     * we can fit the mantissa bits of a NV into an unsigned quad.
+     * (Note that UVs might not be quads even when we have quads.)
+     * This will not work everywhere, though (either no quads, or
+     * using long doubles), in which case we have to resort to NV,
+     * which will probably mean horrible loss of precision due to
+     * multiple fp operations. */
     bool hexfp = FALSE;
     int total_bits = 0;
-#if UVSIZE == 8 && NVSIZE == 8
-#  define HEXFP_UV
-    UV hexfp_uv = 0;
+#if NVSIZE == 8 && defined(HAS_QUAD) && defined(Uquad_t)
+#  define HEXFP_UQUAD
+    Uquad_t hexfp_uquad = 0;
     int hexfp_frac_bits = 0;
 #else
 #  define HEXFP_NV
@@ -9864,17 +9871,17 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            const char *base, *Base, *max;
 
            /* check for hex */
-           if (s[1] == 'x' || s[1] == 'X') {
+           if (isALPHA_FOLD_EQ(s[1], 'x')) {
                shift = 4;
                s += 2;
                just_zero = FALSE;
-           } else if (s[1] == 'b' || s[1] == 'B') {
+           } else if (isALPHA_FOLD_EQ(s[1], 'b')) {
                shift = 1;
                s += 2;
                just_zero = FALSE;
            }
            /* check for a decimal in disguise */
-           else if (s[1] == '.' || s[1] == 'e' || s[1] == 'E')
+           else if (s[1] == '.' || isALPHA_FOLD_EQ(s[1], 'e'))
                goto decimal;
            /* so it must be octal */
            else {
@@ -9976,10 +9983,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
                     /* this could be hexfp, but peek ahead
                      * to avoid matching ".." */
-#define HEXFP_PEEK(s) \
-       (((s[0] == '.') && \
-         (isXDIGIT(s[1]) || s[1] == 'p' || s[1] == 'P')) \
-        || s[0] == 'p' || s[0] == 'P')
                     if (UNLIKELY(HEXFP_PEEK(s))) {
                         goto out;
                     }
@@ -10004,30 +10007,27 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                  * detection will shortly be more thorough with the
                  * underbar checks. */
                 const char* h = s;
-#ifdef HEXFP_UV
-                hexfp_uv = u;
+#ifdef HEXFP_UQUAD
+                hexfp_uquad = u;
 #else /* HEXFP_NV */
                 hexfp_nv = u;
 #endif
                 if (*h == '.') {
 #ifdef HEXFP_NV
-                    NV hfm = 1 / 16.0;
+                    NV mult = 1 / 16.0;
 #endif
                     h++;
                     while (isXDIGIT(*h) || *h == '_') {
                         if (isXDIGIT(*h)) {
-                            const char* p = strchr(PL_hexdigit, *h);
-                            U8 b;
-                            assert(p);
-                            b = ((p - PL_hexdigit) & 0x0F);
+                            U8 b = XDIGIT_VALUE(*h);
                             total_bits += shift;
-#ifdef HEXFP_UV
-                            hexfp_uv <<= shift;
-                            hexfp_uv |= b;
+#ifdef HEXFP_UQUAD
+                            hexfp_uquad <<= shift;
+                            hexfp_uquad |= b;
                             hexfp_frac_bits += shift;
 #else /* HEXFP_NV */
-                            hexfp_nv += b * hfm;
-                            hfm /= 16.0;
+                            hexfp_nv += b * mult;
+                            mult /= 16.0;
 #endif
                         }
                         h++;
@@ -10043,7 +10043,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                         total_bits--;
                 }
 
-                if (total_bits > 0 && (*h == 'p' || *h == 'P')) {
+                if (total_bits > 0 && (isALPHA_FOLD_EQ(*h, 'p'))) {
                     bool negexp = FALSE;
                     h++;
                     if (*h == '+')
@@ -10065,7 +10065,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                                                    "Hexadecimal float: exponent underflow");
 #endif
                                     break;
-                                } else {
+                                }
+                                else {
 #ifdef NV_MAX_EXP
                                     if (!negexp &&
                                         hexfp_exp > NV_MAX_EXP - 1) {
@@ -10080,7 +10081,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                         }
                         if (negexp)
                             hexfp_exp = -hexfp_exp;
-#ifdef HEXFP_UV
+#ifdef HEXFP_UQUAD
                         hexfp_exp -= hexfp_frac_bits;
 #endif
                         hexfp_mult = pow(2.0, hexfp_exp);
@@ -10201,17 +10202,19 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
        }
 
        /* read exponent part, if present */
-       if (((*s == 'e' || *s == 'E') ||
-             UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) &&
-            strchr("+-0123456789_", s[1])) {
+       if ((isALPHA_FOLD_EQ(*s, 'e')
+              || UNLIKELY(hexfp && isALPHA_FOLD_EQ(*s, 'p')))
+            && strchr("+-0123456789_", s[1]))
+        {
             floatit = TRUE;
 
            /* regardless of whether user said 3E5 or 3e5, use lower 'e',
                ditto for p (hexfloats) */
-            if ((*s == 'e' || *s == 'E')) {
+            if ((isALPHA_FOLD_EQ(*s, 'e'))) {
                /* At least some Mach atof()s don't grok 'E' */
                 *d++ = 'e';
-            } else if (UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) {
+            }
+            else if (UNLIKELY(hexfp && (isALPHA_FOLD_EQ(*s, 'p')))) {
                 *d++ = 'p';
             }
 
@@ -10286,8 +10289,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                     Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                                    "Hexadecimal float: mantissa overflow");
 #  endif
-#ifdef HEXFP_UV
-                nv = hexfp_uv * hexfp_mult;
+#ifdef HEXFP_UQUAD
+                nv = hexfp_uquad * hexfp_mult;
 #else /* HEXFP_NV */
                 nv = hexfp_nv * hexfp_mult;
 #endif