mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 03:30:22 +02:00
Code Activity

More discriminating NaN predicates for numbers.test

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2011-02-01 05:22:40 -05:00 • committed by Andy Wingo
parent 605f698026
commit 55a8b70819
1 changed files with 45 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -120,6 +120,23 @@
(eqv? x y)) (eqv? x y))
(else (and (inexact? y) (> test-epsilon (abs (- 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.7182818284590452354)
(define const-e^2 7.3890560989306502274) (define const-e^2 7.3890560989306502274)
(define const-1/e 0.3678794411714423215) (define const-1/e 0.3678794411714423215)
@ -414,7 +431,7 @@
(pass-if (= 0.0 (abs 0.0))) (pass-if (= 0.0 (abs 0.0)))
(pass-if (= 1.0 (abs 1.0))) (pass-if (= 1.0 (abs 1.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)))
(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 (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 (real-nan? (rationalize +inf.0 +inf.0)))
(pass-if (nan? (rationalize +nan.0 +inf.0))) (pass-if (real-nan? (rationalize +nan.0 +inf.0)))
(pass-if (nan? (rationalize +nan.0 4))) (pass-if (real-nan? (rationalize +nan.0 4)))
(pass-if (eqv? +inf.0 (rationalize +inf.0 3))) (pass-if (eqv? +inf.0 (rationalize +inf.0 3)))
(pass-if (eqv? 3/10 (rationalize 3/10 0))) (pass-if (eqv? 3/10 (rationalize 3/10 0)))
@ -2462,10 +2479,10 @@
(pass-if (= 5/2 (max 5/2 2)))) (pass-if (= 5/2 (max 5/2 2))))
(with-test-prefix "inum / real" (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" (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" (with-test-prefix "big / frac"
(pass-if (= big*2 (max big*2 5/2))) (pass-if (= big*2 (max big*2 5/2)))
@ -2476,14 +2493,14 @@
(pass-if (= 5/2 (max 5/2 (- big*2))))) (pass-if (= 5/2 (max 5/2 (- big*2)))))
(with-test-prefix "big / real" (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 -inf.0)))
(pass-if (eqv? (exact->inexact big*5) (max big*5 1.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? +inf.0 (max big*5 +inf.0)))
(pass-if (eqv? 1.0 (max (- big*5) 1.0)))) (pass-if (eqv? 1.0 (max (- big*5) 1.0))))
(with-test-prefix "real / big" (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 -inf.0 big*5)))
(pass-if (eqv? (exact->inexact big*5) (max 1.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))) (pass-if (eqv? +inf.0 (max +inf.0 big*5)))
@ -2496,9 +2513,9 @@
(pass-if (= -1/2 (max -2/3 -1/2)))) (pass-if (= -1/2 (max -2/3 -1/2))))
(with-test-prefix "real / real" (with-test-prefix "real / real"
(pass-if (nan? (max 123.0 +nan.0))) (pass-if (real-nan? (max 123.0 +nan.0)))
(pass-if (nan? (max +nan.0 123.0))) (pass-if (real-nan? (max +nan.0 123.0)))
(pass-if (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 (= 456.0 (max 123.0 456.0)))
(pass-if (= 456.0 (max 456.0 123.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 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that ;; sure we've avoided that
(pass-if (nan? (max (ash 1 2048) +nan.0))) (pass-if (real-nan? (max (ash 1 2048) +nan.0)))
(pass-if (nan? (max +nan.0 (ash 1 2048))))) (pass-if (real-nan? (max +nan.0 (ash 1 2048)))))
;;; ;;;
;;; min ;;; min
@ -2587,10 +2604,10 @@
(pass-if (= 2 (min 5/2 2)))) (pass-if (= 2 (min 5/2 2))))
(with-test-prefix "inum / real" (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" (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" (with-test-prefix "big / frac"
(pass-if (= 5/2 (min big*2 5/2))) (pass-if (= 5/2 (min big*2 5/2)))
@ -2601,14 +2618,14 @@
(pass-if (= (- big*2) (min 5/2 (- big*2))))) (pass-if (= (- big*2) (min 5/2 (- big*2)))))
(with-test-prefix "big / real" (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? (exact->inexact big*5) (min big*5 +inf.0)))
(pass-if (eqv? -inf.0 (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? 1.0 (min big*5 1.0)))
(pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0)))) (pass-if (eqv? (exact->inexact (- big*5)) (min (- big*5) 1.0))))
(with-test-prefix "real / big" (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? (exact->inexact big*5) (min +inf.0 big*5)))
(pass-if (eqv? -inf.0 (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))) (pass-if (eqv? 1.0 (min 1.0 big*5)))
@ -2621,9 +2638,9 @@
(pass-if (= -2/3 (min -2/3 -1/2)))) (pass-if (= -2/3 (min -2/3 -1/2))))
(with-test-prefix "real / real" (with-test-prefix "real / real"
(pass-if (nan? (min 123.0 +nan.0))) (pass-if (real-nan? (min 123.0 +nan.0)))
(pass-if (nan? (min +nan.0 123.0))) (pass-if (real-nan? (min +nan.0 123.0)))
(pass-if (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 (= 123.0 (min 123.0 456.0)))
(pass-if (= 123.0 (min 456.0 123.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 ;; in gmp prior to 4.2, mpz_cmp_d ended up treating NaN as 3*2^1023, make
;; sure we've avoided that ;; sure we've avoided that
(pass-if (nan? (min (- (ash 1 2048)) (- +nan.0)))) (pass-if (real-nan? (min (- (ash 1 2048)) (- +nan.0))))
(pass-if (nan? (min (- +nan.0) (- (ash 1 2048)))))) (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 (expt 0.0 0)))
(pass-if (eqv? 1.0 (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 (eqv? 1.0 (expt 0.0 0.0)))
(pass-if (nan? (expt 0 -1))) (pass-if (real-nan? (expt 0 -1)))
(pass-if (nan? (expt 0 -1.0))) (pass-if (real-nan? (expt 0 -1.0)))
(pass-if (nan? (expt 0.0 -1))) (pass-if (real-nan? (expt 0.0 -1)))
(pass-if (nan? (expt 0.0 -1.0))) (pass-if (real-nan? (expt 0.0 -1.0)))
(pass-if (eqv? 0 (expt 0 3))) (pass-if (eqv? 0 (expt 0 3)))
(pass-if (= 0 (expt 0 4.0))) (pass-if (= 0 (expt 0 4.0)))
(pass-if (eqv? 0.0 (expt 0.0 5))) (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)))
(pass-if (eqv? 1 (integer-expt 0.0 0))) (pass-if (eqv? 1 (integer-expt 0.0 0)))
(pass-if (nan? (integer-expt 0 -1))) (pass-if (real-nan? (integer-expt 0 -1)))
(pass-if (nan? (integer-expt 0.0 -1))) (pass-if (real-nan? (integer-expt 0.0 -1)))
(pass-if (eqv? 0 (integer-expt 0 3))) (pass-if (eqv? 0 (integer-expt 0 3)))
(pass-if (eqv? 0.0 (integer-expt 0.0 5))) (pass-if (eqv? 0.0 (integer-expt 0.0 5)))
(pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1))) (pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))