- 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] [(eq? x y) #t]
[(flonum? x) [(flonum? x)
(and (flonum? y) (and (flonum? y)
(if ($fl= x 0.0) (if ($fl< x y)
(and ($fl= y 0.0) #f
($fl= ($fl/ 1.0 x) (if ($fl> x y)
($fl/ 1.0 y))) #f
(fl=? x y)))] (if ($fl= x 0.0)
($fl= ($fl/ 1.0 x) ($fl/ 1.0 y))
#t))))]
[(bignum? x) (and (bignum? y) (= x y))] [(bignum? x) (and (bignum? y) (= x y))]
[(ratnum? x) (and (ratnum? y) (= x y))] [(ratnum? x) (and (ratnum? y) (= x y))]
[(compnum? x) [(compnum? x)

View File

@ -1 +1 @@
1826 1827

View File

@ -35,6 +35,7 @@
((pretty-format 'fix) ((pretty-format 'letrec))) ((pretty-format 'fix) ((pretty-format 'letrec)))
(strip-source-info #t) (strip-source-info #t)
(current-letrec-pass 'scc)
(define scheme-library-files (define scheme-library-files
;;; Listed in the order in which they're loaded. ;;; 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 #t)
(test-eqv 0.0 -0.0 #f) (test-eqv 0.0 -0.0 #f)
(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 (test-exact-integer-sqrt)
(define (f i j inc) (define (f i j inc)