;;;
(with-test-prefix "numerator"
- (pass-if "0"
- (eqv? 0 (numerator 0)))
- (pass-if "1"
- (eqv? 1 (numerator 1)))
- (pass-if "2"
- (eqv? 2 (numerator 2)))
- (pass-if "-1"
- (eqv? -1 (numerator -1)))
- (pass-if "-2"
- (eqv? -2 (numerator -2)))
-
- (pass-if "0.0"
- (eqv? 0.0 (numerator 0.0)))
- (pass-if "1.0"
- (eqv? 1.0 (numerator 1.0)))
- (pass-if "2.0"
- (eqv? 2.0 (numerator 2.0)))
- (pass-if "-1.0"
- (eqv? -1.0 (numerator -1.0)))
- (pass-if "-2.0"
- (eqv? -2.0 (numerator -2.0)))
-
- (pass-if "0.5"
- (eqv? 1.0 (numerator 0.5)))
- (pass-if "0.25"
- (eqv? 1.0 (numerator 0.25)))
- (pass-if "0.75"
- (eqv? 3.0 (numerator 0.75))))
+ (pass-if-equal "0" 0 (numerator 0))
+ (pass-if-equal "1" 1 (numerator 1))
+ (pass-if-equal "2" 2 (numerator 2))
+ (pass-if-equal "-1" -1 (numerator -1))
+ (pass-if-equal "-2" -2 (numerator -2))
+
+ (pass-if-equal "0.0" 0.0 (numerator 0.0))
+ (pass-if-equal "1.0" 1.0 (numerator 1.0))
+ (pass-if-equal "2.0" 2.0 (numerator 2.0))
+ (pass-if-equal "-0.0" -0.0 (numerator -0.0))
+ (pass-if-equal "-1.0" -1.0 (numerator -1.0))
+ (pass-if-equal "-2.0" -2.0 (numerator -2.0))
+
+ (pass-if-equal "0.5" 1.0 (numerator 0.5))
+ (pass-if-equal "0.25" 1.0 (numerator 0.25))
+ (pass-if-equal "0.75" 3.0 (numerator 0.75))
+
+ (pass-if-equal "+inf.0" +inf.0 (numerator +inf.0))
+ (pass-if-equal "-inf.0" -inf.0 (numerator -inf.0)))
;;;
;;; denominator
;;;
(with-test-prefix "denominator"
- (pass-if "0"
- (eqv? 1 (denominator 0)))
- (pass-if "1"
- (eqv? 1 (denominator 1)))
- (pass-if "2"
- (eqv? 1 (denominator 2)))
- (pass-if "-1"
- (eqv? 1 (denominator -1)))
- (pass-if "-2"
- (eqv? 1 (denominator -2)))
-
- (pass-if "0.0"
- (eqv? 1.0 (denominator 0.0)))
- (pass-if "1.0"
- (eqv? 1.0 (denominator 1.0)))
- (pass-if "2.0"
- (eqv? 1.0 (denominator 2.0)))
- (pass-if "-1.0"
- (eqv? 1.0 (denominator -1.0)))
- (pass-if "-2.0"
- (eqv? 1.0 (denominator -2.0)))
-
- (pass-if "0.5"
- (eqv? 2.0 (denominator 0.5)))
- (pass-if "0.25"
- (eqv? 4.0 (denominator 0.25)))
- (pass-if "0.75"
- (eqv? 4.0 (denominator 0.75))))
+ (pass-if-equal "0" 1 (denominator 0))
+ (pass-if-equal "1" 1 (denominator 1))
+ (pass-if-equal "2" 1 (denominator 2))
+ (pass-if-equal "-1" 1 (denominator -1))
+ (pass-if-equal "-2" 1 (denominator -2))
+
+ (pass-if-equal "0.0" 1.0 (denominator 0.0))
+ (pass-if-equal "1.0" 1.0 (denominator 1.0))
+ (pass-if-equal "2.0" 1.0 (denominator 2.0))
+ (pass-if-equal "-0.0" 1.0 (denominator -0.0))
+ (pass-if-equal "-1.0" 1.0 (denominator -1.0))
+ (pass-if-equal "-2.0" 1.0 (denominator -2.0))
+
+ (pass-if-equal "0.5" 2.0 (denominator 0.5))
+ (pass-if-equal "0.25" 4.0 (denominator 0.25))
+ (pass-if-equal "0.75" 4.0 (denominator 0.75))
+
+ (pass-if-equal "+inf.0" 1.0 (denominator +inf.0))
+ (pass-if-equal "-inf.0" 1.0 (denominator -inf.0)))
;;;
;;; gcd
(pass-if "n = fixnum-min - 1"
(eqv? (- (- fixnum-min 1)) (gcd (- fixnum-min 1) (- fixnum-min 1)))))
+ (with-test-prefix "flonum arguments"
+
+ (pass-if-equal "flonum"
+ 15.0
+ (gcd -15.0))
+
+ (pass-if-equal "flonum/flonum"
+ 3.0
+ (gcd 6.0 -15.0))
+
+ (pass-if-equal "flonum/fixnum"
+ 3.0
+ (gcd 6.0 -15))
+
+ (pass-if-equal "fixnum/flonum"
+ 3.0
+ (gcd -6 15.0))
+
+ (pass-if-equal "flonum/bignum"
+ 2.0
+ (gcd -6.0 (expt 2 fixnum-bit)))
+
+ (pass-if-equal "bignum/flonum"
+ 3.0
+ (gcd (- (expt 3 fixnum-bit)) 6.0)))
+
;; Are wrong type arguments detected correctly?
)
;; FIXME: more tests?
;; (some of these are already in r4rs.test)
(pass-if (documented? lcm))
- (pass-if (= (lcm) 1))
- (pass-if (= (lcm 32 -36) 288))
+ (pass-if-equal 1 (lcm))
+ (pass-if-equal 15 (lcm -15))
+ (pass-if-equal 288 (lcm 32 -36))
+
+ (with-test-prefix "flonum arguments"
+
+ (pass-if-equal "flonum"
+ 15.0
+ (lcm -15.0))
+
+ (pass-if-equal "flonum/flonum"
+ 30.0
+ (lcm 6.0 -15.0))
+
+ (pass-if-equal "flonum/fixnum"
+ 30.0
+ (lcm 6.0 -15))
+
+ (pass-if-equal "fixnum/flonum"
+ 30.0
+ (lcm -6 15.0))
+
+ (pass-if "flonum/bignum"
+ (let ((want (* 3.0 (expt 2 fixnum-bit)))
+ (got (lcm -6.0 (expt 2 fixnum-bit))))
+ (and (inexact? got)
+ (test-eqv? 1.0 (/ want got)))))
+
+ (pass-if "bignum/flonum"
+ (let ((want (* 2.0 (expt 3 fixnum-bit)))
+ (got (lcm (- (expt 3 fixnum-bit)) 6.0)))
+ (and (inexact? got)
+ (test-eqv? 1.0 (/ want got))))))
+
(let ((big-n 115792089237316195423570985008687907853269984665640564039457584007913129639936) ; 2 ^ 256
(lcm-of-big-n-and-11 1273712981610478149659280835095566986385969831322046204434033424087044426039296))
(pass-if (= lcm-of-big-n-and-11 (lcm big-n 11)))
(pass-if (eqv? 1/3 (rationalize 3/10 -1/10)))
(pass-if (eqv? -1/3 (rationalize -3/10 -1/10)))
+ ;; Prior to Guile 2.0.10, rationalize used a faulty algorithm that
+ ;; incorrectly returned 2/3 and -2/3 in the following cases.
+ (pass-if (eqv? 1/2 (rationalize #e+0.67 1/4)))
+ (pass-if (eqv? -1/2 (rationalize #e-0.67 1/4)))
+
+ (pass-if (eqv? 1 (rationalize #e+0.67 1/3)))
+ (pass-if (eqv? -1 (rationalize #e-0.67 1/3)))
+
+ (pass-if (eqv? 1/2 (rationalize #e+0.66 1/3)))
+ (pass-if (eqv? -1/2 (rationalize #e-0.66 1/3)))
+
+ (pass-if (eqv? 1 (rationalize #e+0.67 2/3)))
+ (pass-if (eqv? -1 (rationalize #e-0.67 2/3)))
+
+ (pass-if (eqv? 0 (rationalize #e+0.66 2/3)))
+ (pass-if (eqv? 0 (rationalize #e-0.66 2/3)))
+
+ ;; Prior to Guile 2.0.10, rationalize used a faulty algorithm that
+ ;; incorrectly computed the following approximations of PI.
+ (with-test-prefix "pi"
+ (define *pi* #e3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679)
+ (pass-if (eqv? 16/5 (rationalize *pi* 1/10)))
+ (pass-if (eqv? 201/64 (rationalize *pi* 1/1000)))
+ (pass-if (eqv? 75948/24175 (rationalize *pi* (expt 10 -7))))
+ (pass-if (eqv? 100798/32085 (rationalize *pi* (expt 10 -8))))
+ (pass-if (eqv? 58466453/18610450 (rationalize *pi* (expt 10 -14))))
+ (pass-if (eqv? 2307954651196778721982809475299879198775111361078/734644782339796933783743757007944508986600750685
+ (rationalize *pi* (expt 10 -95)))))
+
(pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 1/10)))
(pass-if (test-eqv? (/ -1.0 3) (rationalize -0.3 1/10)))
(pass-if (test-eqv? (/ 1.0 3) (rationalize 0.3 -1/10)))
(pass-if (not (integer? (lambda () #t))))
(pass-if (not (integer? (current-input-port)))))
+;;;
+;;; exact-integer?
+;;;
+
+(with-test-prefix "exact-integer?"
+ (pass-if (documented? exact-integer?))
+ (pass-if (exact-integer? 0))
+ (pass-if (exact-integer? 7))
+ (pass-if (exact-integer? -7))
+ (pass-if (exact-integer? (+ 1 fixnum-max)))
+ (pass-if (exact-integer? (- 1 fixnum-min)))
+ (pass-if (and (= 1.0 (round 1.0))
+ (not (exact-integer? 1.0))))
+ (pass-if (not (exact-integer? 1.3)))
+ (pass-if (not (exact-integer? +inf.0)))
+ (pass-if (not (exact-integer? -inf.0)))
+ (pass-if (not (exact-integer? +nan.0)))
+ (pass-if (not (exact-integer? +inf.0-inf.0i)))
+ (pass-if (not (exact-integer? +nan.0+nan.0i)))
+ (pass-if (not (exact-integer? 3+4i)))
+ (pass-if (not (exact-integer? #\a)))
+ (pass-if (not (exact-integer? "a")))
+ (pass-if (not (exact-integer? (make-vector 0))))
+ (pass-if (not (exact-integer? (cons 1 2))))
+ (pass-if (not (exact-integer? #t)))
+ (pass-if (not (exact-integer? (lambda () #t))))
+ (pass-if (not (exact-integer? (current-input-port)))))
+
;;;
;;; inexact?
;;;
(pass-if (eqv? 5/2 (max 5/2 2))))
(with-test-prefix "infinities and NaNs"
- ;; +inf.0 beats everything else, including NaNs
+ ;; +inf.0 beats everything except NaNs
(pass-if (eqv? +inf.0 (max +inf.0 123 )))
(pass-if (eqv? +inf.0 (max 123 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 -123.3 )))
(pass-if (eqv? +inf.0 (max (- big*2) +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
- (pass-if (eqv? +inf.0 (max +inf.0 +nan.0 )))
- (pass-if (eqv? +inf.0 (max +nan.0 +inf.0 )))
(pass-if (eqv? +inf.0 (max +inf.0 +inf.0 )))
- ;; NaNs beat everything except +inf.0
+ ;; NaNs beat everything
(pass-if (real-nan? (max +nan.0 123 )))
(pass-if (real-nan? (max 123 +nan.0 )))
(pass-if (real-nan? (max +nan.0 123.3 )))
(pass-if (real-nan? (max +nan.0 -inf.0 )))
(pass-if (real-nan? (max -inf.0 +nan.0 )))
(pass-if (real-nan? (max +nan.0 +nan.0 )))
+ (pass-if (real-nan? (max +inf.0 +nan.0 )))
+ (pass-if (real-nan? (max +nan.0 +inf.0 )))
;; -inf.0 always loses, except against itself
(pass-if (eqv? -inf.0 (max -inf.0 -inf.0 )))
(pass-if (eqv? 2 (min 5/2 2))))
(with-test-prefix "infinities and NaNs"
- ;; -inf.0 beats everything else, including NaNs
+ ;; -inf.0 beats everything except NaNs
(pass-if (eqv? -inf.0 (min -inf.0 123 )))
(pass-if (eqv? -inf.0 (min 123 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -123.3 )))
(pass-if (eqv? -inf.0 (min (- big*2) -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 +inf.0 )))
(pass-if (eqv? -inf.0 (min +inf.0 -inf.0 )))
- (pass-if (eqv? -inf.0 (min -inf.0 +nan.0 )))
- (pass-if (eqv? -inf.0 (min +nan.0 -inf.0 )))
(pass-if (eqv? -inf.0 (min -inf.0 -inf.0 )))
- ;; NaNs beat everything except -inf.0
+ ;; NaNs beat everything
(pass-if (real-nan? (min +nan.0 123 )))
(pass-if (real-nan? (min 123 +nan.0 )))
(pass-if (real-nan? (min +nan.0 123.3 )))
(pass-if (real-nan? (min +nan.0 +inf.0 )))
(pass-if (real-nan? (min +inf.0 +nan.0 )))
(pass-if (real-nan? (min +nan.0 +nan.0 )))
+ (pass-if (real-nan? (min -inf.0 +nan.0 )))
+ (pass-if (real-nan? (min +nan.0 -inf.0 )))
;; +inf.0 always loses, except against itself
(pass-if (eqv? +inf.0 (min +inf.0 +inf.0 )))
(for-each (lambda (n)
(for-each (lambda (count) (test n count))
- '(-1000 -3 -2 -1 0 1 2 3 1000)))
+ `(-1000
+ ,(- fixnum-bit)
+ ,(- (- fixnum-bit 1))
+ -3 -2 -1 0 1 2 3
+ ,(- fixnum-bit 1)
+ ,fixnum-bit
+ 1000)))
(list 0 1 3 23 -1 -3 -23
fixnum-max
(1+ fixnum-max)
HCoop / bpt / guile.git / blobdiff