mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 04:50:28 +02:00
Code Activity

(<): Add tests inum/bignum/flonum/frac with frac.

Browse source
This commit is contained in:
Kevin Ryde 2004-01-06 21:48:33 +00:00
parent f14d16ed3a
commit fe89421e30
1 changed files with 89 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1684,7 +1684,95 @@
(pass-if (not (< (1- (ash 3 1023)) +nan.0)))
(pass-if (not (< +nan.0 (ash 3 1023))))
(pass-if (not (< +nan.0 (1+ (ash 3 1023)))))
(pass-if (not (< +nan.0 (1- (ash 3 1023))))))
(pass-if (not (< +nan.0 (1- (ash 3 1023)))))
(with-test-prefix "inum/frac"
(pass-if (< 2 9/4))
(pass-if (< -2 9/4))
(pass-if (< -2 7/4))
(pass-if (< -2 -7/4))
(pass-if (eq? #f (< 2 7/4)))
(pass-if (eq? #f (< 2 -7/4)))
(pass-if (eq? #f (< 2 -9/4)))
(pass-if (eq? #f (< -2 -9/4))))
(with-test-prefix "bignum/frac"
(let ((x (ash 1 2048)))
(pass-if (< x (* 4/3 x)))
(pass-if (< (- x) (* 4/3 x)))
(pass-if (< (- x) (* 2/3 x)))
(pass-if (< (- x) (* -2/3 x)))
(pass-if (eq? #f (< x (* 2/3 x))))
(pass-if (eq? #f (< x (* -2/3 x))))
(pass-if (eq? #f (< x (* -4/3 x))))
(pass-if (eq? #f (< (- x) (* -4/3 x))))))
(with-test-prefix "flonum/frac"
(pass-if (< 0.75 4/3))
(pass-if (< -0.75 4/3))
(pass-if (< -0.75 2/3))
(pass-if (< -0.75 -2/3))
(pass-if (eq? #f (< 0.75 2/3)))
(pass-if (eq? #f (< 0.75 -2/3)))
(pass-if (eq? #f (< 0.75 -4/3)))
(pass-if (eq? #f (< -0.75 -4/3)))
(pass-if (< -inf.0 4/3))
(pass-if (< -inf.0 -4/3))
(pass-if (eq? #f (< +inf.0 4/3)))
(pass-if (eq? #f (< +inf.0 -4/3)))
(pass-if (eq? #f (< +nan.0 4/3)))
(pass-if (eq? #f (< +nan.0 -4/3))))
(with-test-prefix "frac/inum"
(pass-if (< 7/4 2))
(pass-if (< -7/4 2))
(pass-if (< -9/4 2))
(pass-if (< -9/4 -2))
(pass-if (eq? #f (< 9/4 2)))
(pass-if (eq? #f (< 9/4 -2)))
(pass-if (eq? #f (< 7/4 -2)))
(pass-if (eq? #f (< -7/4 -2))))
(with-test-prefix "frac/bignum"
(let ((x (ash 1 2048)))
(pass-if (< (* 2/3 x) x))
(pass-if (< (* -2/3 x) x))
(pass-if (< (* -4/3 x) x))
(pass-if (< (* -4/3 x) (- x)))
(pass-if (eq? #f (< (* 4/3 x) x)))
(pass-if (eq? #f (< (* 4/3 x) (- x))))
(pass-if (eq? #f (< (* 2/3 x) (- x))))
(pass-if (eq? #f (< (* -2/3 x) (- x))))))
(with-test-prefix "frac/flonum"
(pass-if (< 2/3 0.75))
(pass-if (< -2/3 0.75))
(pass-if (< -4/3 0.75))
(pass-if (< -4/3 -0.75))
(pass-if (eq? #f (< 4/3 0.75)))
(pass-if (eq? #f (< 4/3 -0.75)))
(pass-if (eq? #f (< 2/3 -0.75)))
(pass-if (eq? #f (< -2/3 -0.75)))
(pass-if (< 4/3 +inf.0))
(pass-if (< -4/3 +inf.0))
(pass-if (eq? #f (< 4/3 -inf.0)))
(pass-if (eq? #f (< -4/3 -inf.0)))
(pass-if (eq? #f (< 4/3 +nan.0)))
(pass-if (eq? #f (< -4/3 +nan.0))))
(with-test-prefix "frac/frac"
(pass-if (< 2/3 6/7))
(pass-if (< -2/3 6/7))
(pass-if (< -4/3 6/7))
(pass-if (< -4/3 -6/7))
(pass-if (eq? #f (< 4/3 6/7)))
(pass-if (eq? #f (< 4/3 -6/7)))
(pass-if (eq? #f (< 2/3 -6/7)))
(pass-if (eq? #f (< -2/3 -6/7)))))
;;;
;;; >