"Argument \"%s\" isn't numeric", tmpbuf);
}
-/* the number can be converted to integer with atol() or atoll() although */
-#define IS_NUMBER_TO_INT_BY_ATOL 0x01 /* integer (may have decimals) */
-#define IS_NUMBER_TO_INT_BY_STRTOL 0x02 /* it may exceed IV_MAX */
-#define IS_NUMBER_TO_INT_BY_ATOF 0x04 /* seen something like 123e4 */
-#define IS_NUMBER_LONGER_THAN_IV_MAX 0x08 /* more digits than IV_MAX */
-#define IS_NUMBER_AS_LONG_AS_IV_MAX 0x10 /* may(be not) larger than IV_MAX */
-#define IS_NUMBER_NOT_INT 0x20 /* seen a decimal point or e */
-#define IS_NUMBER_NEG 0x40 /* seen a leading - */
-#define IS_NUMBER_INFINITY 0x80 /* /^\s*-?Infinity\s*$/i */
+#define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not
+ int). value returned in pointed-
+ to UV */
+#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
+#define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */
+#define IS_NUMBER_NEG 0x08 /* leading minus sign */
+#define IS_NUMBER_INFINITY 0x10 /* this is big */
+
+static int
+grok_number(const char *pv, STRLEN len, UV *valuep)
+{
+ const char *s = pv;
+ const char *send = pv + len;
+ const UV max_div_10 = UV_MAX / 10;
+ const char max_mod_10 = UV_MAX % 10 + '0';
+ int numtype = 0;
+ int sawinf = 0;
+#ifdef USE_LOCALE_NUMERIC
+ bool specialradix = FALSE;
+#endif
+
+ while (isSPACE(*s))
+ s++;
+ if (*s == '-') {
+ s++;
+ numtype = IS_NUMBER_NEG;
+ }
+ else if (*s == '+')
+ s++;
+
+ /* next must be digit or the radix separator or beginning of infinity */
+ if (isDIGIT(*s)) {
+ /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+ overflow. */
+ UV value = *s - '0';
+ /* This construction seems to be more optimiser friendly.
+ (without it gcc does the isDIGIT test and the *s - '0' separately)
+ With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+ In theory the optimiser could deduce how far to unroll the loop
+ before checking for overflow. */
+ int digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ /* Now got 9 digits, so need to check
+ each time for overflow. */
+ digit = *++s - '0';
+ while (digit >= 0 && digit <= 9
+ && (value < max_div_10
+ || (value == max_div_10
+ && *s <= max_mod_10))) {
+ value = value * 10 + digit;
+ digit = *++s - '0';
+ }
+ if (digit >= 0 && digit <= 9) {
+ /* value overflowed.
+ skip the remaining digits, don't
+ worry about setting *valuep. */
+ do {
+ s++;
+ } while (isDIGIT(*s));
+ numtype |=
+ IS_NUMBER_GREATER_THAN_UV_MAX;
+ goto skip_value;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ numtype |= IS_NUMBER_IN_UV;
+ if (valuep)
+ *valuep = value;
+
+ skip_value:
+ if (
+#ifdef USE_LOCALE_NUMERIC
+ (specialradix = IS_NUMERIC_RADIX(s, send)) ||
+#endif
+ *s == '.') {
+#ifdef USE_LOCALE_NUMERIC
+ if (specialradix)
+ s += SvCUR(PL_numeric_radix_sv);
+ else
+#endif
+ s++;
+ numtype |= IS_NUMBER_NOT_INT;
+ while (isDIGIT(*s)) /* optional digits after the radix */
+ s++;
+ }
+ }
+ else if (
+#ifdef USE_LOCALE_NUMERIC
+ (specialradix = IS_NUMERIC_RADIX(s, send)) ||
+#endif
+ *s == '.'
+ ) {
+#ifdef USE_LOCALE_NUMERIC
+ if (specialradix)
+ s += SvCUR(PL_numeric_radix_sv);
+ else
+#endif
+ s++;
+ numtype |= IS_NUMBER_NOT_INT;
+ /* no digits before the radix means we need digits after it */
+ if (isDIGIT(*s)) {
+ do {
+ s++;
+ } while (isDIGIT(*s));
+ numtype |= IS_NUMBER_IN_UV;
+ if (valuep) {
+ /* integer approximation is valid - it's 0. */
+ *valuep = 0;
+ }
+ }
+ else
+ return 0;
+ }
+ else if (*s == 'I' || *s == 'i') {
+ s++; if (*s != 'N' && *s != 'n') return 0;
+ s++; if (*s != 'F' && *s != 'f') return 0;
+ s++; if (*s == 'I' || *s == 'i') {
+ s++; if (*s != 'N' && *s != 'n') return 0;
+ s++; if (*s != 'I' && *s != 'i') return 0;
+ s++; if (*s != 'T' && *s != 't') return 0;
+ s++; if (*s != 'Y' && *s != 'y') return 0;
+ s++;
+ }
+ sawinf = 1;
+ }
+ else /* Add test for NaN here. */
+ return 0;
+
+ if (sawinf) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ } else {
+ /* we can have an optional exponent part */
+ if (*s == 'e' || *s == 'E') {
+ /* The only flag we keep is sign. Blow away any "it's UV" */
+ numtype &= IS_NUMBER_NEG;
+ numtype |= IS_NUMBER_NOT_INT;
+ s++;
+ if (*s == '-' || *s == '+')
+ s++;
+ if (isDIGIT(*s)) {
+ do {
+ s++;
+ } while (isDIGIT(*s));
+ }
+ else
+ return 0;
+ }
+ }
+ while (isSPACE(*s))
+ s++;
+ if (s >= send)
+ return numtype;
+ if (len == 10 && memEQ(pv, "0 but true", 10)) {
+ if (valuep)
+ *valuep = 0;
+ return IS_NUMBER_IN_UV;
+ }
+ return 0;
+}
+
+/*
+=for apidoc looks_like_number
+
+Test if an the content of an SV looks like a number (or is a
+number). C<Inf> and C<Infinity> are treated as numbers (so will not
+issue a non-numeric warning), even if your atof() doesn't grok them.
+
+=cut
+*/
+
+I32
+Perl_looks_like_number(pTHX_ SV *sv)
+{
+ register char *sbegin;
+ STRLEN len;
+
+ if (SvPOK(sv)) {
+ sbegin = SvPVX(sv);
+ len = SvCUR(sv);
+ }
+ else if (SvPOKp(sv))
+ sbegin = SvPV(sv, len);
+ else
+ return 1; /* Historic. Wrong? */
+ return grok_number(sbegin, len, NULL);
+}
/* Actually, ISO C leaves conversion of UV to IV undefined, but
until proven guilty, assume that things are not that bad... */
#define IS_NUMBER_IV_AND_UV 2
#define IS_NUMBER_OVERFLOW_IV 4
#define IS_NUMBER_OVERFLOW_UV 5
-/* Hopefully your optimiser will consider inlining these two functions. */
-STATIC int
-S_sv_2inuv_non_preserve (pTHX_ register SV *sv, I32 numtype) {
- NV nv = SvNVX(sv); /* Code simpler and had compiler problems if */
- UV nv_as_uv = U_V(nv); /* these are not in simple variables. */
- DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2inuv_non '%s', IV=0x%"UVxf" NV=%g inttype=%"UVXf"\n", SvPVX(sv), SvIVX(sv), nv, (UV)numtype));
- if (nv_as_uv <= (UV)IV_MAX) {
- (void)SvIOKp_on(sv);
- (void)SvNOKp_on(sv);
- /* Within suitable range to fit in an IV, atol won't overflow */
- /* XXX quite sure? Is that your final answer? not really, I'm
- trusting that nv_as_uv to round down if NV is (IV_MAX + 1) */
- SvIVX(sv) = (IV)Atol(SvPVX(sv));
- if (numtype & IS_NUMBER_NOT_INT) {
- /* I believe that even if the original PV had decimals, they
- are lost beyond the limit of the FP precision.
- However, neither is canonical, so both only get p flags.
- NWC, 2000/11/25 */
- /* Both already have p flags, so do nothing */
- } else if (SvIVX(sv) == I_V(nv)) {
- SvNOK_on(sv);
- SvIOK_on(sv);
- } else {
- SvIOK_on(sv);
- /* It had no "." so it must be integer. assert (get in here from
- sv_2iv and sv_2uv only for ndef HAS_STRTOL and
- IS_NUMBER_AS_LONG_AS_IV_MAX) or my logic is faulty and all
- conversion routines need audit. */
- }
- return nv < 0 ? IS_NUMBER_UNDERFLOW_UV : IS_NUMBER_IV_AND_UV;
- }
- /* between IV_MAX and NV(UV_MAX). Could be slightly> UV_MAX */
- (void)SvIOKp_on(sv);
- (void)SvNOKp_on(sv);
-#ifdef HAS_STRTOUL
- {
- int save_errno = errno;
- errno = 0;
- SvUVX(sv) = Strtoul(SvPVX(sv), Null(char**), 10);
- if (errno == 0) {
- if (numtype & IS_NUMBER_NOT_INT) {
- /* UV and NV both imprecise. */
- SvIsUV_on(sv);
- } else if (SvUVX(sv) == nv_as_uv && SvUVX(sv) != UV_MAX) {
- SvNOK_on(sv);
- SvIOK_on(sv);
- SvIsUV_on(sv);
- } else {
- SvIOK_on(sv);
- SvIsUV_on(sv);
- }
- errno = save_errno;
- return IS_NUMBER_OVERFLOW_IV;
- }
- errno = save_errno;
- SvNOK_on(sv);
- /* Must have just overflowed UV, but not enough that an NV could spot
- this.. */
- return IS_NUMBER_OVERFLOW_UV;
- }
-#else
- /* We've just lost integer precision, nothing we could do. */
- SvUVX(sv) = nv_as_uv;
- DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2niuv_non UV? '%s', UV=0x%"UVxf" NV=%g U_V(NV)=0x%"UVxf" inttype=%"UVXf"\n", SvPVX(sv), SvIVX(sv), nv, nv_as_uv, (UV)numtype));
- /* UV and NV slots equally valid only if we have casting symmetry. */
- if (numtype & IS_NUMBER_NOT_INT) {
- SvIsUV_on(sv);
- } else if (SvUVX(sv) == nv_as_uv && SvUVX(sv) != UV_MAX) {
- /* UV_MAX can cast up to NV (UV_MAX+1), that NV casts down to UV_MAX
- UV_MAX ought to be 0xFF...FFF which won't preserve (We only
- get to this point if NVs don't preserve UVs) */
- SvNOK_on(sv);
- SvIOK_on(sv);
- SvIsUV_on(sv);
- } else {
- /* As above, I believe UV at least as good as NV */
- SvIsUV_on(sv);
- }
-#endif /* HAS_STRTOUL */
- return IS_NUMBER_OVERFLOW_IV;
-}
/* For sv_2nv these three cases are "SvNOK and don't bother casting" */
STATIC int
SvUVX(sv) = UV_MAX;
return IS_NUMBER_OVERFLOW_UV;
}
- if (!(numtype & (IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_TO_INT_BY_STRTOL))) {
- (void)SvIOKp_on(sv);
- (void)SvNOK_on(sv);
- /* Can't use strtol etc to convert this string */
- if (SvNVX(sv) <= (UV)IV_MAX) {
- SvIVX(sv) = I_V(SvNVX(sv));
- if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
- SvIOK_on(sv); /* Integer is precise. NOK, IOK */
- } else {
- /* Integer is imprecise. NOK, IOKp */
- }
- return SvNVX(sv) < 0 ? IS_NUMBER_UNDERFLOW_UV : IS_NUMBER_IV_AND_UV;
- }
- SvIsUV_on(sv);
- SvUVX(sv) = U_V(SvNVX(sv));
- if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
- if (SvUVX(sv) == UV_MAX) {
- /* As we know that NVs don't preserve UVs, UV_MAX cannot
- possibly be preserved by NV. Hence, it must be overflow.
- NOK, IOKp */
- return IS_NUMBER_OVERFLOW_UV;
- }
- SvIOK_on(sv); /* Integer is precise. NOK, UOK */
- } else {
- /* Integer is imprecise. NOK, IOKp */
- }
- return IS_NUMBER_OVERFLOW_IV;
+ (void)SvIOKp_on(sv);
+ (void)SvNOK_on(sv);
+ /* Can't use strtol etc to convert this string. (See truth table in
+ sv_2iv */
+ if (SvNVX(sv) <= (UV)IV_MAX) {
+ SvIVX(sv) = I_V(SvNVX(sv));
+ if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
+ SvIOK_on(sv); /* Integer is precise. NOK, IOK */
+ } else {
+ /* Integer is imprecise. NOK, IOKp */
+ }
+ return SvNVX(sv) < 0 ? IS_NUMBER_UNDERFLOW_UV : IS_NUMBER_IV_AND_UV;
+ }
+ SvIsUV_on(sv);
+ SvUVX(sv) = U_V(SvNVX(sv));
+ if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
+ if (SvUVX(sv) == UV_MAX) {
+ /* As we know that NVs don't preserve UVs, UV_MAX cannot
+ possibly be preserved by NV. Hence, it must be overflow.
+ NOK, IOKp */
+ return IS_NUMBER_OVERFLOW_UV;
+ }
+ SvIOK_on(sv); /* Integer is precise. NOK, UOK */
+ } else {
+ /* Integer is imprecise. NOK, IOKp */
}
- return S_sv_2inuv_non_preserve(aTHX_ sv, numtype);
+ return IS_NUMBER_OVERFLOW_IV;
}
#endif /* NV_PRESERVES_UV*/
}
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- I32 numtype = looks_like_number(sv);
-
+ UV value;
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
/* We want to avoid a possible problem when we cache an IV which
may be later translated to an NV, and the resulting NV is not
- the translation of the initial data.
+ the same as the direct translation of the initial string
+ (eg 123.456 can shortcut to the IV 123 with atol(), but we must
+ be careful to ensure that the value with the .456 is around if the
+ NV value is requested in the future).
This means that if we cache such an IV, we need to cache the
NV as well. Moreover, we trade speed for space, and do not
cache the NV if we are sure it's not needed.
*/
- if ((numtype & ~IS_NUMBER_NEG) == IS_NUMBER_TO_INT_BY_ATOL) {
- /* The NV may be reconstructed from IV - safe to cache IV,
- which may be calculated by atol(). */
+ /* SVt_PVNV is one higher than SVt_PVIV, hence this order */
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == IS_NUMBER_IN_UV) {
+ /* It's defintately an integer, only upgrade to PVIV */
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SvIVX(sv) = Atol(SvPVX(sv));
- } else {
-#ifdef HAS_STRTOL
- IV i;
- int save_errno = errno;
- /* Is it an integer that we could convert with strtol?
- So try it, and if it doesn't set errno then it's pukka.
- This should be faster than going atof and then thinking. */
- if (((numtype & (IS_NUMBER_TO_INT_BY_STRTOL | IS_NUMBER_NOT_INT))
- == IS_NUMBER_TO_INT_BY_STRTOL)
- /* && is a sequence point. Without it not sure if I'm trying
- to do too much between sequence points and hence going
- undefined */
- && ((errno = 0), 1) /* , 1 so always true */
- && ((i = Strtol(SvPVX(sv), Null(char**), 10)), 1)
- && (errno == 0)) {
- if (SvTYPE(sv) < SVt_PVIV)
- sv_upgrade(sv, SVt_PVIV);
- (void)SvIOK_on(sv);
- SvIVX(sv) = i;
- errno = save_errno;
- } else
-#endif
- {
- NV d;
-#ifdef HAS_STRTOL
- /* Hopefully trace flow will optimise this away where possible
- */
- errno = save_errno;
-#endif
- /* It wasn't an integer, or it overflowed, or we don't have
- strtol. Do things the slow way - check if it's a UV etc. */
- d = Atof(SvPVX(sv));
+ } else if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
- if (SvTYPE(sv) < SVt_PVNV)
- sv_upgrade(sv, SVt_PVNV);
- SvNVX(sv) = d;
+ /* If NV preserves UV then we only use the UV value if we know that
+ we aren't going to call atof() below. If NVs don't preserve UVs
+ then the value returned may have more precision than atof() will
+ return, even though value isn't perfectly accurate. */
+ if ((numtype & (IS_NUMBER_IN_UV
+#ifdef NV_PRESERVES_UV
+ | IS_NUMBER_NOT_INT
+#endif
+ )) == IS_NUMBER_IN_UV) {
+ /* This won't turn off the public IOK flag if it was set above */
+ (void)SvIOKp_on(sv);
+
+ if (!(numtype & IS_NUMBER_NEG)) {
+ /* positive */;
+ if (value <= (UV)IV_MAX) {
+ SvIVX(sv) = (IV)value;
+ } else {
+ SvUVX(sv) = value;
+ SvIsUV_on(sv);
+ }
+ } else {
+ /* 2s complement assumption */
+ if (value <= (UV)IV_MIN) {
+ SvIVX(sv) = -(IV)value;
+ } else {
+ /* Too negative for an IV. This is a double upgrade, but
+ I'm assuming it will be be rare. */
+ if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
+ SvNOK_on(sv);
+ SvIOK_off(sv);
+ SvIOKp_on(sv);
+ SvNVX(sv) = -(NV)value;
+ SvIVX(sv) = IV_MIN;
+ }
+ }
+ }
+ /* For !NV_PRESERVES_UV and IS_NUMBER_IN_UV and IS_NUMBER_NOT_INT we
+ will be in the previous block to set the IV slot, and the next
+ block to set the NV slot. So no else here. */
+
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ != IS_NUMBER_IN_UV) {
+ /* It wasn't an (integer that doesn't overflow the UV). */
+ SvNVX(sv) = Atof(SvPVX(sv));
- if (! numtype && ckWARN(WARN_NUMERIC))
- not_a_number(sv);
+ if (! numtype && ckWARN(WARN_NUMERIC))
+ not_a_number(sv);
#if defined(USE_LONG_DOUBLE)
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%" PERL_PRIgldbl ")\n",
- PTR2UV(sv), SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv)));
#else
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%g)\n",
- PTR2UV(sv), SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%g)\n",
+ PTR2UV(sv), SvNVX(sv)));
#endif
#ifdef NV_PRESERVES_UV
- (void)SvIOKp_on(sv);
- (void)SvNOK_on(sv);
- if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
- SvIVX(sv) = I_V(SvNVX(sv));
- if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
- SvIOK_on(sv);
- } else {
- /* Integer is imprecise. NOK, IOKp */
- }
- /* UV will not work better than IV */
+ (void)SvIOKp_on(sv);
+ (void)SvNOK_on(sv);
+ if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
+ SvIVX(sv) = I_V(SvNVX(sv));
+ if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
+ SvIOK_on(sv);
} else {
- if (SvNVX(sv) > (NV)UV_MAX) {
- SvIsUV_on(sv);
- /* Integer is inaccurate. NOK, IOKp, is UV */
- SvUVX(sv) = UV_MAX;
+ /* Integer is imprecise. NOK, IOKp */
+ }
+ /* UV will not work better than IV */
+ } else {
+ if (SvNVX(sv) > (NV)UV_MAX) {
+ SvIsUV_on(sv);
+ /* Integer is inaccurate. NOK, IOKp, is UV */
+ SvUVX(sv) = UV_MAX;
+ SvIsUV_on(sv);
+ } else {
+ SvUVX(sv) = U_V(SvNVX(sv));
+ /* 0xFFFFFFFFFFFFFFFF not an issue in here */
+ if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
+ SvIOK_on(sv);
SvIsUV_on(sv);
} else {
- SvUVX(sv) = U_V(SvNVX(sv));
- /* 0xFFFFFFFFFFFFFFFF not an issue in here */
- if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
- SvIOK_on(sv);
- SvIsUV_on(sv);
- } else {
- /* Integer is imprecise. NOK, IOKp, is UV */
- SvIsUV_on(sv);
- }
+ /* Integer is imprecise. NOK, IOKp, is UV */
+ SvIsUV_on(sv);
}
- goto ret_iv_max;
}
+ goto ret_iv_max;
+ }
#else /* NV_PRESERVES_UV */
- if (((UV)1 << NV_PRESERVES_UV_BITS) >
- U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
- /* Small enough to preserve all bits. */
- (void)SvIOKp_on(sv);
- SvNOK_on(sv);
- SvIVX(sv) = I_V(SvNVX(sv));
- if ((NV)(SvIVX(sv)) == SvNVX(sv))
- SvIOK_on(sv);
- /* Assumption: first non-preserved integer is < IV_MAX,
- this NV is in the preserved range, therefore: */
- if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
- < (UV)IV_MAX)) {
- Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
- }
- } else if (sv_2iuv_non_preserve (sv, numtype)
- >= IS_NUMBER_OVERFLOW_IV)
- goto ret_iv_max;
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) {
+ /* The IV slot will have been set from value returned by
+ grok_number above. The NV slot has just been set using
+ Atof. */
+ assert (SvIOKp(sv));
+ } else {
+ if (((UV)1 << NV_PRESERVES_UV_BITS) >
+ U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
+ /* Small enough to preserve all bits. */
+ (void)SvIOKp_on(sv);
+ SvNOK_on(sv);
+ SvIVX(sv) = I_V(SvNVX(sv));
+ if ((NV)(SvIVX(sv)) == SvNVX(sv))
+ SvIOK_on(sv);
+ /* Assumption: first non-preserved integer is < IV_MAX,
+ this NV is in the preserved range, therefore: */
+ if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
+ < (UV)IV_MAX)) {
+ Perl_croak(aTHX_ "sv_2iv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+ }
+ } else {
+ /* IN_UV NOT_INT
+ 0 0 already failed to read UV.
+ 0 1 already failed to read UV.
+ 1 0 you won't get here in this case. IV/UV
+ slot set, public IOK, Atof() unneeded.
+ 1 1 already read UV.
+ so there's no point in sv_2iuv_non_preserve() attempting
+ to use atol, strtol, strtoul etc. */
+ if (sv_2iuv_non_preserve (sv, numtype)
+ >= IS_NUMBER_OVERFLOW_IV)
+ goto ret_iv_max;
+ }
+ }
#endif /* NV_PRESERVES_UV */
- }
}
} else {
if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
}
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- I32 numtype = looks_like_number(sv);
+ UV value;
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
/* We want to avoid a possible problem when we cache a UV which
may be later translated to an NV, and the resulting NV is not
cache the NV if not needed.
*/
- if ((numtype & ~IS_NUMBER_NEG) == IS_NUMBER_TO_INT_BY_ATOL) {
- /* The NV may be reconstructed from IV - safe to cache IV,
- which may be calculated by atol(). */
+ /* SVt_PVNV is one higher than SVt_PVIV, hence this order */
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == IS_NUMBER_IN_UV) {
+ /* It's defintately an integer, only upgrade to PVIV */
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SvIVX(sv) = Atol(SvPVX(sv));
- } else {
-#ifdef HAS_STRTOUL
- UV u;
- char *num_begin = SvPVX(sv);
- int save_errno = errno;
-
- /* seems that strtoul taking numbers that start with - is
- implementation dependant, and can't be relied upon. */
- if (numtype & IS_NUMBER_NEG) {
- /* Not totally defensive. assumine that looks_like_num
- didn't lie about a - sign */
- while (isSPACE(*num_begin))
- num_begin++;
- if (*num_begin == '-')
- num_begin++;
- }
+ } else if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
- /* Is it an integer that we could convert with strtoul?
- So try it, and if it doesn't set errno then it's pukka.
- This should be faster than going atof and then thinking. */
- if (((numtype & (IS_NUMBER_TO_INT_BY_STRTOL | IS_NUMBER_NOT_INT))
- == IS_NUMBER_TO_INT_BY_STRTOL)
- && ((errno = 0), 1) /* always true */
- && ((u = Strtoul(num_begin, Null(char**), 10)), 1) /* ditto */
- && (errno == 0)
- /* If known to be negative, check it didn't undeflow IV
- XXX possibly we should put more negative values as NVs
- direct rather than go via atof below */
- && ((numtype & IS_NUMBER_NEG) ? (u <= (UV)IV_MIN) : 1)) {
- errno = save_errno;
-
- if (SvTYPE(sv) < SVt_PVIV)
- sv_upgrade(sv, SVt_PVIV);
- (void)SvIOK_on(sv);
-
- /* If it's negative must use IV.
- IV-over-UV optimisation */
- if (numtype & IS_NUMBER_NEG) {
- SvIVX(sv) = -(IV)u;
- } else if (u <= (UV) IV_MAX) {
- SvIVX(sv) = (IV)u;
+ /* If NV preserves UV then we only use the UV value if we know that
+ we aren't going to call atof() below. If NVs don't preserve UVs
+ then the value returned may have more precision than atof() will
+ return, even though it isn't accurate. */
+ if ((numtype & (IS_NUMBER_IN_UV
+#ifdef NV_PRESERVES_UV
+ | IS_NUMBER_NOT_INT
+#endif
+ )) == IS_NUMBER_IN_UV) {
+ /* This won't turn off the public IOK flag if it was set above */
+ (void)SvIOKp_on(sv);
+
+ if (!(numtype & IS_NUMBER_NEG)) {
+ /* positive */;
+ if (value <= (UV)IV_MAX) {
+ SvIVX(sv) = (IV)value;
} else {
/* it didn't overflow, and it was positive. */
- SvUVX(sv) = u;
+ SvUVX(sv) = value;
SvIsUV_on(sv);
}
- } else
-#endif
- {
- NV d;
-#ifdef HAS_STRTOUL
- /* Hopefully trace flow will optimise this away where possible
- */
- errno = save_errno;
-#endif
- /* It wasn't an integer, or it overflowed, or we don't have
- strtol. Do things the slow way - check if it's a IV etc. */
- d = Atof(SvPVX(sv));
-
- if (SvTYPE(sv) < SVt_PVNV)
- sv_upgrade(sv, SVt_PVNV);
- SvNVX(sv) = d;
+ } else {
+ /* 2s complement assumption */
+ if (value <= (UV)IV_MIN) {
+ SvIVX(sv) = -(IV)value;
+ } else {
+ /* Too negative for an IV. This is a double upgrade, but
+ I'm assuming it will be be rare. */
+ if (SvTYPE(sv) < SVt_PVNV)
+ sv_upgrade(sv, SVt_PVNV);
+ SvNOK_on(sv);
+ SvIOK_off(sv);
+ SvIOKp_on(sv);
+ SvNVX(sv) = -(NV)value;
+ SvIVX(sv) = IV_MIN;
+ }
+ }
+ }
+
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ != IS_NUMBER_IN_UV) {
+ /* It wasn't an integer, or it overflowed the UV. */
+ SvNVX(sv) = Atof(SvPVX(sv));
- if (! numtype && ckWARN(WARN_NUMERIC))
+ if (! numtype && ckWARN(WARN_NUMERIC))
not_a_number(sv);
#if defined(USE_LONG_DOUBLE)
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%" PERL_PRIgldbl ")\n",
- PTR2UV(sv), SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%" PERL_PRIgldbl ")\n",
+ PTR2UV(sv), SvNVX(sv)));
#else
- DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%g)\n",
- PTR2UV(sv), SvNVX(sv)));
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%g)\n",
+ PTR2UV(sv), SvNVX(sv)));
#endif
#ifdef NV_PRESERVES_UV
- (void)SvIOKp_on(sv);
- (void)SvNOK_on(sv);
- if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
- SvIVX(sv) = I_V(SvNVX(sv));
- if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
- SvIOK_on(sv);
- } else {
- /* Integer is imprecise. NOK, IOKp */
- }
- /* UV will not work better than IV */
- } else {
- if (SvNVX(sv) > (NV)UV_MAX) {
- SvIsUV_on(sv);
- /* Integer is inaccurate. NOK, IOKp, is UV */
- SvUVX(sv) = UV_MAX;
- SvIsUV_on(sv);
- } else {
- SvUVX(sv) = U_V(SvNVX(sv));
- /* 0xFFFFFFFFFFFFFFFF not an issue in here, NVs
- NV preservse UV so can do correct comparison. */
- if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
- SvIOK_on(sv);
- SvIsUV_on(sv);
- } else {
- /* Integer is imprecise. NOK, IOKp, is UV */
- SvIsUV_on(sv);
- }
- }
- }
+ (void)SvIOKp_on(sv);
+ (void)SvNOK_on(sv);
+ if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
+ SvIVX(sv) = I_V(SvNVX(sv));
+ if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
+ SvIOK_on(sv);
+ } else {
+ /* Integer is imprecise. NOK, IOKp */
+ }
+ /* UV will not work better than IV */
+ } else {
+ if (SvNVX(sv) > (NV)UV_MAX) {
+ SvIsUV_on(sv);
+ /* Integer is inaccurate. NOK, IOKp, is UV */
+ SvUVX(sv) = UV_MAX;
+ SvIsUV_on(sv);
+ } else {
+ SvUVX(sv) = U_V(SvNVX(sv));
+ /* 0xFFFFFFFFFFFFFFFF not an issue in here, NVs
+ NV preservse UV so can do correct comparison. */
+ if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
+ SvIOK_on(sv);
+ SvIsUV_on(sv);
+ } else {
+ /* Integer is imprecise. NOK, IOKp, is UV */
+ SvIsUV_on(sv);
+ }
+ }
+ }
#else /* NV_PRESERVES_UV */
- if (((UV)1 << NV_PRESERVES_UV_BITS) >
- U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
- /* Small enough to preserve all bits. */
- (void)SvIOKp_on(sv);
- SvNOK_on(sv);
- SvIVX(sv) = I_V(SvNVX(sv));
- if ((NV)(SvIVX(sv)) == SvNVX(sv))
- SvIOK_on(sv);
- /* Assumption: first non-preserved integer is < IV_MAX,
- this NV is in the preserved range, therefore: */
- if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
- < (UV)IV_MAX)) {
- Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
- }
- } else
- sv_2iuv_non_preserve (sv, numtype);
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) {
+ /* The UV slot will have been set from value returned by
+ grok_number above. The NV slot has just been set using
+ Atof. */
+ assert (SvIOKp(sv));
+ } else {
+ if (((UV)1 << NV_PRESERVES_UV_BITS) >
+ U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
+ /* Small enough to preserve all bits. */
+ (void)SvIOKp_on(sv);
+ SvNOK_on(sv);
+ SvIVX(sv) = I_V(SvNVX(sv));
+ if ((NV)(SvIVX(sv)) == SvNVX(sv))
+ SvIOK_on(sv);
+ /* Assumption: first non-preserved integer is < IV_MAX,
+ this NV is in the preserved range, therefore: */
+ if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
+ < (UV)IV_MAX)) {
+ Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs(SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%g U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
+ }
+ } else
+ sv_2iuv_non_preserve (sv, numtype);
+ }
#endif /* NV_PRESERVES_UV */
- }
}
}
else {
if (SvNOKp(sv))
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) &&
+ !grok_number(SvPVX(sv), SvCUR(sv), NULL))
not_a_number(sv);
return Atof(SvPVX(sv));
}
if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) {
SvNOK_on(sv);
}
- else if (SvIOKp(sv) &&
- (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
+ else if (SvIOKp(sv) &&
+ (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || /* XXX check this logic */
+ !grok_number(SvPVX(sv), SvCUR(sv),NULL)))
{
SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
#ifdef NV_PRESERVES_UV
#endif
}
else if (SvPOKp(sv) && SvLEN(sv)) {
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
+ UV value;
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
+ if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
not_a_number(sv);
- SvNVX(sv) = Atof(SvPVX(sv));
#ifdef NV_PRESERVES_UV
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == IS_NUMBER_IN_UV) {
+ /* It's defintately an integer */
+ SvNVX(sv) = (numtype & IS_NUMBER_NEG) ? -(NV)value : (NV)value;
+ } else
+ SvNVX(sv) = Atof(SvPVX(sv));
SvNOK_on(sv);
#else
+ SvNVX(sv) = Atof(SvPVX(sv));
/* Only set the public NV OK flag if this NV preserves the value in
the PV at least as well as an IV/UV would.
Not sure how to do this 100% reliably. */
wonky. We shouldn't be in here with NV_PRESERVES_UV_BITS ==
UV_BITS */
if (((UV)1 << NV_PRESERVES_UV_BITS) >
- U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv)))
+ U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
SvNOK_on(sv); /* Definitely small enough to preserve all bits */
- else if (SvNVX(sv) < (NV)IV_MIN || SvNVX(sv) > (NV)UV_MAX) {
- /* Definitely too large/small to fit in an integer, so no loss
- of precision going to integer in the future via NV */
- SvNOK_on(sv);
- } else {
- /* Is it something we can run through strtol etc (ie no
- trailing exponent part)? */
- int numtype = looks_like_number(sv);
- /* XXX probably should cache this if called above */
-
- if (!(numtype &
- (IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_TO_INT_BY_STRTOL))) {
- /* Can't use strtol etc to convert this string, so don't try */
- SvNOK_on(sv);
- } else
- sv_2inuv_non_preserve (sv, numtype);
- }
+ } else if (!(numtype & IS_NUMBER_IN_UV)) {
+ /* Can't use strtol etc to convert this string, so don't try.
+ sv_2iv and sv_2uv will use the NV to convert, not the PV. */
+ SvNOK_on(sv);
+ } else {
+ /* value has been set. It may not be precise. */
+ if ((numtype & IS_NUMBER_NEG) && (value > (UV)IV_MIN)) {
+ /* 2s complement assumption for (UV)IV_MIN */
+ SvNOK_on(sv); /* Integer is too negative. */
+ } else {
+ SvNOKp_on(sv);
+ SvIOKp_on(sv);
+
+ if (numtype & IS_NUMBER_NEG) {
+ SvIVX(sv) = -(IV)value;
+ } else if (value <= (UV)IV_MAX) {
+ SvIVX(sv) = (IV)value;
+ } else {
+ SvUVX(sv) = value;
+ SvIsUV_on(sv);
+ }
+
+ if (numtype & IS_NUMBER_NOT_INT) {
+ /* I believe that even if the original PV had decimals,
+ they are lost beyond the limit of the FP precision.
+ However, neither is canonical, so both only get p
+ flags. NWC, 2000/11/25 */
+ /* Both already have p flags, so do nothing */
+ } else {
+ NV nv = SvNVX(sv);
+ if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
+ if (SvIVX(sv) == I_V(nv)) {
+ SvNOK_on(sv);
+ SvIOK_on(sv);
+ } else {
+ SvIOK_on(sv);
+ /* It had no "." so it must be integer. */
+ }
+ } else {
+ /* between IV_MAX and NV(UV_MAX).
+ Could be slightly > UV_MAX */
+
+ if (numtype & IS_NUMBER_NOT_INT) {
+ /* UV and NV both imprecise. */
+ } else {
+ UV nv_as_uv = U_V(nv);
+
+ if (value == nv_as_uv && SvUVX(sv) != UV_MAX) {
+ SvNOK_on(sv);
+ SvIOK_on(sv);
+ } else {
+ SvIOK_on(sv);
+ }
+ }
+ }
+ }
+ }
+ }
#endif /* NV_PRESERVES_UV */
}
else {
return SvNVX(sv);
}
+/* Caller must validate PVX */
STATIC IV
S_asIV(pTHX_ SV *sv)
{
- I32 numtype = looks_like_number(sv);
- NV d;
+ UV value;
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
- if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
- return Atol(SvPVX(sv));
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == IS_NUMBER_IN_UV) {
+ /* It's defintately an integer */
+ if (numtype & IS_NUMBER_NEG) {
+ if (value < (UV)IV_MIN)
+ return -(IV)value;
+ } else {
+ if (value < (UV)IV_MAX)
+ return (IV)value;
+ }
+ }
if (!numtype) {
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
}
- d = Atof(SvPVX(sv));
- return I_V(d);
+ return I_V(Atof(SvPVX(sv)));
}
STATIC UV
S_asUV(pTHX_ SV *sv)
{
- I32 numtype = looks_like_number(sv);
+ UV value;
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
-#ifdef HAS_STRTOUL
- if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
- return Strtoul(SvPVX(sv), Null(char**), 10);
-#endif
+ if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+ == IS_NUMBER_IN_UV) {
+ /* It's defintately an integer */
+ if (!(numtype & IS_NUMBER_NEG))
+ return value;
+ }
if (!numtype) {
if (ckWARN(WARN_NUMERIC))
not_a_number(sv);
return U_V(Atof(SvPVX(sv)));
}
-/*
- * Returns a combination of (advisory only - can get false negatives)
- * IS_NUMBER_TO_INT_BY_ATOL, IS_NUMBER_TO_INT_BY_ATOF
- * IS_NUMBER_LONGER_THAN_IV_MAX, IS_NUMBER_AS_LONG_AS_IV_MAX
- * IS_NUMBER_NOT_INT, IS_NUMBER_NEG, IS_NUMBER_INFINITY
- * 0 if does not look like number.
- *
- * (atol and strtol stop when they hit a decimal point. strtol will return
- * LONG_MAX and LONG_MIN when given out of range values. ANSI says they should
- * do this, and vendors have had 11 years to get it right.
- * However, will try to make it still work with only atol
- *
- * IS_NUMBER_TO_INT_BY_ATOL 123456789 or 123456789.3 definitely < IV_MAX
- * IS_NUMBER_TO_INT_BY_STRTOL 123456789 or 123456789.3 if digits = IV_MAX
- * IS_NUMBER_TO_INT_BY_ATOF 123456789e0 or >> IV_MAX
- * IS_NUMBER_LONGER_THAN_IV_MAX lots of digits, don't bother with atol
- * IS_NUMBER_AS_LONG_AS_IV_MAX atol might hit LONG_MAX, might not.
- * IS_NUMBER_NOT_INT saw "." or "e"
- * IS_NUMBER_NEG
- * IS_NUMBER_INFINITY
- */
-
-/*
-=for apidoc looks_like_number
-
-Test if an the content of an SV looks like a number (or is a
-number). C<Inf> and C<Infinity> are treated as numbers (so will not
-issue a non-numeric warning), even if your atof() doesn't grok them.
-
-=cut
-*/
-
-I32
-Perl_looks_like_number(pTHX_ SV *sv)
-{
- register char *s;
- register char *send;
- register char *sbegin;
- register char *nbegin;
- I32 numtype = 0;
- I32 sawinf = 0;
- STRLEN len;
-#ifdef USE_LOCALE_NUMERIC
- bool specialradix = FALSE;
-#endif
-
- if (SvPOK(sv)) {
- sbegin = SvPVX(sv);
- len = SvCUR(sv);
- }
- else if (SvPOKp(sv))
- sbegin = SvPV(sv, len);
- else
- return 1;
- send = sbegin + len;
-
- s = sbegin;
- while (isSPACE(*s))
- s++;
- if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
- nbegin = s;
- /*
- * we return IS_NUMBER_TO_INT_BY_ATOL if the number can converted to
- * integer with atol() without overflow, IS_NUMBER_TO_INT_BY_STRTOL if
- * possibly slightly larger than max int, IS_NUMBER_TO_INT_BY_ATOF if you
- * will need (int)atof().
- */
-
- /* next must be digit or the radix separator or beginning of infinity */
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
-
- /* Aaargh. long long really is irritating.
- In the gospel according to ANSI 1989, it is an axiom that "long"
- is the longest integer type, and that if you don't know how long
- something is you can cast it to long, and nothing will be lost
- (except possibly speed of execution if long is slower than the
- type is was).
- Now, one can't be sure if the old rules apply, or long long
- (or some other newfangled thing) is actually longer than the
- (formerly) longest thing.
- */
- /* This lot will work for 64 bit *as long as* either
- either long is 64 bit
- or we can find both strtol/strtoq and strtoul/strtouq
- If not, we really should refuse to let the user use 64 bit IVs
- By "64 bit" I really mean IVs that don't get preserved by NVs
- It also should work for 128 bit IVs. Can any lend me a machine to
- test this?
- */
- if (s - nbegin > TYPE_DIGITS(UV)) /* Cannot cache ato[ul]() */
- numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_LONGER_THAN_IV_MAX;
- else if (s - nbegin < BIT_DIGITS(((sizeof (IV)>sizeof (long))
- ? sizeof(long) : sizeof (IV))*8-1))
- numtype |= IS_NUMBER_TO_INT_BY_ATOL;
- else
- /* Can't be sure either way. (For 64 bit UV, 63 bit IV is 1 decimal
- digit less (IV_MAX= 9223372036854775807,
- UV_MAX= 18446744073709551615) so be cautious */
- numtype |= IS_NUMBER_TO_INT_BY_STRTOL | IS_NUMBER_AS_LONG_AS_IV_MAX;
-
- if (
-#ifdef USE_LOCALE_NUMERIC
- (specialradix = IS_NUMERIC_RADIX(s, send)) ||
-#endif
- *s == '.') {
-#ifdef USE_LOCALE_NUMERIC
- if (specialradix)
- s += SvCUR(PL_numeric_radix_sv);
- else
-#endif
- s++;
- numtype |= IS_NUMBER_NOT_INT;
- while (isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else if (
-#ifdef USE_LOCALE_NUMERIC
- (specialradix = IS_NUMERIC_RADIX(s, send)) ||
-#endif
- *s == '.'
- ) {
-#ifdef USE_LOCALE_NUMERIC
- if (specialradix)
- s += SvCUR(PL_numeric_radix_sv);
- else
-#endif
- s++;
- numtype |= IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_INT;
- /* no digits before the radix means we need digits after it */
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
- }
- else
- return 0;
- }
- else if (*s == 'I' || *s == 'i') {
- s++; if (*s != 'N' && *s != 'n') return 0;
- s++; if (*s != 'F' && *s != 'f') return 0;
- s++; if (*s == 'I' || *s == 'i') {
- s++; if (*s != 'N' && *s != 'n') return 0;
- s++; if (*s != 'I' && *s != 'i') return 0;
- s++; if (*s != 'T' && *s != 't') return 0;
- s++; if (*s != 'Y' && *s != 'y') return 0;
- s++;
- }
- sawinf = 1;
- }
- else
- return 0;
-
- if (sawinf)
- numtype = (numtype & IS_NUMBER_NEG) /* Keep track of sign */
- | IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
- else {
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- numtype &= IS_NUMBER_NEG;
- numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_INT;
- s++;
- if (*s == '+' || *s == '-')
- s++;
- if (isDIGIT(*s)) {
- do {
- s++;
- } while (isDIGIT(*s));
- }
- else
- return 0;
- }
- }
- while (isSPACE(*s))
- s++;
- if (s >= send)
- return numtype;
- if (len == 10 && memEQ(sbegin, "0 but true", 10))
- return IS_NUMBER_TO_INT_BY_ATOL;
- return 0;
-}
-
char *
Perl_sv_2pv_nolen(pTHX_ register SV *sv)
{
/* Got to punt this an an integer if needs be, but we don't issue
warnings. Probably ought to make the sv_iv_please() that does
the conversion if possible, and silently. */
- I32 numtype = looks_like_number(sv);
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), NULL);
if (numtype && !(numtype & IS_NUMBER_INFINITY)) {
/* Need to try really hard to see if it's an integer.
9.22337203685478e+18 is an integer.
}
#ifdef PERL_PRESERVE_IVUV
{
- I32 numtype = looks_like_number(sv);
+ int numtype = grok_number(SvPVX(sv), SvCUR(sv), NULL);
if (numtype && !(numtype & IS_NUMBER_INFINITY)) {
/* Need to try really hard to see if it's an integer.
9.22337203685478e+18 is an integer.
projects / p5sagit/p5-mst-13.2.git / commitdiff