#define PERL_IN_NUMERIC_C
#include "perl.h"
+#ifdef Perl_strtod
+
+PERL_STATIC_INLINE NV
+S_strtod(pTHX_ const char * const s, char ** e)
+{
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ NV result;
+
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+
+# ifdef USE_QUADMATH
+
+ result = strtoflt128(s, e);
+
+# elif defined(HAS_STRTOLD) && defined(HAS_LONG_DOUBLE) \
+ && defined(USE_LONG_DOUBLE)
+# if defined(__MINGW64_VERSION_MAJOR)
+ /***********************************************
+ We are unable to use strtold because of
+ https://sourceforge.net/p/mingw-w64/bugs/711/
+ &
+ https://sourceforge.net/p/mingw-w64/bugs/725/
+
+ but __mingw_strtold is fine.
+ ***********************************************/
+
+ result = __mingw_strtold(s, e);
+
+# else
+
+ result = strtold(s, e);
+
+# endif
+# elif defined(HAS_STRTOD)
+
+ result = strtod(s, e);
+
+# else
+# error No strtod() equivalent found
+# endif
+
+ RESTORE_LC_NUMERIC();
+
+ return result;
+}
+
+#endif /* #ifdef Perl_strtod */
+
+/*
+
+=for apidoc my_strtod
+
+This function is equivalent to the libc strtod() function, and is available
+even on platforms that lack plain strtod(). Its return value is the best
+available precision depending on platform capabilities and F<Configure>
+options.
+
+It properly handles the locale radix character, meaning it expects a dot except
+when called from within the scope of S<C<use locale>>, in which case the radix
+character should be that specified by the current locale.
+
+The synonym Strtod() may be used instead.
+
+=cut
+
+*/
+
+NV
+Perl_my_strtod(const char * const s, char **e)
+{
+ dTHX;
+
+ PERL_ARGS_ASSERT_MY_STRTOD;
+
+#ifdef Perl_strtod
+
+ return S_strtod(aTHX_ s, e);
+
+#else
+
+ {
+ NV result;
+ char ** end_ptr = NULL;
+
+ *end_ptr = my_atof2(s, &result);
+ if (e) {
+ *e = *end_ptr;
+ }
+
+ if (! *end_ptr) {
+ result = 0.0;
+ }
+
+ return result;
+ }
+
+#endif
+
+}
+
+
U32
Perl_cast_ulong(NV f)
{
before checking for overflow. */
if (++s < send) {
int digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
+ if (inRANGE(digit, 0, 9)) {
value = value * 10 + digit;
if (++s < send) {
/* Now got 9 digits, so need to check
each time for overflow. */
digit = *s - '0';
- while (digit >= 0 && digit <= 9
+ while ( inRANGE(digit, 0, 9)
&& (value < uv_max_div_10
|| (value == uv_max_div_10
&& digit <= uv_max_mod_10))) {
else
break;
}
- if (digit >= 0 && digit <= 9
+ if (inRANGE(digit, 0, 9)
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
return TRUE;
}
-#ifndef USE_QUADMATH
+#ifndef Perl_strtod
STATIC NV
S_mulexp10(NV value, I32 exponent)
{
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
# define ATOF(s, x) my_atof2(s, &x)
-# else
+#else
# define ATOF(s, x) Perl_atof2(s, x)
-# endif
+#endif
NV
Perl_my_atof(pTHX_ const char* s)
{
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ if (! (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))) {
+ ATOF(s,x);
+ }
+ else {
/* Look through the string for the first thing that looks like a
* decimal point: either the value in the current locale or the
SET_NUMERIC_UNDERLYING();
}
}
- else {
- ATOF(s,x);
- }
RESTORE_LC_NUMERIC();
}
}
#endif
assert(strNE(fake, "silence compiler warning"));
- nv = Perl_strtod(fake, &endp);
+ nv = S_strtod(aTHX_ fake, &endp);
if (fake != endp) {
#ifdef NV_INF
if ((infnan & IS_NUMBER_INFINITY)) {
}
char*
-Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
+Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
{
const char* s = orig;
NV result[3] = {0.0, 0.0, 0.0};
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
+#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
const char* send = s + ((len != 0)
? len
: strlen(orig)); /* one past the last */
bool negative = 0;
#endif
-#if defined(USE_PERL_ATOF) && !defined(USE_QUADMATH)
+#if defined(USE_PERL_ATOF) && !defined(Perl_strtod)
UV accumulator[2] = {0,0}; /* before/after dp */
bool seen_digit = 0;
I32 exp_adjust[2] = {0,0};
I32 sig_digits = 0; /* noof significant digits seen so far */
#endif
-#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
+#if defined(USE_PERL_ATOF) || defined(Perl_strtod)
PERL_ARGS_ASSERT_MY_ATOF3;
/* leading whitespace */
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
char* copy = NULL;
s = copy + (s - orig);
}
- result[2] = strtoflt128(s, &endp);
+ result[2] = S_strtod(aTHX_ s, &endp);
/* If we created a copy, 'endp' is in terms of that. Convert back to
* the original */
if (copy) {
+ s = (s - copy) + (char *) orig;
endp = (endp - copy) + (char *) orig;
Safefree(copy);
}
https://perl5.git.perl.org / perl5.git / blobdiff