PATCH: [perl #41202] text->float gives wrong answer

This changes to use Perl_strtod() when available, and that turns out to
be the key to fixing this bug.

S_mulexp10() is removed from embed.fnc to avoid repeating the
complicated prerequisites for defining Perl_strtod().  This works
because this static function already was defined before use in
numeric.c, and always called in full form without using a macro.

James Keenan fixed a file permissions problem originally introduced by
this commit, but the fix has been squashed into it.

diff --git a/embed.fnc b/embed.fnc
index 0ca6e1d..4d0daf4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2879,12 +2879,6 @@ pn       |Malloc_t       |mem_log_realloc        |const UV n|const UV typesize|NN const char *type_
 pn     |Malloc_t       |mem_log_free   |Malloc_t oldalloc|NN const char *filename|const int linenumber|NN const char *funcname
 #endif
 
-#if defined(PERL_IN_NUMERIC_C)
-#ifndef USE_QUADMATH
-sn     |NV|mulexp10    |NV value|I32 exponent
-#endif
-#endif
-
 #if defined(PERL_IN_UTF8_C)
 sR     |HV *   |new_msg_hv |NN const char * const message                  \
                            |U32 categories                                 \

diff --git a/embed.h b/embed.h
index c9001a1..c59e6bc 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1653,11 +1653,6 @@
 #define utf16_textfilter(a,b,c)        S_utf16_textfilter(aTHX_ a,b,c)
 #    endif
 #  endif
-#  if !defined(USE_QUADMATH)
-#    if defined(PERL_IN_NUMERIC_C)
-#define mulexp10               S_mulexp10
-#    endif
-#  endif
 #  if !defined(UV_IS_QUAD)
 #    if defined(PERL_IN_UTF8_C)
 #define is_utf8_cp_above_31_bits       S_is_utf8_cp_above_31_bits

diff --git a/numeric.c b/numeric.c
index 486aa1c..00f41fc 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -1145,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)
 {
@@ -1241,9 +1241,9 @@ 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
 #  define ATOF(s, x) Perl_atof2(s, x)
@@ -1406,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};
@@ -1425,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 */
@@ -1442,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;
@@ -1460,7 +1460,7 @@ 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 */

diff --git a/proto.h b/proto.h
index 6003a7b..a708a61 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4324,11 +4324,6 @@ STATIC void      S_validate_suid(pTHX_ PerlIO *rsfp);
        assert(rsfp)
 #  endif
 #endif
-#if !defined(USE_QUADMATH)
-#  if defined(PERL_IN_NUMERIC_C)
-STATIC NV      S_mulexp10(NV value, I32 exponent);
-#  endif
-#endif
 #if !defined(UV_IS_QUAD)
 #  if defined(PERL_IN_UTF8_C)
 STATIC int     S_is_utf8_cp_above_31_bits(const U8 * const s, const U8 * const e, const bool consider_overlongs)