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.

diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 5619bf0..75d3790 100644 (file)
--- 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)))