integrate cfgperl contents into mainline

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 61d6bb4..cb6751a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1479,6 +1479,8 @@ S_scan_const(pTHX_ char *start)
                    res = new_constant( Nullch, 0, "charnames", 
                                        res, Nullsv, "\\N{...}" );
                    str = SvPV(res,len);
+                   if (len > 1)
+                       has_utf = TRUE;
                    if (len > e - s + 4) {
                        char *odest = SvPVX(sv);
 
@@ -3276,7 +3278,7 @@ Perl_yylex(pTHX)
        /* This kludge not intended to be bulletproof. */
        if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
            yylval.opval = newSVOP(OP_CONST, 0,
-                                  newSViv((IV)PL_compiling.cop_arybase));
+                                  newSViv(PL_compiling.cop_arybase));
            yylval.opval->op_private = OPpCONST_ARYBASE;
            TERM(THING);
        }
@@ -3958,7 +3960,8 @@ Perl_yylex(pTHX)
                s += 2;
                d = s;
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
-               tmp = keyword(PL_tokenbuf, len);
+               if (!(tmp = keyword(PL_tokenbuf, len)))
+                   Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
                if (tmp < 0)
                    tmp = -tmp;
                goto reserved_word;
@@ -5645,30 +5648,28 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     SV *res;
     SV **cvp;
     SV *cv, *typesv;
-    const char *why, *why1, *why2;
+    const char *why1, *why2, *why3;
     
-    if (!(PL_hints & HINT_LOCALIZE_HH)) {
+    if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
        SV *msg;
        
-       why = "%^H is not localized";
-    report_short:
-       why1 = why2 = "";
+       why1 = "%^H is not consistent";
+       why2 = strEQ(key,"charnames")
+              ? " (missing \"use charnames ...\"?)"
+              : "";
+       why3 = "";
     report:
        msg = Perl_newSVpvf(aTHX_ "constant(%s): %s%s%s", 
-                           (type ? type: "undef"), why1, why2, why);
+                           (type ? type: "undef"), why1, why2, why3);
        yyerror(SvPVX(msg));
        SvREFCNT_dec(msg);
        return sv;
     }
-    if (!table) {
-       why = "%^H is not defined";
-       goto report_short;
-    }
     cvp = hv_fetch(table, key, strlen(key), FALSE);
     if (!cvp || !SvOK(*cvp)) {
-       why = "} is not defined";
        why1 = "$^H{";
        why2 = key;
+       why3 = "} is not defined";
        goto report;
     }
     sv_2mortal(sv);                    /* Parent created it permanently */
@@ -5716,9 +5717,9 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     POPSTACK;
     
     if (!SvOK(res)) {
-       why = "}} did not return a defined value";
        why1 = "Call to &{$^H{";
        why2 = key;
+       why3 = "}} did not return a defined value";
        sv = res;
        goto report;
     }
@@ -6681,7 +6682,6 @@ 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 */
-    UV tryuv;                          /* used to see if it can be an UV */
     NV value;                          /* number read, as a double */
     SV *sv = Nullsv;                   /* place to put the converted number */
     bool floatit;                      /* boolean: int or float? */
@@ -6960,15 +6960,17 @@ Perl_scan_num(pTHX_ char *start)
           Note: if floatit is true, then we don't need to do the
           conversion at all.
        */
-       tryuv = U_V(value);
-       if (!floatit && (NV)tryuv == value) {
-           if (tryuv <= IV_MAX)
-               sv_setiv(sv, (IV)tryuv);
+       {
+           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_setuv(sv, tryuv);
+               sv_setnv(sv, value);
        }
-       else
-           sv_setnv(sv, value);
 #else
        /*
           strtol/strtoll sets errno to ERANGE if the number is too big
@@ -6977,22 +6979,14 @@ Perl_scan_num(pTHX_ char *start)
         */
 
        if (!floatit) {
-           char *tp;
            IV iv;
            UV uv;
            errno = 0;
-#ifdef USE_64_BIT_INT
-           if (*PL_tokenbuf == '-')
-               iv = strtoll(PL_tokenbuf,&tp,10);
-           else
-               uv = strtoull(PL_tokenbuf,&tp,10);
-#else
            if (*PL_tokenbuf == '-')
-               iv = strtol(PL_tokenbuf,&tp,10);
+               iv = Strtol(PL_tokenbuf, (char**)NULL, 10);
            else
-               uv = strtoul(PL_tokenbuf,&tp,10);
-#endif
-           if (*tp || errno)
+               uv = Strtoul(PL_tokenbuf, (char**)NULL, 10);
+           if (errno)
                floatit = TRUE; /* probably just too large */
            else if (*PL_tokenbuf == '-')
                sv_setiv(sv, iv);
@@ -7000,18 +6994,9 @@ Perl_scan_num(pTHX_ char *start)
                sv_setuv(sv, uv);
        }
        if (floatit) {
-           char *tp;
-           errno = 0;
-#ifdef USE_LONG_DOUBLE
-           value = strtold(PL_tokenbuf,&tp);
-#else
-           value = strtod(PL_tokenbuf,&tp);
-#endif
-           if (*tp || errno)
-               Perl_die(aTHX_ "unparseable float");
-           else
-               sv_setnv(sv, value);
-       } 
+           value = Atof(PL_tokenbuf);
+           sv_setnv(sv, value);
+       }
 #endif
        if ( floatit ? (PL_hints & HINT_NEW_FLOAT) :
                       (PL_hints & HINT_NEW_INTEGER) )
@@ -7020,7 +7005,7 @@ Perl_scan_num(pTHX_ char *start)
                              sv, Nullsv, NULL);
        break;
 
-    /* if it starts with a v, it could be a version number */
+    /* if it starts with a v, it could be a v-string */
     case 'v':
 vstring:
        {
@@ -7317,8 +7302,14 @@ Perl_yyerror(pTHX_ char *s)
        Perl_warn(aTHX_ "%"SVf, msg);
     else
        qerror(msg);
-    if (PL_error_count >= 10)
-       Perl_croak(aTHX_ "%s has too many errors.\n", CopFILE(PL_curcop));
+    if (PL_error_count >= 10) {
+       if (PL_in_eval && SvCUR(ERRSV))
+           Perl_croak(aTHX_ "%_%s has too many errors.\n",
+                      ERRSV, CopFILE(PL_curcop));
+       else
+           Perl_croak(aTHX_ "%s has too many errors.\n",
+                      CopFILE(PL_curcop));
+    }
     PL_in_my = 0;
     PL_in_my_stash = Nullhv;
     return 0;