>From ab106861f0bf59f4a71535a745ae5770d4830e3d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 1 Feb 2011 05:22:40 -0500 Subject: [PATCH] More discriminating NaN predicates for numbers.test * test-suite/tests/numbers.test: (real-nan?, complex-nan?, imaginary-nan?): Add more discriminating NaN testing predicates internal to numbers.test, and convert several uses of `nan?' to use these instead: * `real-nan?' checks that its argument is real and a NaN. * `complex-nan?' checks that both the real and imaginary parts of its argument are NaNs. * `imaginary-nan?' checks that its argument's real part is zero and the imaginary part is a NaN. --- test-suite/tests/numbers.test | 73 +++++++++++++++++++++++++---------------- 1 files changed, 45 insertions(+), 28 deletions(-) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 5619bf0..75d3790 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -120,6 +120,23 @@ (eqv? x y)) (else (and (inexact? y) (> test-epsilon (abs (- x y))))))) +;; return true if OBJ is a real NaN +(define (real-nan? obj) + (and (real? obj) + (nan? obj))) + +;; return true if both the real and imaginary +;; parts of OBJ are NaNs +(define (complex-nan? obj) + (and (nan? (real-part obj)) + (nan? (imag-part obj)))) + +;; return true if the real part of OBJ is zero +;; and the imaginary part is a NaN. +(define (imaginary-nan? obj) + (and (zero? (real-part obj)) + (nan? (imag-part obj)))) + (define const-e 2.7182818284590452354) (define const-e^2 7.3890560989306502274) (define const-1/e 0.3678794411714423215) @@ -414,7 +431,7 @@ (pass-if (= 0.0 (abs 0.0))) (pass-if (= 1.0 (abs 1.0))) (pass-if (= 1.0 (abs -1.0))) - (pass-if (nan? (abs +nan.0))) + (pass-if (real-nan? (abs +nan.0))) (pass-if (= +inf.0 (abs +inf.0))) (pass-if (= +inf.0 (abs -inf.0)))) @@ -1345,9 +1362,9 @@ (pass-if (eqv? 0.0 (rationalize 3 +inf.0))) (pass-if (eqv? 0.0 (rationalize -3 +inf.0))) - (pass-if (nan? (rationalize +inf.0 +inf.0))) - (pass-if (nan? (rationalize +nan.0 +inf.0))) - (pass-if (nan? (rationalize +nan.0 4))) + (pass-if (real-nan? (rationalize +inf.0 +inf.0))) + (pass-if (real-nan? (rationalize +nan.0 +inf.0))) + (pass-if (real-nan? (rationalize +nan.0 4))) (pass-if (eqv? +inf.0 (rationalize +inf.0 3))) (pass-if (eqv? 3/10 (rationalize 3/10 0))) @@ -2462,10 +2479,10 @@ (pass-if (= 5/2 (max 5/2 2)))) (with-test-prefix "inum / real" - (pass-if (nan? (max 123 +nan.0)))) + (pass-if (real-nan? (max 123 +nan.0)))) (with-test-prefix "real / inum" - (pass-if (nan? (max +nan.0 123)))) + (pass-if (real-nan? (max +nan.0 123)))) (with-test-prefix "big / frac" (pass-if (= big*2 (max big*2 5/2))) @@ -2476,14 +2493,14 @@ (pass-if (= 5/2 (max 5/2 (- big*2))))) (with-test-prefix "big / real" - (pass-if (nan? (max big*5 +nan.0))) + (pass-if (real-nan? (max big*5 +nan.0))) (pass-if (eqv? (exact->inexact big*5) (max big*5 -inf.0))) (pass-if (eqv? (exact->inexact big*5) (max big*5 1.0))) (pass-if (eqv? +inf.0 (max big*5 +inf.0))) (pass-if (eqv? 1.0 (max (- big*5) 1.0)))) (with-test-prefix "real / big" - (pass-if (nan? (max +nan.0 big*5))) + (pass-if (real-nan? (max +nan.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (max -inf.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (max 1.0 big*5))) (pass-if (eqv? +inf.0 (max +inf.0 big*5))) @@ -2496,9 +2513,9 @@ (pass-if (= -1/2 (max -2/3 -1/2)))) (with-test-prefix "real / real" - (pass-if (nan? (max 123.0 +nan.0))) - (pass-if (nan? (max +nan.0 123.0))) - (pass-if (nan? (max +nan.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 +nan.0))) (pass-if (= 456.0 (max 123.0 456.0))) (pass-if (= 456.0 (max 456.0 123.0))))) @@ -2522,8 +2539,8 @@ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make ;; sure we've avoided that - (pass-if (nan? (max (ash 1 2048) +nan.0))) - (pass-if (nan? (max +nan.0 (ash 1 2048))))) + (pass-if (real-nan? (max (ash 1 2048) +nan.0))) + (pass-if (real-nan? (max +nan.0 (ash 1 2048))))) ;;; ;;; min @@ -2587,10 +2604,10 @@ (pass-if (= 2 (min 5/2 2)))) (with-test-prefix "inum / real" - (pass-if (nan? (min 123 +nan.0)))) + (pass-if (real-nan? (min 123 +nan.0)))) (with-test-prefix "real / inum" - (pass-if (nan? (min +nan.0 123)))) + (pass-if (real-nan? (min +nan.0 123)))) (with-test-prefix "big / frac" (pass-if (= 5/2 (min big*2 5/2))) @@ -2601,14 +2618,14 @@ (pass-if (= (- big*2) (min 5/2 (- big*2))))) (with-test-prefix "big / real" - (pass-if (nan? (min big*5 +nan.0))) + (pass-if (real-nan? (min big*5 +nan.0))) (pass-if (eqv? (exact->inexact big*5) (min big*5 +inf.0))) (pass-if (eqv? -inf.0 (min big*5 -inf.0))) (pass-if (eqv? 1.0 (min big*5 1.0))) (pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0)))) (with-test-prefix "real / big" - (pass-if (nan? (min +nan.0 big*5))) + (pass-if (real-nan? (min +nan.0 big*5))) (pass-if (eqv? (exact->inexact big*5) (min +inf.0 big*5))) (pass-if (eqv? -inf.0 (min -inf.0 big*5))) (pass-if (eqv? 1.0 (min 1.0 big*5))) @@ -2621,9 +2638,9 @@ (pass-if (= -2/3 (min -2/3 -1/2)))) (with-test-prefix "real / real" - (pass-if (nan? (min 123.0 +nan.0))) - (pass-if (nan? (min +nan.0 123.0))) - (pass-if (nan? (min +nan.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 +nan.0))) (pass-if (= 123.0 (min 123.0 456.0))) (pass-if (= 123.0 (min 456.0 123.0))))) @@ -2648,8 +2665,8 @@ ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make ;; sure we've avoided that - (pass-if (nan? (min (- (ash 1 2048)) (- +nan.0)))) - (pass-if (nan? (min (- +nan.0) (- (ash 1 2048)))))) + (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0)))) + (pass-if (real-nan? (min (- +nan.0) (- (ash 1 2048)))))) ;;; ;;; + @@ -3166,10 +3183,10 @@ (pass-if (eqv? 1 (expt 0.0 0))) (pass-if (eqv? 1.0 (expt 0 0.0))) (pass-if (eqv? 1.0 (expt 0.0 0.0))) - (pass-if (nan? (expt 0 -1))) - (pass-if (nan? (expt 0 -1.0))) - (pass-if (nan? (expt 0.0 -1))) - (pass-if (nan? (expt 0.0 -1.0))) + (pass-if (real-nan? (expt 0 -1))) + (pass-if (real-nan? (expt 0 -1.0))) + (pass-if (real-nan? (expt 0.0 -1))) + (pass-if (real-nan? (expt 0.0 -1.0))) (pass-if (eqv? 0 (expt 0 3))) (pass-if (= 0 (expt 0 4.0))) (pass-if (eqv? 0.0 (expt 0.0 5))) @@ -3336,8 +3353,8 @@ (pass-if (eqv? 1 (integer-expt 0 0))) (pass-if (eqv? 1 (integer-expt 0.0 0))) - (pass-if (nan? (integer-expt 0 -1))) - (pass-if (nan? (integer-expt 0.0 -1))) + (pass-if (real-nan? (integer-expt 0 -1))) + (pass-if (real-nan? (integer-expt 0.0 -1))) (pass-if (eqv? 0 (integer-expt 0 3))) (pass-if (eqv? 0.0 (integer-expt 0.0 5))) (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1))) -- 1.5.6.5