mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00
Code Activity

min and max: NaNs beat infinities, per R6RS errata.

Browse source 
Fixes <http://bugs.gnu.org/14865>.
Reported by Göran Weinholt <goran@weinholt.se>.

* libguile/numbers.c (scm_min, scm_max): NaNs beat infinities, as per
  the R6RS errata.

* test-suite/tests/numbers.test (min, max): Update tests.
This commit is contained in:
Mark H Weaver 2013-07-16 05:18:15 -04:00
parent ad922d065c
commit b4c55c9cce
2 changed files with 16 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

18
libguile/numbers.c
View file

@ -7219,17 +7219,16 @@ scm_max (SCM x, SCM y)
double xx = SCM_REAL_VALUE (x); double xx = SCM_REAL_VALUE (x);
double yy = SCM_REAL_VALUE (y); double yy = SCM_REAL_VALUE (y);
/* For purposes of max: +inf.0 > nan > everything else, per R6RS */ /* For purposes of max: nan > +inf.0 > everything else,
per the R6RS errata */
if (xx > yy) if (xx > yy)
return x; return x;
else if (SCM_LIKELY (xx < yy)) else if (SCM_LIKELY (xx < yy))
return y; return y;
/* If neither (xx > yy) nor (xx < yy), then /* If neither (xx > yy) nor (xx < yy), then
either they're equal or one is a NaN */ either they're equal or one is a NaN */
else if (SCM_UNLIKELY (isnan (xx))) else if (SCM_UNLIKELY (xx != yy))
return DOUBLE_IS_POSITIVE_INFINITY (yy) ? y : x; return (xx != xx) ? x : y; /* Return the NaN */
else if (SCM_UNLIKELY (isnan (yy)))
return DOUBLE_IS_POSITIVE_INFINITY (xx) ? x : y;
/* xx == yy, but handle signed zeroes properly */ /* xx == yy, but handle signed zeroes properly */
else if (double_is_non_negative_zero (yy)) else if (double_is_non_negative_zero (yy))
return y; return y;
@ -7379,17 +7378,16 @@ scm_min (SCM x, SCM y)
double xx = SCM_REAL_VALUE (x); double xx = SCM_REAL_VALUE (x);
double yy = SCM_REAL_VALUE (y); double yy = SCM_REAL_VALUE (y);
/* For purposes of min: -inf.0 < nan < everything else, per R6RS */ /* For purposes of min: nan < -inf.0 < everything else,
per the R6RS errata */
if (xx < yy) if (xx < yy)
return x; return x;
else if (SCM_LIKELY (xx > yy)) else if (SCM_LIKELY (xx > yy))
return y; return y;
/* If neither (xx < yy) nor (xx > yy), then /* If neither (xx < yy) nor (xx > yy), then
either they're equal or one is a NaN */ either they're equal or one is a NaN */
else if (SCM_UNLIKELY (isnan (xx))) else if (SCM_UNLIKELY (xx != yy))
return DOUBLE_IS_NEGATIVE_INFINITY (yy) ? y : x; return (xx != xx) ? x : y; /* Return the NaN */
else if (SCM_UNLIKELY (isnan (yy)))
return DOUBLE_IS_NEGATIVE_INFINITY (xx) ? x : y;
/* xx == yy, but handle signed zeroes properly */ /* xx == yy, but handle signed zeroes properly */
else if (double_is_non_negative_zero (xx)) else if (double_is_non_negative_zero (xx))
return y; return y;

16
test-suite/tests/numbers.test
View file

@ -2690,7 +2690,7 @@
(pass-if (eqv? 5/2 (max 5/2 2)))) (pass-if (eqv? 5/2 (max 5/2 2))))
(with-test-prefix "infinities and NaNs" (with-test-prefix "infinities and NaNs"
;; +inf.0 beats everything else, including NaNs ;; +inf.0 beats everything except NaNs
(pass-if (eqv? +inf.0 (max +inf.0 123 ))) (pass-if (eqv? +inf.0 (max +inf.0 123 )))
(pass-if (eqv? +inf.0 (max 123 +inf.0 ))) (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 +inf.0 -123.3 )))
@ -2703,11 +2703,9 @@
(pass-if (eqv? +inf.0 (max (- big*2) +inf.0 ))) (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 +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 ))) (pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
;; NaNs beat everything except +inf.0 ;; NaNs beat everything
(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 123 +nan.0 )))
(pass-if (real-nan? (max +nan.0 123.3 ))) (pass-if (real-nan? (max +nan.0 123.3 )))
@ -2721,6 +2719,8 @@
(pass-if (real-nan? (max +nan.0 -inf.0 ))) (pass-if (real-nan? (max +nan.0 -inf.0 )))
(pass-if (real-nan? (max -inf.0 +nan.0 ))) (pass-if (real-nan? (max -inf.0 +nan.0 )))
(pass-if (real-nan? (max +nan.0 +nan.0 ))) (pass-if (real-nan? (max +nan.0 +nan.0 )))
(pass-if (real-nan? (max +inf.0 +nan.0 )))
(pass-if (real-nan? (max +nan.0 +inf.0 )))
;; -inf.0 always loses, except against itself ;; -inf.0 always loses, except against itself
(pass-if (eqv? -inf.0 (max -inf.0 -inf.0 ))) (pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
@ -2868,7 +2868,7 @@
(pass-if (eqv? 2 (min 5/2 2)))) (pass-if (eqv? 2 (min 5/2 2))))
(with-test-prefix "infinities and NaNs" (with-test-prefix "infinities and NaNs"
;; -inf.0 beats everything else, including NaNs ;; -inf.0 beats everything except NaNs
(pass-if (eqv? -inf.0 (min -inf.0 123 ))) (pass-if (eqv? -inf.0 (min -inf.0 123 )))
(pass-if (eqv? -inf.0 (min 123 -inf.0 ))) (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 -inf.0 -123.3 )))
@ -2881,11 +2881,9 @@
(pass-if (eqv? -inf.0 (min (- big*2) -inf.0 ))) (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 -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 ))) (pass-if (eqv? -inf.0 (min -inf.0 -inf.0 )))
;; NaNs beat everything except -inf.0 ;; NaNs beat everything
(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 123 +nan.0 )))
(pass-if (real-nan? (min +nan.0 123.3 ))) (pass-if (real-nan? (min +nan.0 123.3 )))
@ -2899,6 +2897,8 @@
(pass-if (real-nan? (min +nan.0 +inf.0 ))) (pass-if (real-nan? (min +nan.0 +inf.0 )))
(pass-if (real-nan? (min +inf.0 +nan.0 ))) (pass-if (real-nan? (min +inf.0 +nan.0 )))
(pass-if (real-nan? (min +nan.0 +nan.0 ))) (pass-if (real-nan? (min +nan.0 +nan.0 )))
(pass-if (real-nan? (min -inf.0 +nan.0 )))
(pass-if (real-nan? (min +nan.0 -inf.0 )))
;; +inf.0 always loses, except against itself ;; +inf.0 always loses, except against itself
(pass-if (eqv? +inf.0 (min +inf.0 +inf.0 ))) (pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))