[PATCH: perl #17849] (corrected) Long double bugs - sprintf.t _and_ num.t

p5pRT commented 22 years ago

Migrated from rt.perl.org#17066 (status was 'resolved')

Searchable as RT17066$

p5pRT commented 22 years ago

From easmith@beatrice.rutgers.edu

I figured out what was causing the problem with lib/Math/Trig.t with my patch to fix num.t - off-by-one error. Does the below look OK? It applies to 17849 (patch -p1) and does a partial cure for the sprintf bug and a full cure for the num.t bug (#48 on IRIX smoketesting with long doubles)\, with no problems with lib/Math/Trig.t either with or without long doubles\, and adds further checks for the bugs in question. I've tested it on IRIX64 with:

O O O O -Duseperlio O O O O -Duseperlio -Duse64bitint O O O O -Duseperlio -Duselongdouble O O O O -Duseperlio -Dusemorebits | | | +- PERLIO = perlio -DDEBUGGING | | +--- PERLIO = stdio -DDEBUGGING | +----- PERLIO = perlio +------- PERLIO = stdio

This contrasts to 17849 without the patches:

O O O O -Duseperlio F F F F -Duseperlio -Duselongdouble O O O O -Duseperlio -Duse64bitint F F F F -Duseperlio -Dusemorebits O O O O -Duseperlio -Duse64bitall F F ? ? -Duseperlio -Duse64bitall -Duselongdouble | | | +- PERLIO = perlio -DDEBUGGING | | +--- PERLIO = stdio -DDEBUGGING | +----- PERLIO = perlio +------- PERLIO = stdio

Failures:

irix stdio/perlio -Duseperlio -Duselongdouble irix stdio/perlio -DDEBUGGING -Duseperlio -Duselongdouble irix stdio/perlio -Duseperlio -Dusemorebits irix stdio/perlio -DDEBUGGING -Duseperlio -Dusemorebits irix stdio/perlio -Duseperlio -Duse64bitall -Duselongdouble t/base/num...........................FAILED at test 48 ...../t/base/num....FAILED test 48

It doesn't even get to the sprintf tests when using long double\, as you can see. Also see prior IRIX smoketesting.

-Allen

# This is a patch for cpan-current-unpatched to update it to cpan-current-patched # # To apply this patch: # STEP 1: Chdir to the source directory. # STEP 2: Run the 'applypatch' program with this patch file as input. # # If you do not have 'applypatch'\, it is part of the 'makepatch' package # that you can fetch from the Comprehensive Perl Archive Network: # http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz # In the above URL\, 'x' should be 2 or higher. # # To apply this patch without the use of 'applypatch': # STEP 1: Chdir to the source directory. # STEP 2: Run the 'patch' program with this file as input. # #### End of Preamble ####

#### Patch data follows #### diff -audBb 'cpan-current-unpatched/hints/irix_6.sh' 'cpan-current-patched/hints/irix_6.sh' Index: ./hints/irix_6.sh

Inline Patch

```diff --- ./hints/irix_6.sh Thu Aug 29 23:43:51 2002 +++ ./hints/irix_6.sh Wed Sep 4 22:38:11 2002 @@ -37,7 +37,7 @@ # If that fails, or you didn't use that, then try adjusting other # optimization options (-LNO, -INLINE, -O3 to -O2, etcetera). # The compiler bug has been reported to SGI. -# -- Allen Smith +# -- Allen Smith case "$use64bitall" in $define|true|[yY]*) @@ -90,8 +90,9 @@ esac cc=${cc:-cc} +cat=${cat:-cat} -cat > UU/cc.cbu <<'EOCCBU' +$cat > UU/cc.cbu <<'EOCCBU' # This script UU/cc.cbu will get 'called-back' by Configure after it # has prompted the user for the C compiler to use. @@ -141,7 +142,7 @@ *"cc -64"*) case "`uname -s`" in IRIX) - cat >&4 <&4 < UU/usethreads.cbu <<'EOCBU' +$cat > UU/usethreads.cbu <<'EOCBU' # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. case "$usethreads" in @@ -448,7 +449,7 @@ # The -n32 makes off_t to be 8 bytes, so we should have largefileness. -cat > UU/use64bitint.cbu <<'EOCBU' +$cat > UU/use64bitint.cbu <<'EOCBU' # This script UU/use64bitint.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bit integers. @@ -471,7 +472,7 @@ EOCBU -cat > UU/use64bitall.cbu <<'EOCBU' +$cat > UU/use64bitall.cbu <<'EOCBU' # This script UU/use64bitall.cbu will get 'called-back' by Configure # after it has prompted the user for whether to be maximally 64 bitty. @@ -488,6 +489,119 @@ esac ;; esac + +EOCBU + +$cat > UU/uselongdouble.cbu <<'EOCBU' +# This script UU/uselongdouble.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use long doubles. + +# This script is designed to test IRIX (and other machines, once it's put into +# Configure) for a bug in which they fail to round correctly when using +# sprintf/printf/etcetera on a long double with precision specified (%.0Lf or +# whatever). Sometimes, this only happens when the number in question is +# between 1 and -1, weirdly enough. - Allen + +case "$uselongdouble" in +$define|true|[yY]*) ;; +*) exit 0 ;; +esac + +case "$d_PRIfldbl" in +$define|true|[yY]*) ;; +*) # Can't tell! + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG" + exit 0 + ;; +esac + + echo " " >try.c + $cat >>try.c < + +#define sPRIfldbl $sPRIfldbl + +#define I_STDLIB $i_stdlib +#ifdef I_STDLIB +#include +#endif + +int main() +{ + char buf1[64]; + char buf2[64]; + buf1[63] = '\0'; + buf2[63] = '\0'; + + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)0.6L); + (void)sprintf(buf2,"%.0f",(double)0.6); + if (strcmp(buf1,buf2)) { + exit(1); + } + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)-0.6L); + (void)sprintf(buf2,"%.0f",(double)-0.6); + if (strcmp(buf1,buf2)) { + exit(1); + } else { + exit(0); + } +} + +EOP + + set try + if eval $compile && $run ./try; then + rm -f try try.c >/dev/null + exit 0 + else + rm -f try try.c core try.o a.out >/dev/null + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG" + fi + + echo " " >try.c + $cat >>try.c < + +#define sPRIfldbl $sPRIfldbl + +#define I_STDLIB $i_stdlib +#ifdef I_STDLIB +#include +#endif + +int main() +{ + char buf1[64]; + char buf2[64]; + buf1[63] = '\0'; + buf2[63] = '\0'; + + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)1.6L); + (void)sprintf(buf2,"%.0f",(double)1.6); + if (strcmp(buf1,buf2)) { + exit(1); + } + (void)sprintf(buf1,"%.0"sPRIfldbl,(long double)-1.6L); + (void)sprintf(buf2,"%.0f",(double)-1.6); + if (strcmp(buf1,buf2)) { + exit(1); + } else { + exit(0); + } +} + +EOP + + set try + if eval $compile && $run ./try; then + rm -f try try.c >/dev/null + ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG_LESS1" + cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG_LESS1" + else + rm -f try try.c core try.o a.out >/dev/null + fi EOCBU diff -audBb 'cpan-current-unpatched/numeric.c' 'cpan-current-patched/numeric.c' ```

Index: ./numeric.c

Inline Patch

```diff --- ./numeric.c Thu Aug 22 07:45:45 2002 +++ ./numeric.c Thu Sep 5 22:16:05 2002 @@ -727,6 +727,8 @@ if (exponent == 0) return value; + if (value == 0) + return 0; /* On OpenVMS VAX we by default use the D_FLOAT double format, * and that format does not have *easy* capabilities [1] for @@ -811,18 +813,20 @@ char* Perl_my_atof2(pTHX_ const char* orig, NV* value) { - NV result = 0.0; + NV result[3] = {0.0, 0.0, 0.0}; char* s = (char*)orig; #ifdef USE_PERL_ATOF - UV accumulator = 0; + UV accumulator[2] = {0,0}; /* before/after dp */ bool negative = 0; char* send = s + strlen(orig) - 1; bool seen_digit = 0; - I32 exp_adjust = 0; - I32 exp_acc = 0; /* the current exponent adjust for the accumulator */ + I32 exp_adjust[2] = {0,0}; + I32 exp_acc[2] = {-1, -1}; + /* the current exponent adjust for the accumulators */ I32 exponent = 0; I32 seen_dp = 0; - I32 digit; + I32 digit = 0; + I32 old_digit = 0; I32 sig_digits = 0; /* noof significant digits seen so far */ /* There is no point in processing more significant digits @@ -866,8 +870,10 @@ while (1) { if (isDIGIT(*s)) { seen_digit = 1; + old_digit = digit; digit = *s++ - '0'; - exp_adjust -= seen_dp; + if (seen_dp) + exp_adjust[1]++; /* don't start counting until we see the first significant * digit, eg the 5 in 0.00005... */ @@ -874,31 +880,52 @@ if (!sig_digits && digit == 0) continue; - if (++sig_digits > MAX_SIG_DIGITS) { + ++sig_digits; + if (sig_digits > MAX_SIG_DIGITS) { /* limits of precision reached */ - if (digit >= 5) - ++accumulator; - ++exp_adjust; + if (digit > 5) { + ++accumulator[seen_dp]; + } else if (digit == 5) { + if (old_digit % 2) { /* round to even - Allen */ + ++accumulator[seen_dp]; + } + } + if (seen_dp) { + exp_adjust[1]--; + } else { + exp_adjust[0]++; + } /* skip remaining digits */ while (isDIGIT(*s)) { ++s; - exp_adjust += 1 - seen_dp; + if (! seen_dp) { + exp_adjust[0]++; } + } /* warn of loss of precision? */ } else { - if (accumulator > MAX_ACCUMULATE) { + if (accumulator[seen_dp] > MAX_ACCUMULATE) { /* add accumulator to result and start again */ - result = S_mulexp10(result, exp_acc) + (NV)accumulator; - accumulator = 0; - exp_acc = 0; + result[seen_dp] = S_mulexp10(result[seen_dp], + exp_acc[seen_dp]) + + (NV)accumulator[seen_dp]; + accumulator[seen_dp] = 0; + exp_acc[seen_dp] = 0; } - accumulator = accumulator * 10 + digit; - ++exp_acc; + accumulator[seen_dp] = accumulator[seen_dp] * 10 + digit; + ++exp_acc[seen_dp]; } } else if (!seen_dp && GROK_NUMERIC_RADIX((const char **)&s, send)) { seen_dp = 1; + if (sig_digits > MAX_SIG_DIGITS) { + ++s; + while (isDIGIT(*s)) { + ++s; + } + break; + } } else { break; @@ -905,7 +932,10 @@ } } - result = S_mulexp10(result, exp_acc) + (NV)accumulator; + result[0] = S_mulexp10(result[0], exp_acc[0]) + (NV)accumulator[0]; + if (seen_dp) { + result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1]; + } if (seen_digit && (*s == 'e' || *s == 'E')) { bool expnegative = 0; @@ -924,15 +954,22 @@ exponent = -exponent; } + + /* now apply the exponent */ - exponent += exp_adjust; - result = S_mulexp10(result, exponent); + + if (seen_dp) { + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]) + + S_mulexp10(result[1],exponent-exp_adjust[1]); + } else { + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]); + } /* now apply the sign */ if (negative) - result = -result; + result[2] = -result[2]; #endif /* USE_PERL_ATOF */ - *value = result; + *value = result[2]; return s; } diff -audBb 'cpan-current-unpatched/perl.h' 'cpan-current-patched/perl.h' ```

Index: ./perl.h

Inline Patch

```diff --- ./perl.h Sun Aug 25 15:55:04 2002 +++ ./perl.h Wed Sep 4 22:37:42 2002 @@ -1186,6 +1186,27 @@ # endif #endif +/* + * This is for making sure we have a good DBL_MAX value, if possible, + * either for usage as NV_MAX or for usage in figuring out if we can + * fit a given long double into a double, if bug-fixing makes it + * necessary to do so. - Allen + */ + +#if defined(I_VALUES) +# if !defined(USE_LONG_DOUBLE) || defined(HAS_LDBL_SPRINTF_BUG) +# if (!defined(DBL_MIN) || !defined(DBL_MAX)) +# include +# if defined(MAXDOUBLE) && !defined(DBL_MAX) +# define DBL_MAX MAXDOUBLE +# endif +# if defined(MINDOUBLE) && !defined(DBL_MIN) +# define DBL_MIN MINDOUBLE +# endif +# endif +# endif +#endif + typedef NVTYPE NV; #ifdef I_IEEEFP @@ -1217,7 +1238,7 @@ # endif # ifdef LDBL_MAX # define NV_MAX LDBL_MAX -# define NV_MIN LDBL_MIN +/* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ # else # ifdef HUGE_VALL # define NV_MAX HUGE_VALL diff -audBb 'cpan-current-unpatched/sv.c' 'cpan-current-patched/sv.c' ```

Index: ./sv.c

Inline Patch

```diff --- ./sv.c Wed Sep 4 20:23:32 2002 +++ ./sv.c Wed Sep 4 22:40:49 2002 @@ -7926,6 +7926,11 @@ bool has_precis = FALSE; STRLEN precis = 0; bool is_utf8 = FALSE; /* is this item utf8? */ +#ifdef HAS_LDBL_SPRINTF_BUG + /* This is to try to fix a bug with irix/nonstop-ux/powerux and + with sfio - Allen */ + bool fix_ldbl_sprintf_bug = FALSE; +#endif char esignbuf[4]; U8 utf8buf[UTF8_MAXLEN+1]; @@ -8514,8 +8519,91 @@ need = BIT_DIGITS(i); } need += has_precis ? precis : 6; /* known default */ + if (need < width) need = width; + +#ifdef HAS_LDBL_SPRINTF_BUG + /* This is to try to fix a bug with irix/nonstop-ux/powerux and + with sfio - Allen */ + if ((intsize == 'q') && (c == 'f') && +#ifdef HAS_LDBL_SPRINTF_BUG_LESS1 +/* Only happens between -1 and 1 ??? - Allen */ + ((nv < 1L) && (nv > -1L)) && +#endif + (need < DBL_DIG)) { /* it's going to be short enough that + long double precision is not needed */ + + if ((nv <= 0L) && (nv >= -0L)) { + fix_ldbl_sprintf_bug = TRUE; /* Easiest */ + } else { + /* SGI has fpclassl... but not with the same result values, + and it's via a typedef, so will need to redo Configure + to use. Not worth the trouble IMO. Also has fp_class_l, + BTW, via fp_class.h - Allen */ + + /* #if defined(HAS_FPCLASSL) && defined(USE_LONG_DOUBLE) */ + /* if (Perl_fp_class_zero((long double)nv)) { */ + /* fix_ldbl_sprintf_bug = TRUE; */ /* Easiest */ + /* } elsif (Perl_fp_class_norm((long double)nv)) { */ + /* #endif */ +#if !defined(DBL_MIN) || !defined(HAS_LDBL_SPRINTF_BUG_LESS1) +# ifdef DBL_MAX +# define MY_DBL_MAX DBL_MAX +# else /* XXX guessing! HUGE_VAL may be defined as infinity, so not using */ +# if DOUBLESIZE >= 8 +# define MY_DBL_MAX 1.7976931348623157E+308L +# else +# define MY_DBL_MAX 3.40282347E+38L +# endif +# endif +#endif /* !defined(DBL_MIN) || !defined(HAS_LDBL_SPRINTF_BUG_LESS1 */ + +#ifndef HAS_LDBL_SPRINTF_BUG_LESS1 + if ((nv < MY_DBL_MAX) && (nv > -MY_DBL_MAX)) { +#endif + +#ifdef DBL_MIN +# define MY_DBL_MIN DBL_MIN +#else /* XXX guessing! -Allen */ +# if DOUBLESIZE >= 8 +# define MY_DBL_MIN 2.2250738585072014E-308L +# else +# define MY_DBL_MIN 1.17549435E-38L +# endif +#endif + if (((nv > 0L) && (nv >= MY_DBL_MIN) +#ifndef DBL_MIN + && ((long double)1/MY_DBL_MAX <= nv) +#endif + ) || ((nv < -0L) && (nv <= -MY_DBL_MIN) +#ifndef DBL_MIN + && (-(long double)1/MY_DBL_MAX >= nv) +#endif + )) { + /* It's within the range that a double can represent */ + fix_ldbl_sprintf_bug = TRUE; + } +#undef MY_DBL_MIN +#ifndef HAS_LDBL_SPRINTF_BUG_LESS1 + } +#endif +#if !defined(DBL_MIN) || !defined(HAS_LDBL_SPRINTF_BUG_LESS1) +# undef MY_DBL_MAX +#endif +/* #if defined(HAS_FPCLASSL) && defined(USE_LONG_DOUBLE) */ +/* } */ +/* #endif */ + } + if (fix_ldbl_sprintf_bug == TRUE) { + double temp; + + intsize = 0; + temp = (double)nv; + nv = (NV)temp; + } + } +#endif /* HAS_LDBL_SPRINTF_BUG */ need += 20; /* fudge factor */ if (PL_efloatsize < need) { diff -audBb 'cpan-current-unpatched/t/base/num.t' 'cpan-current-patched/t/base/num.t' ```

Index: ./t/base/num.t

Inline Patch

```diff --- ./t/base/num.t Thu Aug 22 07:45:45 2002 +++ ./t/base/num.t Thu Sep 5 22:51:41 2002 @@ -1,6 +1,6 @@ #!./perl -print "1..49\n"; +print "1..50\n"; # First test whether the number stringification works okay. # (Testing with == would exercize the IV/NV part, not the PV.) @@ -179,3 +179,9 @@ $a = 1.0000000000000000000000000000000000000000000000000000000000000000000e1; print $a == 10.0 ? "ok 49\n" : "not ok 49\n"; + +# From Math/Trig - number has to be long enough to exceed at least DBL_DIG + +$a = 57.295779513082320876798154814169; +print ok($a*10,572.95779513082320876798154814169,1e-10) ? "ok 50\n" : + "not ok 50 # $a\n"; diff -audBb 'cpan-current-unpatched/t/op/sprintf.t' 'cpan-current-patched/t/op/sprintf.t' ```

Index: ./t/op/sprintf.t

Inline Patch

```diff --- ./t/op/sprintf.t Sun Jul 14 15:24:26 2002 +++ ./t/op/sprintf.t Wed Sep 4 22:40:11 2002 @@ -236,6 +236,8 @@ >%#e< >-1234.875< >-1.234875e+03< >%.0e< >1234.875< >1e+03< >%#.0e< >1234.875< >1.e+03< +>%.0e< >1.875< >2e+00< +>%.0e< >0.875< >9e-01< >%.*e< >[0, 1234.875]< >1e+03< >%.1e< >1234.875< >1.2e+03< >%-12.4e< >1234.875< >1.2349e+03 < @@ -265,8 +267,10 @@ >%.0f< >0< >0< >%.0f< >2**38< >274877906944< >Should have exact int'l rep'n< >%.0f< >0.1< >0< ->%.0f< >0.6< >1< >Known to fail with sfio and (irix|nonstop-ux|powerux)< ->%.0f< >-0.6< >-1< >Known to fail with sfio and (irix|nonstop-ux|powerux)< +>%.0f< >0.6< >1< >Known to fail with sfio, (irix|nonstop-ux|powerux); -DHAS_LDBL_SPRINTF_BUG may fix< +>%.0f< >-0.6< >-1< >Known to fail with sfio, (irix|nonstop-ux|powerux); -DHAS_LDBL_SPRINTF_BUG may fix< +>%.0f< >1.6< >2< +>%.0f< >-1.6< >-2< >%.0f< >1< >1< >%#.0f< >1< >1.< >%g< >12345.6789< >12345.7< ```

End of Patch data

#### End of Patch kit [created: Thu Sep 5 22:55:34 2002] #### #### Patch checksum: 592 17141 31996 #### #### Checksum: 610 17846 25559 ####

-- Allen Smith http://cesario.rutgers.edu/easmith/ September 11\, 2001 A Day That Shall Live In Infamy II "They that can give up essential liberty to obtain a little temporary safety deserve neither liberty nor safety." - Benjamin Franklin

p5pRT commented 22 years ago

allens@cpan.org - Status changed from 'new' to 'open'

p5pRT commented 22 years ago

From allens@cpan.org

This is related to the 15073 bug in that the fix for that one turned out not to _quite_ fix it for long doubles\, at least on IRIX\, and one of the tests the patch for 15073\, namely 17736\, added is still failing on IRIX with long doubles (namely #48 in t/base/num.t). Given that this is a base test\, no further testing occurs past it\, of course.

This patch has it doing the numbers before and after the decimal point seperately\, so that we aren't winding up\, if there are a huge number of digits after the decimal point being taken into account (which only happens when NV_DIG is large because of using LDBL_DIG instead of DBL_DIG)\, having to first multiply repeatedly to add in the (NV) accumulator when it overflows\, then dividing by a large number to get the correct placement of the decimal point\, all of which introduce massive inaccuracies (especially in odd long double systems like IRIX).

p5pRT commented 22 years ago

allens@cpan.org - Status changed from 'open' to 'resolved'

Perl / perl5