# 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 <easmith@beatrice.rutgers.edu>
+# -- Allen Smith <allens@cpan.org>
case "$use64bitall" in
$define|true|[yY]*)
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.
*"cc -64"*)
case "`uname -s`" in
IRIX)
- cat >&4 <<EOM
+ $cat >&4 <<EOM
You cannot use cc -64 or -Duse64bitall in 32-bit IRIX, sorry.
Cannot continue, aborting.
EOM
-# What is space=ON doing in here? - Allen
+# XXX What is space=ON doing in here? Could someone ask Scott Henry? - Allen
*7.*) # Mongoose 7.2.1+
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff"
optimize='none'
;;
*) # Be safe and not optimize
- ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff -OPT:Olimit=0"
+ ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff $woff"
optimize='none'
;;
esac
# I have conflicting reports about the sun, crypt, bsd, and PW
# libraries on Irix 6.2.
#
-# One user rerports:
+# One user reports:
# Don't need sun crypt bsd PW under 6.2. You *may* need to link
# with these if you want to run perl built under 6.2 on a 5.3 machine
# (I haven't checked)
i_sysmode="$undef"
-cat > 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
# 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.
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.
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]*)
+
+case "$d_PRIfldbl" in
+$define|true|[yY]*)
+
+ echo " " >try.c
+ $cat >>try.c <<EOP
+#include <stdio.h>
+
+#define sPRIfldbl $sPRIfldbl
+
+#define I_STDLIB $i_stdlib
+#ifdef I_STDLIB
+#include <stdlib.h>
+#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.* >/dev/null
+ else
+ rm -f try try.* core a.out >/dev/null
+ ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG"
+ cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG"
+
+ echo " " >try.c
+ $cat >>try.c <<EOP
+#include <stdio.h>
+
+#define sPRIfldbl $sPRIfldbl
+
+#define I_STDLIB $i_stdlib
+#ifdef I_STDLIB
+#include <stdlib.h>
+#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
+ fi
+;;
+*) # Can't tell!
+ ccflags="$ccflags -DHAS_LDBL_SPRINTF_BUG"
+ cppflags="$cppflags -DHAS_LDBL_SPRINTF_BUG"
+ ;;
+esac
+
+# end of case statement for how to print ldbl with 'f'
+;;
+*) ;;
+esac
+
+# end of case statement for whether to do long doubles
+
+EOCBU
+
# Helmut Jarausch reports that Perl's malloc is rather unusable
# with IRIX, and SGI confirms the problem.
usemymalloc=${usemymalloc:-false}
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
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
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... */
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;
}
}
- 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;
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;
}
# 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 <allens@cpan.org>
+ */
+
+#if defined(I_VALUES)
+# if !defined(USE_LONG_DOUBLE) || defined(HAS_LDBL_SPRINTF_BUG)
+# if (!defined(DBL_MIN) || !defined(DBL_MAX))
+# include <values.h>
+# 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
# 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
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 <easmith@beatrice.rutgers.edu> */
+ bool fix_ldbl_sprintf_bug = FALSE;
+#endif
char esignbuf[4];
U8 utf8buf[UTF8_MAXLEN+1];
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 <easmith@beatrice.rutgers.edu> */
+ 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) {
Safefree(PL_efloatbuf);
#!./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.)
$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";
>%#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 <
>%.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<
projects / p5sagit/p5-mst-13.2.git / commitdiff