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);
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;
LOP(OP_BIND,XTERM);
case KEY_binmode:
- UNI(OP_BINMODE);
+ LOP(OP_BINMODE,XTERM);
case KEY_bless:
LOP(OP_BLESS,XTERM);
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 */
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;
}
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? */
/* make an sv from the string */
sv = NEWSV(92,0);
-#if ( defined(USE_64_BIT_INT) && \
- (!defined(HAS_STRTOLL)|| !defined(HAS_STRTOULL))) || \
- (!defined(USE_64_BIT_INT) && \
- (!defined(HAS_STRTOL) || !defined(HAS_STRTOUL)))
+ /* 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)))
/*
No working strto[u]l[l]. Since atoi() doesn't do range checks,
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
*/
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);
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) )
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:
{
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;