conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixed bug in (eqv? 0.0 -0.0) returning #t.

This commit is contained in:
Abdulaziz Ghuloum 2008-10-18 13:08:14 -04:00
parent 29edb9d800
commit bbafcc08d2
3 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scheme/ikarus.predicates.ss
View File

@ -251,7 +251,13 @@
(import (ikarus)) (import (ikarus))
(cond (cond
[(eq? x y) #t] [(eq? x y) #t]
[(flonum? x) (and (flonum? y) (fl=? x y))] [(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)))]
[(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)

2
scheme/last-revision
View File

@ -1 +1 @@
1629 1631

5
scheme/tests/numerics.ss
View File

@ -49,8 +49,6 @@
(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))
(define (test-exact-integer-sqrt) (define (test-exact-integer-sqrt)
(define (f i j inc) (define (f i j inc)
(when (< i j) (when (< i j)
@ -67,4 +65,5 @@
(define (run-tests) (define (run-tests)
(test-rounding) (test-rounding)
(test-exact-integer-sqrt) (test-exact-integer-sqrt)
#;(test-eqv))) (test-eqv))
)