;;;; numbers.test --- tests guile's numbers -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2009, 2010, 2011,
+;;;; 2012, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(not (not (object-documentation object))))
(define fixnum-bit
- (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
+ (do ((i 0 (+ 1 i))
+ (n 1 (* 2 n)))
+ ((> n most-positive-fixnum)
+ (+ 1 i))))
(define fixnum-min most-negative-fixnum)
(define fixnum-max most-positive-fixnum)
;;;
(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)))))
+;;;
+;;; 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 (not (= (ash-flo 1.0 58) (1- (ash 1 58)))))
(pass-if (= (ash 1 58) (ash-flo 1.0 58)))
(pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58))))
- (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))))
+ (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58))))
+
+ ;; prior to guile 2.0.10, inum/complex comparisons were done just by
+ ;; converting the inum to a double, which on a 64-bit would round making
+ ;; say inexact 2^58 appear equal to exact 2^58+1
+ (pass-if (= (+ +0.0i (ash-flo 1.0 58)) (ash 1 58)))
+ (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1+ (ash 1 58)))))
+ (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1- (ash 1 58)))))
+ (pass-if (= (ash 1 58) (+ +0.0i (ash-flo 1.0 58))))
+ (pass-if (not (= (1+ (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
+ (pass-if (not (= (1- (ash 1 58)) (+ +0.0i (ash-flo 1.0 58)))))
+
+ ;; prior to guile 2.0.10, fraction/flonum and fraction/complex
+ ;; comparisons mishandled infinities.
+ (pass-if (not (= 1/2 +inf.0)))
+ (pass-if (not (= 1/2 -inf.0)))
+ (pass-if (not (= +inf.0 1/2)))
+ (pass-if (not (= -inf.0 1/2)))
+ (pass-if (not (= 1/2 +inf.0+0.0i)))
+ (pass-if (not (= 1/2 -inf.0+0.0i)))
+ (pass-if (not (= +inf.0+0.0i 1/2)))
+ (pass-if (not (= -inf.0+0.0i 1/2))))
;;;
;;; <
(pass-if "n = 0.0"
(not (< 0.0 0.0)))
+ (pass-if "n = -0.0"
+ (not (< 0.0 -0.0)))
+
(pass-if "n = 1"
(< 0.0 1))
(pass-if "n = fixnum-min - 1"
(not (< 0.0 (- fixnum-min 1)))))
+
+ (pass-if (not (< -0.0 0.0)))
+ (pass-if (not (< -0.0 -0.0)))
(with-test-prefix "(< 1 n)"
(pass-if (eq? #f (< x (* -4/3 x))))
(pass-if (eq? #f (< (- x) (* -4/3 x))))))
+ (with-test-prefix "inum/flonum"
+ (pass-if (< 4 4.5))
+ (pass-if (< 4.5 5))
+ (pass-if (< -5 -4.5))
+ (pass-if (< -4.5 4))
+ (pass-if (not (< 4.5 4)))
+ (pass-if (not (< 5 4.5)))
+ (pass-if (not (< -4.5 -5)))
+ (pass-if (not (< 4 -4.5)))
+
+ (pass-if (< 4 +inf.0))
+ (pass-if (< -4 +inf.0))
+ (pass-if (< -inf.0 4))
+ (pass-if (< -inf.0 -4))
+ (pass-if (not (< +inf.0 4)))
+ (pass-if (not (< +inf.0 -4)))
+ (pass-if (not (< 4 -inf.0)))
+ (pass-if (not (< -4 -inf.0)))
+
+ (pass-if (not (< +nan.0 4)))
+ (pass-if (not (< +nan.0 -4)))
+ (pass-if (not (< 4 +nan.0)))
+ (pass-if (not (< -4 +nan.0)))
+
+ (pass-if (< most-positive-fixnum (expt 2.0 fixnum-bit)))
+ (pass-if (not (< (expt 2.0 fixnum-bit) most-positive-fixnum)))
+
+ (pass-if (< (- (expt 2.0 fixnum-bit)) most-negative-fixnum))
+ (pass-if (not (< most-negative-fixnum (- (expt 2.0 fixnum-bit)))))
+
+ ;; Prior to guile 2.0.10, we would unconditionally convert the inum
+ ;; to a double, which on a 64-bit system could result in a
+ ;; significant change in its value, thus corrupting the comparison.
+ (pass-if (< most-positive-fixnum (exact->inexact (+ 1 most-positive-fixnum))))
+ (pass-if (< (exact->inexact (- (+ 1 most-positive-fixnum))) (- most-positive-fixnum))))
+
(with-test-prefix "flonum/frac"
(pass-if (< 0.75 4/3))
(pass-if (< -0.75 4/3))
(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 )))
(let ((big (ash 1 4096)))
(= 1.0 (exact->inexact (/ (1+ big) big)))))
+ ;; In guile 2.0.9, 'exact->inexact' guaranteed proper rounding when
+ ;; applied to non-negative fractions, but on 64-bit systems would
+ ;; sometimes double-round when applied to negative fractions,
+ ;; specifically when the numerator was a fixnum not exactly
+ ;; representable as a double.
+ (with-test-prefix "frac inum/inum, numerator not exactly representable as a double"
+ (let ((n (+ 1 (expt 2 dbl-mant-dig))))
+ (for-each (lambda (d)
+ (test (/ n d)
+ (/ n d)
+ (exact->inexact (/ n d))))
+ '(3 5 6 7 9 11 13 17 19 23 0.0 -0.0 +nan.0 +inf.0 -inf.0))))
+
(test "round up to odd"
;; =====================================================
;; 11111111111111111111111111111111111111111111111111000101 ->
(define (test root)
(pass-if (list root 'exact)
(eqv? root (sqrt (expt root 2))))
+ (pass-if (list root '*2)
+ (let ((r (sqrt (* 2 (expt root 2)))))
+ (and (inexact? r)
+ (eqv-loosely? (* (sqrt 2) root) r))))
(pass-if (list root '-1)
(let ((r (sqrt (- (expt root 2) 1))))
(and (inexact? r)
(test (exact-integer-sqrt (+ -1 (expt 2 (+ 1 dbl-mant-dig)))))
(test (exact-integer-sqrt (+ -1 (expt 2 (+ 0 dbl-mant-dig)))))
(test (exact-integer-sqrt (+ -1 (expt 2 (+ -1 dbl-mant-dig)))))
- (test (exact-integer-sqrt (+ -1 (expt 2 (+ -2 dbl-mant-dig))))))
+ (test (exact-integer-sqrt (+ -1 (expt 2 (+ -2 dbl-mant-dig)))))
+
+ ;; largest finite inexact
+ (test (* (- (expt 2 dbl-mant-dig) 1)
+ (expt 2 (- dbl-max-exp dbl-mant-dig)))))
+
+ (pass-if-equal "smallest inexact"
+ (expt 2.0 (- dbl-min-exp dbl-mant-dig))
+ (sqrt (/ (+ -1 (expt 2 (* 2 (- dbl-mant-dig dbl-min-exp)))))))
+
+ (with-test-prefix "extreme ratios"
+ (define-syntax-rule (test want x)
+ (pass-if 'x
+ (let ((got (sqrt x)))
+ (and (inexact? got)
+ (test-eqv? 1.0 (/ want got))))))
+ (test 1.511139943175573e176 (/ (expt 3 2001) (expt 2 2001)))
+ (test 2.1370746022826034e176 (/ (expt 3 2001) (expt 2 2000)))
+ (test 8.724570529756128e175 (/ (expt 3 2000) (expt 2 2001)))
+ (test 6.6175207962444435e-177 (/ (expt 2 2001) (expt 3 2001)))
+ (test 1.1461882239239027e-176 (/ (expt 2 2001) (expt 3 2000)))
+ (test 4.679293829667447e-177 (/ (expt 2 2000) (expt 3 2001))))
+
+ (pass-if (eqv? (/ (expt 2 1000)
+ (expt 3 1000))
+ (sqrt (/ (expt 2 2000)
+ (expt 3 2000)))))
+
+ (pass-if (eqv? (/ (expt 3 1000)
+ (expt 2 1000))
+ (sqrt (/ (expt 3 2000)
+ (expt 2 2000)))))
(pass-if (eqv? +4i (sqrt -16)))
(pass-if (eqv-loosely? +1.0e150i (sqrt #e-1e300)))
(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