mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
Fix min' and max' handling of NaNs, infinities, and signed zeroes
* libguile/numbers.c (scm_min, scm_max): Properly order the real infinities and NaNs, per R6RS, and also take care to handle signed zeroes properly. Note that this ordering is different than that of `<', `>', `<=', and `>=', which return #f if any argument is a real NaN, and consider the real zeroes to be equal. The relevant real infinity (-inf.0 for min, +inf.0 for max) beats everything, including NaNs, and NaNs beat everything else. Previously these were handled improperly in some cases, e.g.: (min 1/2 +nan.0) now returns +nan.0 (previously returned 0.5), (max 1/2 +nan.0) now returns +nan.0 (previously returned 0.5), (min -inf.0 +nan.0) now returns -inf.0 (previously returned +nan.0), (max +inf.0 +nan.0) now returns +inf.0 (previously returned +nan.0), (min -0.0 0.0) now returns -0.0 (previously returned 0.0), (max 0.0 -0.0) now returns 0.0 (previously returned -0.0), (max 0 -0.0) now returns 0.0 (previously returned -0.0), (max -0.0 0 ) now returns 0.0 (previously returned -0.0). * test-suite/tests/numbers.test (min, max): Add many more test cases relating to NaNs, infinities, and signed zeroes. Change most existing test cases to use `eqv?' instead of `=', in order to check exactness.
This commit is contained in:
Mark H Weaver
Andy Wingo
parent
09cb3ae237
commit
2e2743113a
2 changed files with 237 additions and 74 deletions
|
|
@ -498,6 +498,14 @@ scm_i_fraction2double (SCM z)
|
||||||
SCM_FRACTION_DENOMINATOR (z)));
|
SCM_FRACTION_DENOMINATOR (z)));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int
|
||||||
|
double_is_non_negative_zero (double x)
|
||||||
|
{
|
||||||
|
static double zero = 0.0;
|
||||||
|
|
||||||
|
return !memcmp (&x, &zero, sizeof(double));
|
||||||
|
}
|
||||||
|
|
||||||
SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
|
SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
|
||||||
(SCM x),
|
(SCM x),
|
||||||
"Return @code{#t} if @var{x} is an exact number, @code{#f}\n"
|
"Return @code{#t} if @var{x} is an exact number, @code{#f}\n"
|
||||||
|
|
@ -5148,9 +5156,19 @@ scm_max (SCM x, SCM y)
|
||||||
}
|
}
|
||||||
else if (SCM_REALP (y))
|
else if (SCM_REALP (y))
|
||||||
{
|
{
|
||||||
double z = xx;
|
double xxd = xx;
|
||||||
/* if y==NaN then ">" is false and we return NaN */
|
double yyd = SCM_REAL_VALUE (y);
|
||||||
return (z > SCM_REAL_VALUE (y)) ? scm_from_double (z) : y;
|
|
||||||
|
if (xxd > yyd)
|
||||||
|
return scm_from_double (xxd);
|
||||||
|
/* If y is a NaN, then "==" is false and we return the NaN */
|
||||||
|
else if (SCM_LIKELY (!(xxd == yyd)))
|
||||||
|
return y;
|
||||||
|
/* Handle signed zeroes properly */
|
||||||
|
else if (xx == 0)
|
||||||
|
return flo0;
|
||||||
|
else
|
||||||
|
return y;
|
||||||
}
|
}
|
||||||
else if (SCM_FRACTIONP (y))
|
else if (SCM_FRACTIONP (y))
|
||||||
{
|
{
|
||||||
|
|
@ -5194,9 +5212,20 @@ scm_max (SCM x, SCM y)
|
||||||
{
|
{
|
||||||
if (SCM_I_INUMP (y))
|
if (SCM_I_INUMP (y))
|
||||||
{
|
{
|
||||||
double z = SCM_I_INUM (y);
|
scm_t_inum yy = SCM_I_INUM (y);
|
||||||
/* if x==NaN then "<" is false and we return NaN */
|
double xxd = SCM_REAL_VALUE (x);
|
||||||
return (SCM_REAL_VALUE (x) < z) ? scm_from_double (z) : x;
|
double yyd = yy;
|
||||||
|
|
||||||
|
if (yyd > xxd)
|
||||||
|
return scm_from_double (yyd);
|
||||||
|
/* If x is a NaN, then "==" is false and we return the NaN */
|
||||||
|
else if (SCM_LIKELY (!(xxd == yyd)))
|
||||||
|
return x;
|
||||||
|
/* Handle signed zeroes properly */
|
||||||
|
else if (yy == 0)
|
||||||
|
return flo0;
|
||||||
|
else
|
||||||
|
return x;
|
||||||
}
|
}
|
||||||
else if (SCM_BIGP (y))
|
else if (SCM_BIGP (y))
|
||||||
{
|
{
|
||||||
|
|
@ -5205,12 +5234,25 @@ scm_max (SCM x, SCM y)
|
||||||
}
|
}
|
||||||
else if (SCM_REALP (y))
|
else if (SCM_REALP (y))
|
||||||
{
|
{
|
||||||
/* if x==NaN then our explicit check means we return NaN
|
|
||||||
if y==NaN then ">" is false and we return NaN
|
|
||||||
calling isnan is unavoidable, since it's the only way to know
|
|
||||||
which of x or y causes any compares to be false */
|
|
||||||
double xx = SCM_REAL_VALUE (x);
|
double xx = SCM_REAL_VALUE (x);
|
||||||
return (isnan (xx) || xx > SCM_REAL_VALUE (y)) ? x : y;
|
double yy = SCM_REAL_VALUE (y);
|
||||||
|
|
||||||
|
/* For purposes of max: +inf.0 > nan > everything else, per R6RS */
|
||||||
|
if (xx > yy)
|
||||||
|
return x;
|
||||||
|
else if (SCM_LIKELY (xx < yy))
|
||||||
|
return y;
|
||||||
|
/* If neither (xx > yy) nor (xx < yy), then
|
||||||
|
either they're equal or one is a NaN */
|
||||||
|
else if (SCM_UNLIKELY (isnan (xx)))
|
||||||
|
return (isinf (yy) == 1) ? y : x;
|
||||||
|
else if (SCM_UNLIKELY (isnan (yy)))
|
||||||
|
return (isinf (xx) == 1) ? x : y;
|
||||||
|
/* xx == yy, but handle signed zeroes properly */
|
||||||
|
else if (double_is_non_negative_zero (yy))
|
||||||
|
return y;
|
||||||
|
else
|
||||||
|
return x;
|
||||||
}
|
}
|
||||||
else if (SCM_FRACTIONP (y))
|
else if (SCM_FRACTIONP (y))
|
||||||
{
|
{
|
||||||
|
|
@ -5234,7 +5276,8 @@ scm_max (SCM x, SCM y)
|
||||||
else if (SCM_REALP (y))
|
else if (SCM_REALP (y))
|
||||||
{
|
{
|
||||||
double xx = scm_i_fraction2double (x);
|
double xx = scm_i_fraction2double (x);
|
||||||
return (xx < SCM_REAL_VALUE (y)) ? y : scm_from_double (xx);
|
/* if y==NaN then ">" is false, so we return the NaN y */
|
||||||
|
return (xx > SCM_REAL_VALUE (y)) ? scm_from_double (xx) : y;
|
||||||
}
|
}
|
||||||
else if (SCM_FRACTIONP (y))
|
else if (SCM_FRACTIONP (y))
|
||||||
{
|
{
|
||||||
|
|
@ -5351,12 +5394,25 @@ scm_min (SCM x, SCM y)
|
||||||
}
|
}
|
||||||
else if (SCM_REALP (y))
|
else if (SCM_REALP (y))
|
||||||
{
|
{
|
||||||
/* if x==NaN then our explicit check means we return NaN
|
|
||||||
if y==NaN then "<" is false and we return NaN
|
|
||||||
calling isnan is unavoidable, since it's the only way to know
|
|
||||||
which of x or y causes any compares to be false */
|
|
||||||
double xx = SCM_REAL_VALUE (x);
|
double xx = SCM_REAL_VALUE (x);
|
||||||
return (isnan (xx) || xx < SCM_REAL_VALUE (y)) ? x : y;
|
double yy = SCM_REAL_VALUE (y);
|
||||||
|
|
||||||
|
/* For purposes of min: -inf.0 < nan < everything else, per R6RS */
|
||||||
|
if (xx < yy)
|
||||||
|
return x;
|
||||||
|
else if (SCM_LIKELY (xx > yy))
|
||||||
|
return y;
|
||||||
|
/* If neither (xx < yy) nor (xx > yy), then
|
||||||
|
either they're equal or one is a NaN */
|
||||||
|
else if (SCM_UNLIKELY (isnan (xx)))
|
||||||
|
return (isinf (yy) == -1) ? y : x;
|
||||||
|
else if (SCM_UNLIKELY (isnan (yy)))
|
||||||
|
return (isinf (xx) == -1) ? x : y;
|
||||||
|
/* xx == yy, but handle signed zeroes properly */
|
||||||
|
else if (double_is_non_negative_zero (xx))
|
||||||
|
return y;
|
||||||
|
else
|
||||||
|
return x;
|
||||||
}
|
}
|
||||||
else if (SCM_FRACTIONP (y))
|
else if (SCM_FRACTIONP (y))
|
||||||
{
|
{
|
||||||
|
|
@ -5380,7 +5436,8 @@ scm_min (SCM x, SCM y)
|
||||||
else if (SCM_REALP (y))
|
else if (SCM_REALP (y))
|
||||||
{
|
{
|
||||||
double xx = scm_i_fraction2double (x);
|
double xx = scm_i_fraction2double (x);
|
||||||
return (SCM_REAL_VALUE (y) < xx) ? y : scm_from_double (xx);
|
/* if y==NaN then "<" is false, so we return the NaN y */
|
||||||
|
return (xx < SCM_REAL_VALUE (y)) ? scm_from_double (xx) : y;
|
||||||
}
|
}
|
||||||
else if (SCM_FRACTIONP (y))
|
else if (SCM_FRACTIONP (y))
|
||||||
{
|
{
|
||||||
|
|
|
||||||
|
|
@ -2471,26 +2471,79 @@
|
||||||
(big*5 (* fixnum-max 5)))
|
(big*5 (* fixnum-max 5)))
|
||||||
|
|
||||||
(with-test-prefix "inum / frac"
|
(with-test-prefix "inum / frac"
|
||||||
(pass-if (= 3 (max 3 5/2)))
|
(pass-if (eqv? 3 (max 3 5/2)))
|
||||||
(pass-if (= 5/2 (max 2 5/2))))
|
(pass-if (eqv? 5/2 (max 2 5/2))))
|
||||||
|
|
||||||
(with-test-prefix "frac / inum"
|
(with-test-prefix "frac / inum"
|
||||||
(pass-if (= 3 (max 5/2 3)))
|
(pass-if (eqv? 3 (max 5/2 3)))
|
||||||
(pass-if (= 5/2 (max 5/2 2))))
|
(pass-if (eqv? 5/2 (max 5/2 2))))
|
||||||
|
|
||||||
(with-test-prefix "inum / real"
|
(with-test-prefix "infinities and NaNs"
|
||||||
(pass-if (real-nan? (max 123 +nan.0))))
|
;; +inf.0 beats everything else, including NaNs
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 123 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max 123 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 -123.3 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max -123.3 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 -7/2 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max -7/2 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 -1e20 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max -1e20 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 (- big*2))))
|
||||||
|
(pass-if (eqv? +inf.0 (max (- big*2) +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 +nan.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +nan.0 +inf.0 )))
|
||||||
|
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
|
||||||
|
|
||||||
(with-test-prefix "real / inum"
|
;; NaNs beat everything except +inf.0
|
||||||
(pass-if (real-nan? (max +nan.0 123))))
|
(pass-if (real-nan? (max +nan.0 123 )))
|
||||||
|
(pass-if (real-nan? (max 123 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 123.3 )))
|
||||||
|
(pass-if (real-nan? (max 123.3 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 -7/2 )))
|
||||||
|
(pass-if (real-nan? (max -7/2 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 -1e20 )))
|
||||||
|
(pass-if (real-nan? (max -1e20 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 (- big*2))))
|
||||||
|
(pass-if (real-nan? (max (- big*2) +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 -inf.0 )))
|
||||||
|
(pass-if (real-nan? (max -inf.0 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (max +nan.0 +nan.0 )))
|
||||||
|
|
||||||
|
;; -inf.0 always loses, except against itself
|
||||||
|
(pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
|
||||||
|
(pass-if (eqv? -123.0 (max -inf.0 -123 )))
|
||||||
|
(pass-if (eqv? -123.0 (max -123 -inf.0 )))
|
||||||
|
(pass-if (eqv? -123.3 (max -inf.0 -123.3 )))
|
||||||
|
(pass-if (eqv? -123.3 (max -123.3 -inf.0 )))
|
||||||
|
(pass-if (eqv? -3.5 (max -inf.0 -7/2 )))
|
||||||
|
(pass-if (eqv? -3.5 (max -7/2 -inf.0 )))
|
||||||
|
(pass-if (eqv? -1.0e20 (max -inf.0 -1e20 )))
|
||||||
|
(pass-if (eqv? -1.0e20 (max -1e20 -inf.0 )))
|
||||||
|
(pass-if (eqv? (exact->inexact (- big*2))
|
||||||
|
(max -inf.0 (- big*2))))
|
||||||
|
(pass-if (eqv? (exact->inexact (- big*2))
|
||||||
|
(max (- big*2) -inf.0 ))))
|
||||||
|
|
||||||
|
(with-test-prefix "signed zeroes"
|
||||||
|
(pass-if (eqv? 0.0 (max 0.0 0.0)))
|
||||||
|
(pass-if (eqv? 0.0 (max 0.0 -0.0)))
|
||||||
|
(pass-if (eqv? 0.0 (max -0.0 0.0)))
|
||||||
|
(pass-if (eqv? -0.0 (max -0.0 -0.0)))
|
||||||
|
(pass-if (eqv? 0.0 (max -0.0 0 )))
|
||||||
|
(pass-if (eqv? 0.0 (max 0.0 0 )))
|
||||||
|
(pass-if (eqv? 0.0 (max 0 -0.0)))
|
||||||
|
(pass-if (eqv? 0.0 (max 0 0.0)))
|
||||||
|
(pass-if (eqv? 0 (min 0 0 ))))
|
||||||
|
|
||||||
(with-test-prefix "big / frac"
|
(with-test-prefix "big / frac"
|
||||||
(pass-if (= big*2 (max big*2 5/2)))
|
(pass-if (eqv? big*2 (max big*2 5/2)))
|
||||||
(pass-if (= 5/2 (max (- big*2) 5/2))))
|
(pass-if (eqv? 5/2 (max (- big*2) 5/2))))
|
||||||
|
|
||||||
(with-test-prefix "frac / big"
|
(with-test-prefix "frac / big"
|
||||||
(pass-if (= big*2 (max 5/2 big*2)))
|
(pass-if (eqv? big*2 (max 5/2 big*2)))
|
||||||
(pass-if (= 5/2 (max 5/2 (- big*2)))))
|
(pass-if (eqv? 5/2 (max 5/2 (- big*2)))))
|
||||||
|
|
||||||
(with-test-prefix "big / real"
|
(with-test-prefix "big / real"
|
||||||
(pass-if (real-nan? (max big*5 +nan.0)))
|
(pass-if (real-nan? (max big*5 +nan.0)))
|
||||||
|
|
@ -2507,29 +2560,29 @@
|
||||||
(pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
|
(pass-if (eqv? 1.0 (max 1.0 (- big*5)))))
|
||||||
|
|
||||||
(with-test-prefix "frac / frac"
|
(with-test-prefix "frac / frac"
|
||||||
(pass-if (= 2/3 (max 1/2 2/3)))
|
(pass-if (eqv? 2/3 (max 1/2 2/3)))
|
||||||
(pass-if (= 2/3 (max 2/3 1/2)))
|
(pass-if (eqv? 2/3 (max 2/3 1/2)))
|
||||||
(pass-if (= -1/2 (max -1/2 -2/3)))
|
(pass-if (eqv? -1/2 (max -1/2 -2/3)))
|
||||||
(pass-if (= -1/2 (max -2/3 -1/2))))
|
(pass-if (eqv? -1/2 (max -2/3 -1/2))))
|
||||||
|
|
||||||
(with-test-prefix "real / real"
|
(with-test-prefix "real / real"
|
||||||
(pass-if (real-nan? (max 123.0 +nan.0)))
|
(pass-if (real-nan? (max 123.0 +nan.0)))
|
||||||
(pass-if (real-nan? (max +nan.0 123.0)))
|
(pass-if (real-nan? (max +nan.0 123.0)))
|
||||||
(pass-if (real-nan? (max +nan.0 +nan.0)))
|
(pass-if (real-nan? (max +nan.0 +nan.0)))
|
||||||
(pass-if (= 456.0 (max 123.0 456.0)))
|
(pass-if (eqv? 456.0 (max 123.0 456.0)))
|
||||||
(pass-if (= 456.0 (max 456.0 123.0)))))
|
(pass-if (eqv? 456.0 (max 456.0 123.0)))))
|
||||||
|
|
||||||
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
|
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
|
||||||
;; sure we've avoided that
|
;; sure we've avoided that
|
||||||
(for-each (lambda (b)
|
(for-each (lambda (b)
|
||||||
(pass-if (list b +inf.0)
|
(pass-if (list b +inf.0)
|
||||||
(= +inf.0 (max b +inf.0)))
|
(eqv? +inf.0 (max b +inf.0)))
|
||||||
(pass-if (list +inf.0 b)
|
(pass-if (list +inf.0 b)
|
||||||
(= +inf.0 (max b +inf.0)))
|
(eqv? +inf.0 (max b +inf.0)))
|
||||||
(pass-if (list b -inf.0)
|
(pass-if (list b -inf.0)
|
||||||
(= (exact->inexact b) (max b -inf.0)))
|
(eqv? (exact->inexact b) (max b -inf.0)))
|
||||||
(pass-if (list -inf.0 b)
|
(pass-if (list -inf.0 b)
|
||||||
(= (exact->inexact b) (max b -inf.0))))
|
(eqv? (exact->inexact b) (max b -inf.0))))
|
||||||
(list (1- (ash 1 1024))
|
(list (1- (ash 1 1024))
|
||||||
(ash 1 1024)
|
(ash 1 1024)
|
||||||
(1+ (ash 1 1024))
|
(1+ (ash 1 1024))
|
||||||
|
|
@ -2579,43 +2632,96 @@
|
||||||
(big*5 (* fixnum-max 5)))
|
(big*5 (* fixnum-max 5)))
|
||||||
|
|
||||||
(pass-if (documented? min))
|
(pass-if (documented? min))
|
||||||
(pass-if (= 1 (min 7 3 1 5)))
|
(pass-if (eqv? 1 (min 7 3 1 5)))
|
||||||
(pass-if (= 1 (min 1 7 3 5)))
|
(pass-if (eqv? 1 (min 1 7 3 5)))
|
||||||
(pass-if (= 1 (min 7 3 5 1)))
|
(pass-if (eqv? 1 (min 7 3 5 1)))
|
||||||
(pass-if (= -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
|
(pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2)))
|
||||||
(pass-if (= -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
|
(pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2)))
|
||||||
(pass-if (= -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
|
(pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7)))
|
||||||
(pass-if (= big*2 (min big*3 big*5 big*2 big*4)))
|
(pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4)))
|
||||||
(pass-if (= big*2 (min big*2 big*3 big*5 big*4)))
|
(pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4)))
|
||||||
(pass-if (= big*2 (min big*3 big*5 big*4 big*2)))
|
(pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2)))
|
||||||
(pass-if
|
(pass-if
|
||||||
(= (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
|
(eqv? (- fixnum-min 1) (min 2 4 (- fixnum-min 1) 3 (* 2 fixnum-max))))
|
||||||
(pass-if
|
(pass-if
|
||||||
(= (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
|
(eqv? (- fixnum-min 1) (min (- fixnum-min 1) 2 4 3 (* 2 fixnum-max))))
|
||||||
(pass-if
|
(pass-if
|
||||||
(= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
|
(eqv? (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
|
||||||
|
|
||||||
(with-test-prefix "inum / frac"
|
(with-test-prefix "inum / frac"
|
||||||
(pass-if (= 5/2 (min 3 5/2)))
|
(pass-if (eqv? 5/2 (min 3 5/2)))
|
||||||
(pass-if (= 2 (min 2 5/2))))
|
(pass-if (eqv? 2 (min 2 5/2))))
|
||||||
|
|
||||||
(with-test-prefix "frac / inum"
|
(with-test-prefix "frac / inum"
|
||||||
(pass-if (= 5/2 (min 5/2 3)))
|
(pass-if (eqv? 5/2 (min 5/2 3)))
|
||||||
(pass-if (= 2 (min 5/2 2))))
|
(pass-if (eqv? 2 (min 5/2 2))))
|
||||||
|
|
||||||
(with-test-prefix "inum / real"
|
(with-test-prefix "infinities and NaNs"
|
||||||
(pass-if (real-nan? (min 123 +nan.0))))
|
;; -inf.0 beats everything else, including NaNs
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 123 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min 123 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 -123.3 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -123.3 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 -7/2 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -7/2 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 -1e20 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -1e20 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 (- big*2))))
|
||||||
|
(pass-if (eqv? -inf.0 (min (- big*2) -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 +inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min +inf.0 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 +nan.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min +nan.0 -inf.0 )))
|
||||||
|
(pass-if (eqv? -inf.0 (min -inf.0 -inf.0 )))
|
||||||
|
|
||||||
(with-test-prefix "real / inum"
|
;; NaNs beat everything except -inf.0
|
||||||
(pass-if (real-nan? (min +nan.0 123))))
|
(pass-if (real-nan? (min +nan.0 123 )))
|
||||||
|
(pass-if (real-nan? (min 123 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 123.3 )))
|
||||||
|
(pass-if (real-nan? (min 123.3 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 -7/2 )))
|
||||||
|
(pass-if (real-nan? (min -7/2 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 -1e20 )))
|
||||||
|
(pass-if (real-nan? (min -1e20 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 (- big*2))))
|
||||||
|
(pass-if (real-nan? (min (- big*2) +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 +inf.0 )))
|
||||||
|
(pass-if (real-nan? (min +inf.0 +nan.0 )))
|
||||||
|
(pass-if (real-nan? (min +nan.0 +nan.0 )))
|
||||||
|
|
||||||
|
;; +inf.0 always loses, except against itself
|
||||||
|
(pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))
|
||||||
|
(pass-if (eqv? -123.0 (min +inf.0 -123 )))
|
||||||
|
(pass-if (eqv? -123.0 (min -123 +inf.0 )))
|
||||||
|
(pass-if (eqv? -123.3 (min +inf.0 -123.3 )))
|
||||||
|
(pass-if (eqv? -123.3 (min -123.3 +inf.0 )))
|
||||||
|
(pass-if (eqv? -3.5 (min +inf.0 -7/2 )))
|
||||||
|
(pass-if (eqv? -3.5 (min -7/2 +inf.0 )))
|
||||||
|
(pass-if (eqv? -1.0e20 (min +inf.0 -1e20 )))
|
||||||
|
(pass-if (eqv? -1.0e20 (min -1e20 +inf.0 )))
|
||||||
|
(pass-if (eqv? (exact->inexact (- big*2))
|
||||||
|
(min +inf.0 (- big*2))))
|
||||||
|
(pass-if (eqv? (exact->inexact (- big*2))
|
||||||
|
(min (- big*2) +inf.0 ))))
|
||||||
|
|
||||||
|
(with-test-prefix "signed zeroes"
|
||||||
|
(pass-if (eqv? 0.0 (min 0.0 0.0)))
|
||||||
|
(pass-if (eqv? -0.0 (min 0.0 -0.0)))
|
||||||
|
(pass-if (eqv? -0.0 (min -0.0 0.0)))
|
||||||
|
(pass-if (eqv? -0.0 (min -0.0 -0.0)))
|
||||||
|
(pass-if (eqv? -0.0 (min -0.0 0 )))
|
||||||
|
(pass-if (eqv? 0.0 (min 0.0 0 )))
|
||||||
|
(pass-if (eqv? -0.0 (min 0 -0.0)))
|
||||||
|
(pass-if (eqv? 0.0 (min 0 0.0)))
|
||||||
|
(pass-if (eqv? 0 (min 0 0 ))))
|
||||||
|
|
||||||
(with-test-prefix "big / frac"
|
(with-test-prefix "big / frac"
|
||||||
(pass-if (= 5/2 (min big*2 5/2)))
|
(pass-if (eqv? 5/2 (min big*2 5/2)))
|
||||||
(pass-if (= (- big*2) (min (- big*2) 5/2))))
|
(pass-if (eqv? (- big*2) (min (- big*2) 5/2))))
|
||||||
|
|
||||||
(with-test-prefix "frac / big"
|
(with-test-prefix "frac / big"
|
||||||
(pass-if (= 5/2 (min 5/2 big*2)))
|
(pass-if (eqv? 5/2 (min 5/2 big*2)))
|
||||||
(pass-if (= (- big*2) (min 5/2 (- big*2)))))
|
(pass-if (eqv? (- big*2) (min 5/2 (- big*2)))))
|
||||||
|
|
||||||
(with-test-prefix "big / real"
|
(with-test-prefix "big / real"
|
||||||
(pass-if (real-nan? (min big*5 +nan.0)))
|
(pass-if (real-nan? (min big*5 +nan.0)))
|
||||||
|
|
@ -2632,30 +2738,30 @@
|
||||||
(pass-if (eqv? (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
|
(pass-if (eqv? (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
|
||||||
|
|
||||||
(with-test-prefix "frac / frac"
|
(with-test-prefix "frac / frac"
|
||||||
(pass-if (= 1/2 (min 1/2 2/3)))
|
(pass-if (eqv? 1/2 (min 1/2 2/3)))
|
||||||
(pass-if (= 1/2 (min 2/3 1/2)))
|
(pass-if (eqv? 1/2 (min 2/3 1/2)))
|
||||||
(pass-if (= -2/3 (min -1/2 -2/3)))
|
(pass-if (eqv? -2/3 (min -1/2 -2/3)))
|
||||||
(pass-if (= -2/3 (min -2/3 -1/2))))
|
(pass-if (eqv? -2/3 (min -2/3 -1/2))))
|
||||||
|
|
||||||
(with-test-prefix "real / real"
|
(with-test-prefix "real / real"
|
||||||
(pass-if (real-nan? (min 123.0 +nan.0)))
|
(pass-if (real-nan? (min 123.0 +nan.0)))
|
||||||
(pass-if (real-nan? (min +nan.0 123.0)))
|
(pass-if (real-nan? (min +nan.0 123.0)))
|
||||||
(pass-if (real-nan? (min +nan.0 +nan.0)))
|
(pass-if (real-nan? (min +nan.0 +nan.0)))
|
||||||
(pass-if (= 123.0 (min 123.0 456.0)))
|
(pass-if (eqv? 123.0 (min 123.0 456.0)))
|
||||||
(pass-if (= 123.0 (min 456.0 123.0)))))
|
(pass-if (eqv? 123.0 (min 456.0 123.0)))))
|
||||||
|
|
||||||
|
|
||||||
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
|
;; in gmp prior to 4.2, mpz_cmp_d ended up treating Inf as 2^1024, make
|
||||||
;; sure we've avoided that
|
;; sure we've avoided that
|
||||||
(for-each (lambda (b)
|
(for-each (lambda (b)
|
||||||
(pass-if (list b +inf.0)
|
(pass-if (list b +inf.0)
|
||||||
(= (exact->inexact b) (min b +inf.0)))
|
(eqv? (exact->inexact b) (min b +inf.0)))
|
||||||
(pass-if (list +inf.0 b)
|
(pass-if (list +inf.0 b)
|
||||||
(= (exact->inexact b) (min b +inf.0)))
|
(eqv? (exact->inexact b) (min b +inf.0)))
|
||||||
(pass-if (list b -inf.0)
|
(pass-if (list b -inf.0)
|
||||||
(= -inf.0 (min b -inf.0)))
|
(eqv? -inf.0 (min b -inf.0)))
|
||||||
(pass-if (list -inf.0 b)
|
(pass-if (list -inf.0 b)
|
||||||
(= -inf.0 (min b -inf.0))))
|
(eqv? -inf.0 (min b -inf.0))))
|
||||||
(list (1- (ash 1 1024))
|
(list (1- (ash 1 1024))
|
||||||
(ash 1 1024)
|
(ash 1 1024)
|
||||||
(1+ (ash 1 1024))
|
(1+ (ash 1 1024))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue