note about undocumented caller() return value (from M.J.T. Guy);
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 2035c3f..6af744c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -896,7 +896,7 @@ S_tokeq(pTHX_ SV *sv)
        goto finish;
 
     s = SvPV_force(sv, len);
-    if (SvIVX(sv) == -1)
+    if (SvTYPE(sv) >= SVt_PVIV && SvIVX(sv) == -1)
        goto finish;
     send = s + len;
     while (s < send && *s != '\\')
@@ -1377,7 +1377,7 @@ S_scan_const(pTHX_ char *start)
            default:
                {
                    dTHR;
-                   if (ckWARN(WARN_MISC) && isALPHA(*s))
+                   if (ckWARN(WARN_MISC) && isALNUM(*s))
                        Perl_warner(aTHX_ WARN_MISC, 
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1389,6 +1389,7 @@ S_scan_const(pTHX_ char *start)
            /* \132 indicates an octal constant */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
+               len = 0;        /* disallow underscores */
                uv = (UV)scan_oct(s, 3, &len);
                s += len;
                goto NUM_ESCAPE_INSERT;
@@ -1402,10 +1403,12 @@ S_scan_const(pTHX_ char *start)
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
+                   len = 1;            /* allow underscores */
                     uv = (UV)scan_hex(s + 1, e - s - 1, &len);
                     s = e + 1;
                }
                else {
+                   len = 0;            /* disallow underscores */
                    uv = (UV)scan_hex(s, 2, &len);
                    s += len;
                }
@@ -2656,6 +2659,11 @@ Perl_yylex(pTHX)
     case '#':
     case '\n':
        if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
+           if (*s == '#' && s == PL_linestart && PL_in_eval && !PL_rsfp) {
+               /* handle eval qq[#line 1 "foo"\n ...] */
+               CopLINE_dec(PL_curcop);
+               incline(s);
+           }
            d = PL_bufend;
            while (s < d && *s != '\n')
                s++;
@@ -3619,7 +3627,7 @@ Perl_yylex(pTHX)
        tmp = keyword(PL_tokenbuf, len);
 
        /* Is this a word before a => operator? */
-       if (strnEQ(d,"=>",2)) {
+       if (*d == '=' && d[1] == '>') {
            CLINE;
            yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
            yylval.opval->op_private = OPpCONST_BARE;
@@ -3774,10 +3782,18 @@ Perl_yylex(pTHX)
                    }
                }
 
-               /* If followed by a paren, it's certainly a subroutine. */
 
                PL_expect = XOPERATOR;
                s = skipspace(s);
+
+               /* Is this a word before a => operator? */
+               if (*s == '=' && s[1] == '>') {
+                   CLINE;
+                   sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+                   TERM(WORD);
+               }
+
+               /* If followed by a paren, it's certainly a subroutine. */
                if (*s == '(') {
                    CLINE;
                    if (gv && GvCVu(gv)) {
@@ -4496,7 +4512,7 @@ Perl_yylex(pTHX)
                            for (; !isSPACE(*d) && len; --len, ++d) ;
                        }
                        words = append_elem(OP_LIST, words,
-                                           newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
+                                           newSVOP(OP_CONST, 0, tokeq(newSVpvn(b, d-b))));
                    }
                }
                if (words) {
@@ -6689,7 +6705,7 @@ Perl_scan_num(pTHX_ char *start)
     register char *s = start;          /* current position in buffer */
     register char *d;                  /* destination in temp buffer */
     register char *e;                  /* end of temp buffer */
-    NV value;                          /* number read, as a double */
+    NV nv;                             /* number read, as a double */
     SV *sv = Nullsv;                   /* place to put the converted number */
     bool floatit;                      /* boolean: int or float? */
     char *lastub = 0;                  /* position of last underbar */
@@ -6946,40 +6962,9 @@ Perl_scan_num(pTHX_ char *start)
        /* make an sv from the string */
        sv = NEWSV(92,0);
 
-       /* unfortunately this monster needs to be on one line or
-          makedepend will be confused. */
-#if (defined(USE_64_BIT_INT) && (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || (!defined(USE_64_BIT_INT) && (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL)))
+#if defined(Strtol) && defined(Strtoul)
 
        /*
-          No working strto[u]l[l]. Since atoi() doesn't do range checks,
-          we need to do this the hard way.
-        */
-
-       value = Atof(PL_tokenbuf);
-
-       /* 
-          See if we can make do with an integer value without loss of
-          precision.  We use I_V to cast to an int, because some
-          compilers have issues.  Then we try casting it back and see
-          if it was the same.  We only do this if we know we
-          specifically read an integer.
-
-          Note: if floatit is true, then we don't need to do the
-          conversion at all.
-       */
-       {
-           UV tryuv = U_V(value);
-           if (!floatit && (NV)tryuv == value) {
-               if (tryuv <= IV_MAX)
-                   sv_setiv(sv, (IV)tryuv);
-               else
-                   sv_setuv(sv, tryuv);
-           }
-           else
-               sv_setnv(sv, value);
-       }
-#else
-       /*
           strtol/strtoll sets errno to ERANGE if the number is too big
           for an integer. We try to do an integer conversion first
           if no characters indicating "float" have been found.
@@ -6994,15 +6979,62 @@ Perl_scan_num(pTHX_ char *start)
            else
                uv = Strtoul(PL_tokenbuf, (char**)NULL, 10);
            if (errno)
-               floatit = TRUE; /* probably just too large */
+               floatit = TRUE; /* Probably just too large. */
            else if (*PL_tokenbuf == '-')
                sv_setiv(sv, iv);
+           else if (uv <= IV_MAX)
+               sv_setiv(sv, uv); /* Prefer IVs over UVs. */
            else
                sv_setuv(sv, uv);
        }
        if (floatit) {
-           value = Atof(PL_tokenbuf);
-           sv_setnv(sv, value);
+           nv = Atof(PL_tokenbuf);
+           sv_setnv(sv, nv);
+       }
+#else
+       /*
+          No working strtou?ll?.
+
+          Unfortunately atol() doesn't do range checks (returning
+          LONG_MIN/LONG_MAX, and setting errno to ERANGE on overflows)
+          everywhere [1], so we cannot use use atol() (or atoll()).
+          If we could, they would be used, as Atol(), very much like
+          Strtol() and Strtoul() are used above.
+
+          [1] XXX Configure test needed to check for atol()
+                  (and atoll() overflow behaviour) XXX --jhi
+
+          We need to do this the hard way.  */
+
+       nv = Atof(PL_tokenbuf);
+
+       /* See if we can make do with an integer value without loss of
+          precision.  We use U_V to cast to a UV, because some
+          compilers have issues.  Then we try casting it back and see
+          if it was the same [1].  We only do this if we know we
+          specifically read an integer.  If floatit is true, then we
+          don't need to do the conversion at all. 
+
+          [1] Note that this is lossy if our NVs cannot preserve our
+          UVs.  There is a metaconfig define, NV_PRESERVES_UV, but we
+          really do hope all such platforms have strtou?ll? to do a
+          lossless IV/UV conversion.
+          XXX Configure test needed to check how many UV bits
+              do our NVs preserve, really (the current test checks
+              for the roundtrip of ~0) XXX --jhi
+              Maybe do some tricks with DBL_MANT_DIG and LDBL_MANT_DIG,
+              and DBL_DIG, LDBL_DIG (this is already available as NV_DIG)?
+          */
+       {
+           UV uv = U_V(nv);
+           if (!floatit && (NV)uv == nv) {
+               if (uv <= IV_MAX)
+                   sv_setiv(sv, uv); /* Prefer IVs over UVs. */
+               else
+                   sv_setuv(sv, uv);
+           }
+           else
+               sv_setnv(sv, nv);
        }
 #endif
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :