This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add UTF8_SAFE_SKIP API macro
[perl5.git] / numeric.c
index 46d8cd8..9804a9b 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -204,7 +204,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                           "Illegal binary digit '%c' ignored", *s);
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -325,7 +325,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                         "Illegal hexadecimal digit '%c' ignored", *s);
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -432,7 +432,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
         }
         break;
     }
-    
+
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
        || (!overflowed && value > 0xffffffff
@@ -565,9 +565,9 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 Helper for C<grok_number()>, accepts various ways of spelling "infinity"
 or "not a number", and returns one of the following flag combinations:
 
-  IS_NUMBER_INFINITE
+  IS_NUMBER_INFINITY
   IS_NUMBER_NAN
-  IS_NUMBER_INFINITE | IS_NUMBER_NEG
+  IS_NUMBER_INFINITY | IS_NUMBER_NEG
   IS_NUMBER_NAN | IS_NUMBER_NEG
   0
 
@@ -1084,6 +1084,8 @@ used for incremental parsing, and therefore should be avoided
 C<atoi> and C<strtol> are also affected by locale settings, which can also be
 seen as a bug (global state controlled by user environment).
 
+=cut
+
 */
 
 bool
@@ -1143,7 +1145,7 @@ Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
     return TRUE;
 }
 
-#ifndef USE_QUADMATH
+#ifndef Perl_strtod
 STATIC NV
 S_mulexp10(NV value, I32 exponent)
 {
@@ -1159,11 +1161,11 @@ S_mulexp10(NV value, I32 exponent)
 
     /* On OpenVMS VAX we by default use the D_FLOAT double format,
      * and that format does not have *easy* capabilities [1] for
-     * overflowing doubles 'silently' as IEEE fp does.  We also need 
-     * to support G_FLOAT on both VAX and Alpha, and though the exponent 
-     * range is much larger than D_FLOAT it still doesn't do silent 
-     * overflow.  Therefore we need to detect early whether we would 
-     * overflow (this is the behaviour of the native string-to-float 
+     * overflowing doubles 'silently' as IEEE fp does.  We also need
+     * to support G_FLOAT on both VAX and Alpha, and though the exponent
+     * range is much larger than D_FLOAT it still doesn't do silent
+     * overflow.  Therefore we need to detect early whether we would
+     * overflow (this is the behaviour of the native string-to-float
      * conversion routines, and therefore of native applications, too).
      *
      * [1] Trying to establish a condition handler to trap floating point
@@ -1231,7 +1233,7 @@ S_mulexp10(NV value, I32 exponent)
 # endif
 #endif
            /* Floating point exceptions are supposed to be turned off,
-            *  but if we're obviously done, don't risk another iteration.  
+            *  but if we're obviously done, don't risk another iteration.
             */
             if (exponent == 0) break;
        }
@@ -1239,7 +1241,13 @@ S_mulexp10(NV value, I32 exponent)
     }
     return negative ? value / result : value * result;
 }
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
+
+#ifdef Perl_strtod
+#  define ATOF(s, x) my_atof2(s, &x)
+#else
+#  define ATOF(s, x) Perl_atof2(s, x)
+#endif
 
 NV
 Perl_my_atof(pTHX_ const char* s)
@@ -1250,20 +1258,20 @@ Perl_my_atof(pTHX_ const char* s)
 
     PERL_ARGS_ASSERT_MY_ATOF;
 
-#ifdef USE_QUADMATH
-
-    my_atof2(s, &x);
+#if ! defined(USE_LOCALE_NUMERIC)
 
-#elif ! defined(USE_LOCALE_NUMERIC)
-
-    Perl_atof2(s, x);
+    ATOF(s, x);
 
 #else
 
     {
         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
              * standard fallback of '.'. The one which appears earliest in the
@@ -1282,15 +1290,13 @@ Perl_my_atof(pTHX_ const char* s)
                 LOCK_LC_NUMERIC_STANDARD();
             }
 
-            Perl_atof2(s, x);
+            ATOF(s,x);
 
             if (use_standard_radix) {
                 UNLOCK_LC_NUMERIC_STANDARD();
                 SET_NUMERIC_UNDERLYING();
             }
         }
-        else
-            Perl_atof2(s, x);
         RESTORE_LC_NUMERIC();
     }
 
@@ -1334,7 +1340,7 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
          * is to try faking the input.  We will try inf/-inf/nan
          * as the most promising/portable input. */
         {
-            const char* fake = NULL;
+            const char* fake = "silence compiler warning";
             char* endp;
             NV nv;
 #ifdef NV_INF
@@ -1347,7 +1353,7 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
                 fake = "nan";
             }
 #endif
-            assert(fake);
+            assert(strNE(fake, "silence compiler warning"));
             nv = Perl_strtod(fake, &endp);
             if (fake != endp) {
 #ifdef NV_INF
@@ -1400,13 +1406,13 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, 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};
@@ -1419,7 +1425,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
     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 */
@@ -1436,7 +1442,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
     }
 #endif
 
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
     {
         char* endp;
         char* copy = NULL;
@@ -1454,11 +1460,12 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
             s = copy + (s - orig);
         }
 
-        result[2] = strtoflt128(s, &endp);
+        result[2] = Perl_strtod(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);
         }
@@ -1700,7 +1707,7 @@ Perl_my_frexpl(long double x, int *e) {
 =for apidoc Perl_signbit
 
 Return a non-zero integer if the sign bit on an NV is set, and 0 if
-it is not.  
+it is not.
 
 If F<Configure> detects this system has a C<signbit()> that will work with
 our NVs, then we just use it via the C<#define> in F<perl.h>.  Otherwise,