In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/ce6f496d720f6206455628425320badd95b07372?hp=5d8df9ed10b04822e13ef16c9f6e8cd8fe42625c>
- Log -----------------------------------------------------------------
commit ce6f496d720f6206455628425320badd95b07372
Author: sisyphus <sisyph...@optusnet.com.au>
Date: Wed Aug 1 22:33:38 2018 +1000
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.
commit c7ea9f039c0e7c2333adfcb3b9f1e3f2b25693a1
Author: sisyphus <sisyph...@optusnet.com.au>
Date: Wed Aug 1 22:32:00 2018 +1000
perl.h - mingw-w64 builds use __mingw_strtold instead of strtold
There are bugs in strtold().
James Keenan fixed a file permissions problem originally introduced by
this commit, but the fix has been squashed into it.
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 6 ------
embed.h | 5 -----
numeric.c | 16 ++++++++--------
perl.h | 12 +++++++++++-
proto.h | 5 -----
5 files changed, 19 insertions(+), 25 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 0ca6e1db79..4d0daf4df8 100644
--- 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 c9001a128e..c59e6bcf63 100644
--- 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 486aa1c6b7..00f41fce7f 100644
--- 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/perl.h b/perl.h
index 9bf47e4ddf..66ebf205df 100644
--- a/perl.h
+++ b/perl.h
@@ -6477,7 +6477,17 @@ expression, but with an empty argument list, like this:
#ifdef USE_QUADMATH
# define Perl_strtod(s, e) strtoflt128(s, e)
#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-# if defined(HAS_STRTOLD)
+# if defined(__MINGW64_VERSION_MAJOR) && defined(HAS_STRTOLD)
+ /***********************************************
+ 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.
+ ***********************************************/
+# define Perl_strtod(s, e) __mingw_strtold(s, e)
+# elif defined(HAS_STRTOLD)
# define Perl_strtod(s, e) strtold(s, e)
# elif defined(HAS_STRTOD)
# define Perl_strtod(s, e) (NV)strtod(s, e) /* Unavoidable loss. */
diff --git a/proto.h b/proto.h
index 6003a7b7a5..a708a611f4 100644
--- 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)
--
Perl5 Master Repository
