- eqv? and equal? now guarantee #t when given two NaNs (unspecified

by R6RS).
This commit is contained in:
Abdulaziz Ghuloum 2009-07-20 10:01:05 +03:00
parent fe88c7bd0d
commit 9e764c76b4
4 changed files with 14 additions and 7 deletions

View File

@ -253,11 +253,13 @@
[(eq? x y) #t]
[(flonum? x)
(and (flonum? y)
(if ($fl= x 0.0)
(and ($fl= y 0.0)
($fl= ($fl/ 1.0 x)
($fl/ 1.0 y)))
(fl=? x y)))]
(if ($fl< x y)
#f
(if ($fl> x y)
#f
(if ($fl= x 0.0)
($fl= ($fl/ 1.0 x) ($fl/ 1.0 y))
#t))))]
[(bignum? x) (and (bignum? y) (= x y))]
[(ratnum? x) (and (ratnum? y) (= x y))]
[(compnum? x)

View File

@ -1 +1 @@
1826
1827

View File

@ -35,6 +35,7 @@
((pretty-format 'fix) ((pretty-format 'letrec)))
(strip-source-info #t)
(current-letrec-pass 'scc)
(define scheme-library-files
;;; Listed in the order in which they're loaded.
;;;

View File

@ -78,7 +78,11 @@
(test-eqv 0.0 0.0 #t)
(test-eqv 0.0 -0.0 #f)
(test-eqv -0.0 0.0 #f)
(test-eqv -0.0 -0.0 #t))
(test-eqv -0.0 -0.0 #t)
;;; ikarus extensions, not guaranteed by R6RS
(test-eqv +nan.0 +nan.0 #t)
(test-eqv (/ +inf.0 +inf.0) (/ -inf.0 +inf.0) #t)
(test-eqv +nan.0 (string->number "+nan.0") #t))
(define (test-exact-integer-sqrt)
(define (f i j inc)