From: Allen Smith Date: Mon, 9 Sep 2002 01:48:08 +0000 (-0400) Subject: Re: [PATCH: perl #17849] (corrected) Long double bugs - sprintf.t _and_ num.t X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=205f51d8e6c484299677945023b990c3cad50d1e;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH: perl #17849] (corrected) Long double bugs - sprintf.t _and_ num.t From: "Allen Smith" Message-Id: <10209090148.ZM1555835@puck2.rutgers.edu> p4raw-id: //depot/perl@17881 --- diff --git a/perl.h b/perl.h index f37ec83..28e3f58 100644 --- a/perl.h +++ b/perl.h @@ -1130,8 +1130,10 @@ typedef UVTYPE UV; # define DBL_DIG OVR_DBL_DIG #else /* The following is all to get DBL_DIG, in order to pick a nice - default value for printing floating point numbers in Gconvert. - (see config.h) + default value for printing floating point numbers in Gconvert + (see config.h). (It also has other uses, such as figuring out if + a given precision of printing can be done with a double instead of + a long double - Allen). */ #ifdef I_LIMITS #include @@ -1193,20 +1195,22 @@ typedef UVTYPE UV; * 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 +#ifdef I_LIMITS +# include #endif +#ifdef I_VALUES +# if !(defined(DBL_MIN) && defined(DBL_MAX) && defined(I_LIMITS)) +# 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 /* defined(I_VALUES) */ + typedef NVTYPE NV; #ifdef I_IEEEFP @@ -1305,7 +1309,7 @@ long double modfl(long double, long double *); # ifdef DBL_EPSILON # define NV_EPSILON DBL_EPSILON # endif -# ifdef DBL_MAX +# ifdef DBL_MAX /* XXX Does DBL_MAX imply having DBL_MIN? */ # define NV_MAX DBL_MAX # define NV_MIN DBL_MIN # else @@ -1328,6 +1332,13 @@ long double modfl(long double, long double *); /* rumor has it that Win32 has _fpclass() */ +/* SGI has fpclassl... but not with the same result values, + * and it's via a typedef (not via #define), so will need to redo Configure + * to use. Not worth the trouble, IMO, at least until the below is used + * more places. Also has fp_class_l, BTW, via fp_class.h. Feel free to check + * with me for the SGI manpages, SGI testing, etcetera, if you want to + * try getting this to work with IRIX. - Allen */ + #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) # ifdef I_IEEFP # include @@ -1469,7 +1480,8 @@ int isnan(double d); * it is however best to use the native implementation of atof. * You can experiment with using your native one by -DUSE_PERL_ATOF=0. * Some good tests to try out with either setting are t/base/num.t, - * t/op/numconvert.t, and t/op/pack.t. */ + * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles + * you may need to be using a different function than atof! */ #ifndef USE_PERL_ATOF # ifndef _UNICOS @@ -1502,11 +1514,9 @@ int isnan(double d); #ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ # include -#else -#ifdef I_VALUES -# include -#endif #endif +/* Included values.h above if necessary; still including limits.h down here, + * despite doing above, because math.h might have overriden... XXX - Allen */ /* * Try to figure out max and min values for the integral types. THE CORRECT diff --git a/sv.c b/sv.c index aa50429..51a0bb6 100644 --- a/sv.c +++ b/sv.c @@ -7924,7 +7924,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } if (!args && svix < svmax && DO_UTF8(*svargs)) - has_utf8 = TRUE; + has_utf8 = TRUE; patend = (char*)pat + patlen; for (p = (char*)pat; p < patend; p = q) { @@ -7943,10 +7943,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV 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 */ + with sfio - Allen */ bool fix_ldbl_sprintf_bug = FALSE; #endif - + char esignbuf[4]; U8 utf8buf[UTF8_MAXLEN+1]; STRLEN esignlen = 0; @@ -7957,7 +7957,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV * NV_DIG: mantissa takes than many decimal digits. * Plus 32: Playing safe. */ char ebuf[IV_DIG * 4 + NV_DIG + 32]; - /* large enough for "%#.#f" --chip */ + /* large enough for "%#.#f" --chip */ /* what about long double NVs? --jhi */ SV *vecsv = Nullsv; @@ -8166,7 +8166,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV #endif case 'l': #if defined(HAS_QUAD) || defined(HAS_LONG_DOUBLE) - if (*(q + 1) == 'l') { /* lld, llf */ + if (*(q + 1) == 'l') { /* lld, llf */ intsize = 'q'; q += 2; break; @@ -8514,10 +8514,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV nv = (args && !vectorize) ? #if LONG_DOUBLESIZE > DOUBLESIZE intsize == 'q' ? - va_arg(*args, long double) : - va_arg(*args, double) + va_arg(*args, long double) : + va_arg(*args, double) #else - va_arg(*args, double) + va_arg(*args, double) #endif : SvNVx(argsv); @@ -8540,84 +8540,68 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV #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 + with sfio - Allen */ + +# 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 + +# ifdef HAS_LDBL_SPRINTF_BUG_LESS1 /* only between -1L & 1L - Allen */ +# define MY_DBL_MAX_BUG 1L # else -# define MY_DBL_MAX 3.40282347E+38L +# define MY_DBL_MAX_BUG MY_DBL_MAX # 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 -#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) + if ((intsize == 'q') && (c == 'f') && + ((nv < MY_DBL_MAX_BUG) && (nv > -MY_DBL_MAX_BUG)) && + (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; /* 0 is 0 - easiest */ + else { + /* would use Perl_fp_class as a double-check but not + * functional on IRIX - see perl.h comments */ + + if ((nv >= MY_DBL_MIN) || (nv <= -MY_DBL_MIN)) { + /* It's within the range that a double can represent */ +#if defined(DBL_MAX) && !defined(DBL_MIN) + if ((nv >= ((long double)1/DBL_MAX)) || + (nv <= (-(long double)1/DBL_MAX))) #endif - )) { - /* It's within the range that a double can represent */ - fix_ldbl_sprintf_bug = TRUE; + 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; - } + } + if (fix_ldbl_sprintf_bug == TRUE) { + double temp; + + intsize = 0; + temp = (double)nv; + nv = (NV)temp; + } } + +# undef MY_DBL_MAX +# undef MY_DBL_MAX_BUG +# undef MY_DBL_MIN + #endif /* HAS_LDBL_SPRINTF_BUG */ need += 20; /* fudge factor */