This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Fix comment
[perl5.git] / numeric.c
index f645502..7065486 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -574,6 +574,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
 {
     const char* s = *sp;
     int flags = 0;
+#if defined(NV_INF) || defined(NV_NAN)
     bool odh = FALSE; /* one-dot-hash: 1.#INF */
 
     PERL_ARGS_ASSERT_GROK_INFNAN;
@@ -798,6 +799,9 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
     while (s < send && isSPACE(*s))
         s++;
 
+#else
+    PERL_UNUSED_ARG(send);
+#endif /* #if defined(NV_INF) || defined(NV_NAN) */
     *sp = s;
     return flags;
 }
@@ -1009,7 +1013,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
     s++;
   if (s >= send)
     return numtype;
-  if (len == 10 && memEQ(pv, "0 but true", 10)) {
+  if (memEQs(pv, len, "0 but true")) {
     if (valuep)
       *valuep = 0;
     return IS_NUMBER_IN_UV;
@@ -1018,7 +1022,7 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
   if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
       /* Really detect inf/nan. Start at d, not s, since the above
        * code might have already consumed the "1." or "1". */
-      int infnan = Perl_grok_infnan(aTHX_ &d, send);
+      const int infnan = Perl_grok_infnan(aTHX_ &d, send);
       if ((infnan & IS_NUMBER_INFINITY)) {
           return (numtype | infnan); /* Keep sign for infinity. */
       }
@@ -1085,7 +1089,7 @@ Perl_grok_atoUV(const char *pv, UV *valptr, const char** endptr)
                 /* This could be unrolled like in grok_number(), but
                  * the expected uses of this are not speed-needy, and
                  * unlikely to need full 64-bitness. */
-                U8 digit = *s++ - '0';
+                const U8 digit = *s++ - '0';
                 if (val < uv_max_div_10 ||
                     (val == uv_max_div_10 && digit <= uv_max_mod_10)) {
                     val = val * 10 + digit;
@@ -1138,7 +1142,7 @@ S_mulexp10(NV value, I32 exponent)
      * a hammer.  Therefore we need to catch potential overflows before
      * it's too late. */
 
-#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
+#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP)
     STMT_START {
        const NV exp_v = log10(value);
        if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
@@ -1185,7 +1189,11 @@ S_mulexp10(NV value, I32 exponent)
            result *= power;
 #ifdef FP_OVERFLOWS_TO_ZERO
             if (result == 0)
+# ifdef NV_INF
                 return value < 0 ? -NV_INF : NV_INF;
+# else
+                return value < 0 ? -FLT_MAX : FLT_MAX;
+# endif
 #endif
            /* Floating point exceptions are supposed to be turned off,
             *  but if we're obviously done, don't risk another iteration.  
@@ -1201,21 +1209,26 @@ S_mulexp10(NV value, I32 exponent)
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
+    /* 's' must be NUL terminated */
+
     NV x = 0.0;
+
+    PERL_ARGS_ASSERT_MY_ATOF;
+
 #ifdef USE_QUADMATH
+
     Perl_my_atof2(aTHX_ s, &x);
-    return x;
+
+#elif ! defined(USE_LOCALE_NUMERIC)
+
+    Perl_atof2(s, x);
+
 #else
-#  ifdef USE_LOCALE_NUMERIC
-    PERL_ARGS_ASSERT_MY_ATOF;
 
     {
         DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
         STORE_LC_NUMERIC_SET_TO_NEEDED();
         if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
-            const char *standard = NULL, *local = NULL;
-            bool use_standard_radix;
-
             /* 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
@@ -1223,10 +1236,11 @@ Perl_my_atof(pTHX_ const char* s)
              * that we have to determine this beforehand because on some
              * systems, Perl_atof2 is just a wrapper around the system's atof.
              * */
-            standard = strchr(s, '.');
-            local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
-
-            use_standard_radix = standard && (!local || standard < local);
+            const char * const standard_pos = strchr(s, '.');
+            const char * const local_pos
+                                  = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
+            const bool use_standard_radix
+                    = standard_pos && (!local_pos || standard_pos < local_pos);
 
             if (use_standard_radix)
                 SET_NUMERIC_STANDARD();
@@ -1240,13 +1254,13 @@ Perl_my_atof(pTHX_ const char* s)
             Perl_atof2(s, x);
         RESTORE_LC_NUMERIC();
     }
-#  else
-    Perl_atof2(s, x);
-#  endif
+
 #endif
+
     return x;
 }
 
+#if defined(NV_INF) || defined(NV_NAN)
 
 #ifdef USING_MSVC6
 #  pragma warning(push)
@@ -1257,7 +1271,7 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
 {
     const char *p0 = negative ? s - 1 : s;
     const char *p = p0;
-    int infnan = grok_infnan(&p, send);
+    const int infnan = grok_infnan(&p, send);
     if (infnan && p != p0) {
         /* If we can generate inf/nan directly, let's do so. */
 #ifdef NV_INF
@@ -1276,8 +1290,6 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
         /* If still here, we didn't have either NV_INF or NV_NAN,
          * and can try falling back to native strtod/strtold.
          *
-         * (Though, are our NV_INF or NV_NAN ever not defined?)
-         *
          * The native interface might not recognize all the possible
          * inf/nan strings Perl recognizes.  What we can try
          * is to try faking the input.  We will try inf/-inf/nan
@@ -1286,36 +1298,44 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
             const char* fake = NULL;
             char* endp;
             NV nv;
+#ifdef NV_INF
             if ((infnan & IS_NUMBER_INFINITY)) {
                 fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf";
             }
-            else if ((infnan & IS_NUMBER_NAN)) {
+#endif
+#ifdef NV_NAN
+            if ((infnan & IS_NUMBER_NAN)) {
                 fake = "nan";
             }
+#endif
             assert(fake);
             nv = Perl_strtod(fake, &endp);
             if (fake != endp) {
+#ifdef NV_INF
                 if ((infnan & IS_NUMBER_INFINITY)) {
-#ifdef Perl_isinf
+#  ifdef Perl_isinf
                     if (Perl_isinf(nv))
                         *value = nv;
-#else
+#  else
                     /* last resort, may generate SIGFPE */
                     *value = Perl_exp((NV)1e9);
                     if ((infnan & IS_NUMBER_NEG))
                         *value = -*value;
-#endif
+#  endif
                     return (char*)p; /* p, not endp */
                 }
-                else if ((infnan & IS_NUMBER_NAN)) {
-#ifdef Perl_isnan
+#endif
+#ifdef NV_NAN
+                if ((infnan & IS_NUMBER_NAN)) {
+#  ifdef Perl_isnan
                     if (Perl_isnan(nv))
                         *value = nv;
-#else
+#  else
                     /* last resort, may generate SIGFPE */
                     *value = Perl_log((NV)-1.0);
-#endif
+#  endif
                     return (char*)p; /* p, not endp */
+#endif
                 }
             }
         }
@@ -1327,6 +1347,8 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
 #  pragma warning(pop)
 #endif
 
+#endif /* if defined(NV_INF) || defined(NV_NAN) */
+
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 {
@@ -1409,11 +1431,13 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 /* the max number we can accumulate in a UV, and still safely do 10*N+9 */
 #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10))
 
+#if defined(NV_INF) || defined(NV_NAN)
     {
-        const char* endp;
+        char* endp;
         if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
-            return (char*)endp;
+            return endp;
     }
+#endif
 
     /* we accumulate digits into an integer; when this becomes too
      * large, we add the total to NV and start again */
@@ -1470,9 +1494,9 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
        else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
            seen_dp = 1;
            if (sig_digits > MAX_SIG_DIGITS) {
-               do {
+               while (isDIGIT(*s)) {
                    ++s;
-               } while (isDIGIT(*s));
+               }
                break;
            }
        }
@@ -1536,6 +1560,7 @@ This is also the logical inverse of Perl_isfinite().
 bool
 Perl_isinfnan(NV nv)
 {
+  PERL_UNUSED_ARG(nv);
 #ifdef Perl_isinf
     if (Perl_isinf(nv))
         return TRUE;