-
Notifications
You must be signed in to change notification settings - Fork 550
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
text->float conversion gives wrong answer #8730
Comments
From zefram@fysh.orgCreated by zefram@fysh.org$ perl -lwe 'printf "%f\n", 1180591620717411303424.0' The value that I put in the source is exactly 2^70. This is $ perl -lwe 'printf "%f\n", 1180591620717411172352.0' Using that I can construct 2^70, which converts back to text normally: $ perl -lwe 'printf "%f\n", 1180591620717411172352.0+131072.0' For further evidence that it is the text->float conversion, and not $ perl -MData::Float=float_hex -lwe 'print float_hex(1180591620717411303424.0)' The same conversion fault occurs with runtime string->number conversion This fault does not occur with other programs doing this conversion on zsh% echo $((1180591620717411303424.0 == 1180591620717411172352.0)) Perl Info
|
From @cpansproutOn Sun Jan 07 10:45:52 2007, zefram@fysh.org wrote:
Perl’s atof implementation (c2988b2) multiplies by ten every time it |
The RT System itself - Status changed from 'new' to 'open' |
From @samvOn Sun Nov 28 14:44:28 2010, sprout wrote:
I performed some investigation of this "bug". No precision is lost by perl -le 'print unpack("H*", reverse(pack("d", This is 1.fffffffffffff * 2^69 and a valid conversion for the input It seems true that C99 encourages implementations to perform "correct" As to how glibc gets it "right". I pulled apart the glibc and indeed But it still gets it wrong: http://www.exploringbinary.com/incorrectly-rounded-conversions-in-gcc- This is apparently because the glibc strtod has a "pragmatic" limit of So they just made a string to number conversion not only use MP math and Practically speaking, Perl's implementation is about as good as you I suggest setting this ticket to 'rejected' |
From zefram@fysh.orgTom Hukins has run into an interesting case of this bug. He's trying try $T++, 2.2250738585072014e-308 != 0.0, 'min double'; The value shown is not particularly close to the minimum IEEE However, the duff decimal->float conversion has the effect of breaking On the Beaglebone, because subnormals can't be handled at all, all of -zefram |
From @sisyphusLe Tue, 01 Feb 2011 16:10:13 -0800, mugwump a écrit :
This is 7 years later, and even when HAS_STRTOD is defined with the latest devel release(perl-5.27.9) we don't get the value that glibc assigns. I noticed quite some time ago that, with -Dusequadmath builds of perl, there are not any known cases of perl assigning a floating point value incorrectly. In contrast, it's amazingly easy to hit floating point values on double and (extended precision) long double builds of perl that are assigned incorrectly. So ... what's so special about the way that the quadmath builds assign values ? Now, it seems to me that if Perl_strtod() is good enough for quadmath builds, then it ought to be good enough for 'double' and 'long double' builds, too. The patch (attached) ensures that, if Perl_strtod is defined, assignment of values for 'double' and 'long double' builds of perl follows the same path as that for '__float128' builds. The main script I've used for testing is nv2.pl (attached). On an *unpatched* 5.27.9, running 'perl nv2.pl 10' has always quickly hit a mis-assigned value (mostly within the first 20 iterations) and died. I have managed to find some instances where strtod/strtold does return an incorrect value, but only on a targeted search of values close to a power of 2. With the patched numeric.c, all tests still passed on x86 windows for both 'double' and 'long double' builds.(Can't do quadmath builds on Windows.) Annoyingly, on the Windows 'long double' build only, the patch altered the way that the numification of the string '9875'x1000 alters the internals. (This caused one Math::MPFR test to fail, and I need to investigate it.) On Ubuntu, patched builds produce the following test failure for both the 'double' and the 'long double' build: t/porting/args_assert .......................................... Other than that, all seems fine. Is any of this at all useful ? Cheers, |
From @sisyphusHmmm ... I don't see the patch. |
From @sisyphus--- numeric.c_orig 2018-03-07 19:31:23 +1100 -#ifndef USE_QUADMATH NV PERL_ARGS_ASSERT_MY_ATOF; -#ifdef USE_QUADMATH Perl_my_atof2(aTHX_ s, &x); @@ -1357,11 +1357,11 @@ -#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH) /* leading whitespace */ -#ifdef USE_QUADMATH |
From @sisyphusLe Fri, 09 Mar 2018 22:47:01 -0800, sisyphus a écrit :
Looks to me like a mingw runtime bug in strtold() - which I've reported to: Cheers, |
From @sisyphusOn Sun, 11 Mar 2018 04:11:50 -0700, sisyphus wrote:
The bug turns out to be easily worked around. Attached is the patch I eventually used with perl-5.28.0. The systems I've tested have been Ubuntu-16.04 (gcc-5.4.0 &, glibc-2.23), Debian Wheezy (gcc-4.6.3 & glibc-2.13) and MS Windows (various mingw-w64 ports of gcc-4.7.0 thru to 8.1.0). I'm therefore unaware of any valid reason that this modified patch should not be incorporated into perl-5.29. The effects of this patch can be nullified by building perl such that HAS_STRTOD or HAS_STRTOLD is not defined. On Linux this is as simple as configuring the perl build with -Ud_strtod or -Ud_strtold. I've given a little more detail at https://www.perlmonks.org/?node_id=1217588 Cheers, |
From @sisyphus--- numeric.c_orig 2018-07-01 21:44:17 +1000 -#ifndef USE_QUADMATH NV PERL_ARGS_ASSERT_MY_ATOF; -#ifdef USE_QUADMATH Perl_my_atof2(aTHX_ s, &x); @@ -1369,11 +1369,11 @@ -#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH) /* leading whitespace */ -#ifdef USE_QUADMATH |
From @jkeenanOn Sat, 14 Jul 2018 12:22:08 GMT, sisyphus@cpan.org wrote:
numeric.c has changed since perl-5.28.0, so your patch did not apply cleanly. There were 3 hunks rejected, preventing me from creating a smoke-me branch for testing. Would it be possible to re-draw this patch against perl 5 blead, preferably creating the patch with 'git format-patch'? Thank you very much.
-- |
From @sisyphusAnd, of course, when I incorporate my patch into the current blead version So ... I think I'll wait for this issue with the quadmath builds to be The actual patch I used with latest blead (commit 76416d1) is attached. It would be great if we could have my patch smoked - though perhaps it Thanks for showing some interest, Jim. It's much appreciated ! Cheers, On Sun, Jul 15, 2018 at 9:21 AM, James E Keenan via RT <
|
From @sisyphus0001-patched-numeric.c.patchFrom 53be06c206a17fea83599e7607ca72d8d2d2d7c3 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Sun, 15 Jul 2018 11:39:59 +1000
Subject: [PATCH] patched numeric.c
---
numeric.c | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
diff --git a/numeric.c b/numeric.c
index 34eb8b3..9f98311 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1143,7 +1143,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)
{
@@ -1239,7 +1239,7 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
NV
Perl_my_atof(pTHX_ const char* s)
@@ -1250,7 +1250,7 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
my_atof2(s, &x);
@@ -1400,13 +1400,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 +1419,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,13 +1436,28 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
return endp;
endp = send;
- result[2] = strtoflt128(s, &endp);
+# if defined(__MINGW64_VERSION_MAJOR) && defined(USE_LONG_DOUBLE)
+
+ /***********************************************
+ 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[2] = __mingw_strtold(s, &endp);
+
+# else
+ result[2] = Perl_strtod(s, &endp);
+# endif
if (s != endp) {
*value = negative ? -result[2] : result[2];
return endp;
--
2.1.4
|
From @sisyphusAnd, of course, when I incorporate my patch into the current blead version So ... I think I'll wait for this issue with the quadmath builds to be The actual patch I used with latest blead (commit 76416d1) is attached. It would be great if we could have my patch smoked - though perhaps it Thanks for showing some interest, Jim. It's much appreciated ! Cheers, On Sun, Jul 15, 2018 at 9:21 AM, James E Keenan via RT <
|
From @sisyphus0001-patched-numeric.c.patchFrom 53be06c206a17fea83599e7607ca72d8d2d2d7c3 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Sun, 15 Jul 2018 11:39:59 +1000
Subject: [PATCH] patched numeric.c
---
numeric.c | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
diff --git a/numeric.c b/numeric.c
index 34eb8b3..9f98311 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1143,7 +1143,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)
{
@@ -1239,7 +1239,7 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
NV
Perl_my_atof(pTHX_ const char* s)
@@ -1250,7 +1250,7 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
my_atof2(s, &x);
@@ -1400,13 +1400,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 +1419,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,13 +1436,28 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
return endp;
endp = send;
- result[2] = strtoflt128(s, &endp);
+# if defined(__MINGW64_VERSION_MAJOR) && defined(USE_LONG_DOUBLE)
+
+ /***********************************************
+ 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[2] = __mingw_strtold(s, &endp);
+
+# else
+ result[2] = Perl_strtod(s, &endp);
+# endif
if (s != endp) {
*value = negative ? -result[2] : result[2];
return endp;
--
2.1.4
|
From @jkeenanOn Sun, 15 Jul 2018 04:29:42 GMT, sisyphus359@gmail.com wrote:
On Linux, I got a lot of failures in 3 files: ##### branch: smoke-me/jkeenan/sisyphus/41202-text-float
-- |
From @sisyphusOn Sun, 15 Jul 2018 06:14:33 -0700, jkeenan wrote:
That looks similar to what I got, except I didn't notice any locale.t. The numeric.c patch that I have (against the numeric.c at that commit) is attached as 0002-patched-numeric.c.patch. All is working fine for me again - and I hope you see the same improvement. Note that -Dusequadmath builds of perl should be identical, irrespective of whether this patch is applied. This is most desirable because quadmath builds already assign floating point values correctly, straight out of the box. Having applied the patch, if you then build perl configured with -Ud_strtod (on a "double" build) or -Ud_strtold (on a "long double" build) then you should effectively disable the patch. (This can be useful for comparison purposes.) Cheers, |
From @sisyphus0002-patched-numeric.c.patchFrom 64d72c34c593bd17e0db25466201a42d358b2866 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Mon, 16 Jul 2018 13:59:19 +1000
Subject: [PATCH] patched numeric.c
---
numeric.c | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
diff --git a/numeric.c b/numeric.c
index b608615..6de333e 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1143,7 +1143,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)
{
@@ -1239,7 +1239,7 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
NV
Perl_my_atof(pTHX_ const char* s)
@@ -1250,7 +1250,7 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
my_atof2(s, &x);
@@ -1400,13 +1400,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 +1419,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 +1436,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,7 +1454,22 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
s = copy + (s - orig);
}
- result[2] = strtoflt128(s, &endp);
+# if defined(__MINGW64_VERSION_MAJOR) && defined(USE_LONG_DOUBLE)
+
+ /***********************************************
+ 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[2] = __mingw_strtold(s, &endp);
+
+# else
+ result[2] = Perl_strtod(s, &endp);
+# endif
/* If we created a copy, 'endp' is in terms of that. Convert back to
* the original */
--
2.1.4
|
From @sisyphusI should probably provide an up-to-date script that checks floating point assignments for correctness. The script requires Math-MPFR-4.03, and that module needs to have been built against mpfr-3.1.6 or later - best to build against the current stable mpfr-4.0.1 if possible. I'd be interested to hear of any mis-assignments that it catches on perls that define $Config{d_strtod} or $Config{d_strtold} && to which the patch under consideration has been applied. Cheers, |
From @sisyphusThe version of numeric.c in the smoke-me/jkeenan/sisyphus/41202-text-float branch looks wrong to me. I don't think it includes the corrections that Karl made in commits d94e901 and 6d37e91 Attached is the numeric.c patch against current blead (as at commit b2247a8...) Could this please be applied to the smoke-me/jkeenan/sisyphus/41202-text-float branch. Cheers, |
From @sisyphus0003-patched-numeric.c.patchFrom 4b3b7f7acf7e121ffc87c844fa2b7c8bad4f2871 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Thu, 19 Jul 2018 21:10:35 +1000
Subject: [PATCH] patched numeric.c
---
numeric.c | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
diff --git a/numeric.c b/numeric.c
index e776f73..40d464a 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,7 +1241,7 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
NV
Perl_my_atof(pTHX_ const char* s)
@@ -1252,7 +1252,7 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
my_atof2(s, &x);
@@ -1402,13 +1402,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};
@@ -1421,7 +1421,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 */
@@ -1438,7 +1438,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
char* copy = NULL;
@@ -1456,7 +1456,22 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
s = copy + (s - orig);
}
- result[2] = strtoflt128(s, &endp);
+# if defined(__MINGW64_VERSION_MAJOR) && defined(USE_LONG_DOUBLE)
+
+ /***********************************************
+ 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[2] = __mingw_strtold(s, &endp);
+
+# else
+ result[2] = Perl_strtod(s, &endp);
+# endif
/* If we created a copy, 'endp' is in terms of that. Convert back to
* the original */
--
2.1.4
|
From [Unknown Contact. See original ticket]The version of numeric.c in the smoke-me/jkeenan/sisyphus/41202-text-float branch looks wrong to me. I don't think it includes the corrections that Karl made in commits d94e901 and 6d37e91 Attached is the numeric.c patch against current blead (as at commit b2247a8...) Could this please be applied to the smoke-me/jkeenan/sisyphus/41202-text-float branch. Cheers, |
From @jkeenanOn Thu, 19 Jul 2018 11:48:24 GMT, sisyphus@cpan.org wrote:
Replacement branch for smoke-testing: smoke-me/jkeenan/sisyphus/41202-2nd-text-float However, when I tried that locally, I encountered previously unseen failures in lib/locale.t: ##### Failed 5/682 subtests Test Summary Report ../lib/locale.t (Wstat: 0 Tests: 682 Failed: 5) -- |
From @khwilliamsonOn 07/19/2018 05:48 AM, sisyphus@cpan.org via RT wrote:
|
From @khwilliamsonOn 07/19/2018 05:48 AM, sisyphus@cpan.org via RT wrote:
Again, I wonder if the Mingw stuff should be moved into perl.h? So |
From @sisyphusOn Thu, 19 Jul 2018 07:33:43 -0700, public@khwilliamson.com wrote:
Ok - I'll move the MinGW stuff relating to Perl_strtod into perl.h. I'll post again later with the relevant patches. Cheers, |
From @sisyphusOn Thu, 19 Jul 2018 17:38:58 -0700, sisyphus@cpan.org wrote:
AS of current blead (commit cb57a25) attached are the relevant patches to perl.h and numeric.c. Cheers, |
From @sisyphus0002-numeric_c.patchFrom dad23802050e0088442e08523664e0429a3298d7 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 10:58:08 +1000
Subject: [PATCH 2/4] numeric_c
---
numeric.c | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/numeric.c b/numeric.c
index e776f73..2a340d7 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,7 +1241,7 @@ S_mulexp10(NV value, I32 exponent)
}
return negative ? value / result : value * result;
}
-#endif /* #ifndef USE_QUADMATH */
+#endif /* #ifndef Perl_strtod */
NV
Perl_my_atof(pTHX_ const char* s)
@@ -1252,7 +1252,7 @@ Perl_my_atof(pTHX_ const char* s)
PERL_ARGS_ASSERT_MY_ATOF;
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
my_atof2(s, &x);
@@ -1402,13 +1402,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};
@@ -1421,7 +1421,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 */
@@ -1438,7 +1438,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
}
#endif
-#ifdef USE_QUADMATH
+#ifdef Perl_strtod
{
char* endp;
char* copy = NULL;
@@ -1456,7 +1456,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 */
--
2.1.4
|
From @sisyphus0003-perl_h.patchFrom 9dc1423d02ea4057c568552b011ef86ff0ba47cd Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 10:58:45 +1000
Subject: [PATCH 3/4] perl_h
---
perl.h | 33 ++++++++++++++++++++++-----------
1 file changed, 22 insertions(+), 11 deletions(-)
diff --git a/perl.h b/perl.h
index f4b146d..16bcf23 100644
--- a/perl.h
+++ b/perl.h
@@ -1565,6 +1565,28 @@ EXTERN_C char *crypt(const char *, const char *);
#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
#ifdef USE_QUADMATH
+# define Perl_strtod(s, e) strtoflt128(s, e)
+#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+# 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. */
+# endif
+#elif defined(HAS_STRTOD)
+# define Perl_strtod(s, e) strtod(s, e)
+#endif
+
+#ifdef USE_QUADMATH
# define my_snprintf Perl_my_snprintf
# define PERL_MY_SNPRINTF_GUARDED
#elif defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
@@ -6474,17 +6496,6 @@ expression, but with an empty argument list, like this:
#define Atof my_atof
-#ifdef USE_QUADMATH
-# define Perl_strtod(s, e) strtoflt128(s, e)
-#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
-# if 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. */
-# endif
-#elif defined(HAS_STRTOD)
-# define Perl_strtod(s, e) strtod(s, e)
-#endif
#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && \
(QUADKIND == QUAD_IS_LONG_LONG || QUADKIND == QUAD_IS___INT64)
--
2.1.4
|
From @sisyphus
Ignore the proto.h attachment. |
From @sisyphus0004-proto_h.patchFrom 53de570889de38a9cc7e915f195ab2bd4c2de97a Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 10:59:39 +1000
Subject: [PATCH 4/4] proto.h
---
proto.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/proto.h b/proto.h
index b94a47d..2b4c647 100644
--- a/proto.h
+++ b/proto.h
@@ -4327,7 +4327,7 @@ STATIC void S_validate_suid(pTHX_ PerlIO *rsfp);
assert(rsfp)
# endif
#endif
-#if !defined(USE_QUADMATH)
+#if !defined(Perl_strtod)
# if defined(PERL_IN_NUMERIC_C)
STATIC NV S_mulexp10(NV value, I32 exponent);
# endif
--
2.1.4
|
From @khwilliamsonOn 07/31/2018 07:07 PM, sisyphus@cpan.org via RT wrote:
embed.fnc should be patched with the necessary #ifdef's. Then
I think it's pretty close to gospel.
I'm disappointed to learn that these builds were added with such
I have pushed a branch that I think may add locale handling to quadmath. https://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-me/khw-locale.
|
1 similar comment
From @khwilliamsonOn 07/31/2018 07:07 PM, sisyphus@cpan.org via RT wrote:
embed.fnc should be patched with the necessary #ifdef's. Then
I think it's pretty close to gospel.
I'm disappointed to learn that these builds were added with such
I have pushed a branch that I think may add locale handling to quadmath. https://perl5.git.perl.org/perl.git/shortlog/refs/heads/smoke-me/khw-locale.
|
From @sisyphusOn Tue, 31 Jul 2018 20:47:53 -0700, public@khwilliamson.com wrote:
Yes, that's looking good here as a quadmath build (built with "-Duse64bitall -Dusequadmath"). The only test failure on the quadmath build was lib/File/Copy.t which is a separate issue (https://rt-archive.perl.org/perl5/Ticket/Display.html?id=133377). I then stuck my earlier perl.h and numeric.c changes on top of that branch - didn't bother with the proto.h and embed.h patches as that's only going to confuse things at the moment. I then re-built the quadmath build, in case my additional changes might've upset it. (Thankfully, they had not.) I also checked a uselongdouble 64-bit build on Windows, too, and I'll check other builds as time permits. Everything looks good so far. Attached are the patches I applied to your smoke-me/khw-locale branch. |
From @sisyphusOn Wed, 01 Aug 2018 07:04:30 -0700, sisyphus@cpan.org wrote:
Jesus ... where the hell did they go :-( |
From @sisyphus0001-lib-locale.t-no-longer-special-case-quadmath-builds.patchFrom bc4ee85df9568998ee2b744275c95ce52c905b87 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 22:29:57 +1000
Subject: [PATCH 1/3] lib/locale.t - no longer special case quadmath builds
---
lib/locale.t | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/lib/locale.t b/lib/locale.t
index 17931c8..b6c597f 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -2167,7 +2167,7 @@ foreach my $Locale (@Locale) {
my $first_c_test = $locales_test_number;
$test_names{++$locales_test_number} = 'Verify that a different locale radix works when doing "==" with a constant';
- if ($Config{usequadmath}) {
+ if (0) {
print "# Skip: no locale radix with usequadmath ($test_names{$locales_test_number})\n";
report_result($Locale, $locales_test_number, 1);
} else {
@@ -2176,7 +2176,7 @@ foreach my $Locale (@Locale) {
}
$test_names{++$locales_test_number} = 'Verify that a different locale radix works when doing "==" with a scalar';
- if ($Config{usequadmath}) {
+ if (0) {
print "# Skip: no locale radix with usequadmath ($test_names{$locales_test_number})\n";
report_result($Locale, $locales_test_number, 1);
} else {
@@ -2198,7 +2198,7 @@ foreach my $Locale (@Locale) {
$test_names{$locales_test_number} = 'Verify that "==" with a scalar still works in inner no locale';
$test_names{++$locales_test_number} = 'Verify that "==" with a scalar and an intervening sprintf still works in inner no locale';
- if ($Config{usequadmath}) {
+ if (0) {
print "# Skip: no locale radix with usequadmath ($test_names{$locales_test_number})\n";
report_result($Locale, $locales_test_number, 1);
} else {
@@ -2218,7 +2218,7 @@ foreach my $Locale (@Locale) {
$problematical_tests{$locales_test_number} = 1;
$test_names{++$locales_test_number} = 'Verify that after a no-locale block, a different locale radix still works when doing "==" with a scalar and an intervening sprintf';
- if ($Config{usequadmath}) {
+ if (0) {
print "# Skip: no locale radix with usequadmath ($test_names{$locales_test_number})\n";
report_result($Locale, $locales_test_number, 1);
} else {
@@ -2465,7 +2465,7 @@ foreach my $Locale (@Locale) {
}
}
- if ($Config{usequadmath}) {
+ if (0) {
print "# Skip: no locale radix with usequadmath ($Locale)\n";
report_result($Locale, $locales_test_number, 1);
} else {
--
2.1.4
|
From @sisyphus0002-perl.h-mingw-w64-builds-use-__mingw_strtold-instead-.patchFrom 4957c7e870ada9f7eb48b73527a43ef41d8387a1 Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 22:32:00 +1000
Subject: [PATCH 2/3] perl.h - mingw-w64 builds use __mingw_strtold instead of
strtold
---
perl.h | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
mode change 100644 => 100755 perl.h
diff --git a/perl.h b/perl.h
old mode 100644
new mode 100755
index f4b146d..1fda07c
--- 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. */
--
2.1.4
|
From @sisyphus0003-numeric.c-assign-floating-point-values-with-Perl_str.patchFrom 73684184c4de1a2af71b76e0dae624f72830bf2d Mon Sep 17 00:00:00 2001
From: sisyphus <sisyphus1@optusnet.com.au>
Date: Wed, 1 Aug 2018 22:33:38 +1000
Subject: [PATCH 3/3] numeric.c - assign floating point values with Perl_strtod
instead of perl's Atof
---
numeric.c | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
mode change 100644 => 100755 numeric.c
diff --git a/numeric.c b/numeric.c
old mode 100644
new mode 100755
index 128dac5..dffeed0
--- 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 */
--
2.1.4
|
From @khwilliamsonOn 08/01/2018 08:15 AM, sisyphus@cpan.org via RT wrote:
I pushed your patches onto my branch for smoking. |
From @sisyphus
I lost my connection to most of the internet a few hours ago, so I can't I did see one report that failed both t/run/locale.t and I also saw t/porting/exec-bit.t failure because perl.h or numeric.c had the Can't offer much more until I can find a way to get back to viewing those The smoke-me/khw-locale branch is fine for me with double, long double and Cheers, |
From @khwilliamsonOn 08/02/2018 02:45 AM, sisyphus wrote:
The latest smoke reports are very encouraging, with two of Dave's http://perl.develop-help.com/?b=smoke-me%2Fkhw-locale Rob has sent me some minor cleanup patches, so I'm ready to apply this I think Dave's "HiRes: don't truncate nanosec utime" should go in at the Dave, shall I apply that? |
From @iabynOn Wed, Aug 08, 2018 at 08:47:46AM -0600, Karl Williamson wrote:
Yes please. -- |
From @khwilliamsonThis has been fixed by the patch furnished by sisyphus, commit |
@khwilliamson - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.30.0, this and 160 other issues have been Perl 5.30.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#41202 (status was 'resolved')
Searchable as RT41202$
The text was updated successfully, but these errors were encountered: