>From 5e174213416b97e9446dccac70fd9689106a6fd6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 2 Feb 2011 01:02:49 -0500 Subject: [PATCH] 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. --- libguile/numbers.c | 93 ++++++++++++++---- test-suite/tests/numbers.test | 226 ++++++++++++++++++++++++++++++----------- 2 files changed, 241 insertions(+), 78 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index df95c32..090fb75 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -498,6 +498,14 @@ scm_i_fraction2double (SCM 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 x), "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)) { - double z = xx; - /* if y==NaN then ">" is false and we return NaN */ - return (z > SCM_REAL_VALUE (y)) ? scm_from_double (z) : y; + double xxd = xx; + double yyd = SCM_REAL_VALUE (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)) { @@ -5194,9 +5212,20 @@ scm_max (SCM x, SCM y) { if (SCM_I_INUMP (y)) { - double z = SCM_I_INUM (y); - /* if x==NaN then "<" is false and we return NaN */ - return (SCM_REAL_VALUE (x) < z) ? scm_from_double (z) : x; + scm_t_inum yy = SCM_I_INUM (y); + double xxd = SCM_REAL_VALUE (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)) { @@ -5205,12 +5234,25 @@ scm_max (SCM x, SCM 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); - 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)) { @@ -5234,7 +5276,8 @@ scm_max (SCM x, SCM y) else if (SCM_REALP (y)) { 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)) { @@ -5351,12 +5394,25 @@ scm_min (SCM x, SCM 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); - 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)) { @@ -5380,7 +5436,8 @@ scm_min (SCM x, SCM y) else if (SCM_REALP (y)) { 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)) { diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 9c01fa1..28db652 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -2471,26 +2471,79 @@ (big*5 (* fixnum-max 5))) (with-test-prefix "inum / frac" - (pass-if (= 3 (max 3 5/2))) - (pass-if (= 5/2 (max 2 5/2)))) + (pass-if (eqv? 3 (max 3 5/2))) + (pass-if (eqv? 5/2 (max 2 5/2)))) (with-test-prefix "frac / inum" - (pass-if (= 3 (max 5/2 3))) - (pass-if (= 5/2 (max 5/2 2)))) - - (with-test-prefix "inum / real" - (pass-if (real-nan? (max 123 +nan.0)))) - - (with-test-prefix "real / inum" - (pass-if (real-nan? (max +nan.0 123)))) + (pass-if (eqv? 3 (max 5/2 3))) + (pass-if (eqv? 5/2 (max 5/2 2)))) + + (with-test-prefix "infinities and NaNs" + ;; +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 ))) + + ;; NaNs beat everything except +inf.0 + (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" - (pass-if (= big*2 (max big*2 5/2))) - (pass-if (= 5/2 (max (- big*2) 5/2)))) + (pass-if (eqv? big*2 (max big*2 5/2))) + (pass-if (eqv? 5/2 (max (- big*2) 5/2)))) (with-test-prefix "frac / big" - (pass-if (= big*2 (max 5/2 big*2))) - (pass-if (= 5/2 (max 5/2 (- big*2))))) + (pass-if (eqv? big*2 (max 5/2 big*2))) + (pass-if (eqv? 5/2 (max 5/2 (- big*2))))) (with-test-prefix "big / real" (pass-if (real-nan? (max big*5 +nan.0))) @@ -2507,29 +2560,29 @@ (pass-if (eqv? 1.0 (max 1.0 (- big*5))))) (with-test-prefix "frac / frac" - (pass-if (= 2/3 (max 1/2 2/3))) - (pass-if (= 2/3 (max 2/3 1/2))) - (pass-if (= -1/2 (max -1/2 -2/3))) - (pass-if (= -1/2 (max -2/3 -1/2)))) + (pass-if (eqv? 2/3 (max 1/2 2/3))) + (pass-if (eqv? 2/3 (max 2/3 1/2))) + (pass-if (eqv? -1/2 (max -1/2 -2/3))) + (pass-if (eqv? -1/2 (max -2/3 -1/2)))) (with-test-prefix "real / real" (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 +nan.0))) - (pass-if (= 456.0 (max 123.0 456.0))) - (pass-if (= 456.0 (max 456.0 123.0))))) + (pass-if (eqv? 456.0 (max 123.0 456.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 ;; sure we've avoided that (for-each (lambda (b) (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) - (= +inf.0 (max b +inf.0))) + (eqv? +inf.0 (max 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) - (= (exact->inexact b) (max b -inf.0)))) + (eqv? (exact->inexact b) (max b -inf.0)))) (list (1- (ash 1 1024)) (ash 1 1024) (1+ (ash 1 1024)) @@ -2579,43 +2632,96 @@ (big*5 (* fixnum-max 5))) (pass-if (documented? min)) - (pass-if (= 1 (min 7 3 1 5))) - (pass-if (= 1 (min 1 7 3 5))) - (pass-if (= 1 (min 7 3 5 1))) - (pass-if (= -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 (= -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 (= 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? 1 (min 7 3 1 5))) + (pass-if (eqv? 1 (min 1 7 3 5))) + (pass-if (eqv? 1 (min 7 3 5 1))) + (pass-if (eqv? -7 (min 2 3 4 -2 5 -7 1 -1 4 2))) + (pass-if (eqv? -7 (min -7 2 3 4 -2 5 1 -1 4 2))) + (pass-if (eqv? -7 (min 2 3 4 -2 5 1 -1 4 2 -7))) + (pass-if (eqv? big*2 (min big*3 big*5 big*2 big*4))) + (pass-if (eqv? big*2 (min big*2 big*3 big*5 big*4))) + (pass-if (eqv? big*2 (min big*3 big*5 big*4 big*2))) (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 - (= (- 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 - (= (- 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" - (pass-if (= 5/2 (min 3 5/2))) - (pass-if (= 2 (min 2 5/2)))) + (pass-if (eqv? 5/2 (min 3 5/2))) + (pass-if (eqv? 2 (min 2 5/2)))) (with-test-prefix "frac / inum" - (pass-if (= 5/2 (min 5/2 3))) - (pass-if (= 2 (min 5/2 2)))) - - (with-test-prefix "inum / real" - (pass-if (real-nan? (min 123 +nan.0)))) - - (with-test-prefix "real / inum" - (pass-if (real-nan? (min +nan.0 123)))) + (pass-if (eqv? 5/2 (min 5/2 3))) + (pass-if (eqv? 2 (min 5/2 2)))) + + (with-test-prefix "infinities and NaNs" + ;; -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 ))) + + ;; NaNs beat everything except -inf.0 + (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" - (pass-if (= 5/2 (min big*2 5/2))) - (pass-if (= (- big*2) (min (- big*2) 5/2)))) + (pass-if (eqv? 5/2 (min big*2 5/2))) + (pass-if (eqv? (- big*2) (min (- big*2) 5/2)))) (with-test-prefix "frac / big" - (pass-if (= 5/2 (min 5/2 big*2))) - (pass-if (= (- big*2) (min 5/2 (- big*2))))) + (pass-if (eqv? 5/2 (min 5/2 big*2))) + (pass-if (eqv? (- big*2) (min 5/2 (- big*2))))) (with-test-prefix "big / real" (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))))) (with-test-prefix "frac / frac" - (pass-if (= 1/2 (min 1/2 2/3))) - (pass-if (= 1/2 (min 2/3 1/2))) - (pass-if (= -2/3 (min -1/2 -2/3))) - (pass-if (= -2/3 (min -2/3 -1/2)))) + (pass-if (eqv? 1/2 (min 1/2 2/3))) + (pass-if (eqv? 1/2 (min 2/3 1/2))) + (pass-if (eqv? -2/3 (min -1/2 -2/3))) + (pass-if (eqv? -2/3 (min -2/3 -1/2)))) (with-test-prefix "real / real" (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 +nan.0))) - (pass-if (= 123.0 (min 123.0 456.0))) - (pass-if (= 123.0 (min 456.0 123.0))))) + (pass-if (eqv? 123.0 (min 123.0 456.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 ;; sure we've avoided that (for-each (lambda (b) (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) - (= (exact->inexact b) (min b +inf.0))) + (eqv? (exact->inexact b) (min 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) - (= -inf.0 (min b -inf.0)))) + (eqv? -inf.0 (min b -inf.0)))) (list (1- (ash 1 1024)) (ash 1 1024) (1+ (ash 1 1024)) -- 1.5.6.5