mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
489 lines
16 KiB
Scheme
489 lines
16 KiB
Scheme
|
|
(import (chibi test) (scheme base) (scheme division))
|
|
|
|
(test-begin "division")
|
|
|
|
;; These verify the basic rounding operators floor, ceiling, truncate
|
|
;; and round, on which the other tests depend.
|
|
|
|
(test-begin "rounding")
|
|
|
|
(test 4.0 (floor 4.3))
|
|
(test 5.0 (ceiling 4.3))
|
|
(test 4.0 (truncate 4.3))
|
|
(test 4.0 (round 4.3))
|
|
(test -5.0 (floor -4.3))
|
|
(test -4.0 (ceiling -4.3))
|
|
(test -4.0 (truncate -4.3))
|
|
(test -4.0 (round -4.3))
|
|
(test 3.0 (floor 3.5))
|
|
(test 4.0 (ceiling 3.5))
|
|
(test 3.0 (truncate 3.5))
|
|
(test 4.0 (round 3.5))
|
|
(test -4.0 (floor -3.5))
|
|
(test -3.0 (ceiling -3.5))
|
|
(test -3.0 (truncate -3.5))
|
|
(test -4.0 (round -3.5))
|
|
(test 3 (floor (/ 1300000000000000000000 400000000000000000000)))
|
|
(test 4 (ceiling (/ 1300000000000000000000 400000000000000000000)))
|
|
(test 3 (truncate (/ 1300000000000000000000 400000000000000000000)))
|
|
(test 3 (round (/ 1300000000000000000000 400000000000000000000)))
|
|
(test -4 (floor (/ -1300000000000000000000 400000000000000000000)))
|
|
(test -3 (ceiling (/ -1300000000000000000000 400000000000000000000)))
|
|
(test -3 (truncate (/ -1300000000000000000000 400000000000000000000)))
|
|
(test -3 (round (/ -1300000000000000000000 400000000000000000000)))
|
|
(test 650000000000000000000 (floor (/ 1300000000000000000001 2)))
|
|
(test 650000000000000000001 (ceiling (/ 1300000000000000000001 2)))
|
|
(test 650000000000000000000 (truncate (/ 1300000000000000000001 2)))
|
|
(test 650000000000000000000 (round (/ 1300000000000000000001 2)))
|
|
(test 650000000000000000001 (floor (/ 1300000000000000000003 2)))
|
|
(test 650000000000000000002 (ceiling (/ 1300000000000000000003 2)))
|
|
(test 650000000000000000001 (truncate (/ 1300000000000000000003 2)))
|
|
(test 650000000000000000002 (round (/ 1300000000000000000003 2)))
|
|
(test -650000000000000000001 (floor (/ -1300000000000000000001 2)))
|
|
(test -650000000000000000000 (ceiling (/ -1300000000000000000001 2)))
|
|
(test -650000000000000000000 (truncate (/ -1300000000000000000001 2)))
|
|
(test -650000000000000000000 (round (/ -1300000000000000000001 2)))
|
|
(test -650000000000000000002 (floor (/ -1300000000000000000003 2)))
|
|
(test -650000000000000000001 (ceiling (/ -1300000000000000000003 2)))
|
|
(test -650000000000000000001 (truncate (/ -1300000000000000000003 2)))
|
|
(test -650000000000000000002 (round (/ -1300000000000000000003 2)))
|
|
(test 4 (round 7/2))
|
|
(test 7 (round 7))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "trivial zero divisor")
|
|
|
|
;; All operators are the same when the quotient is zero.
|
|
|
|
(test 0 (ceiling-quotient 0 4))
|
|
(test 0 (ceiling-quotient 0 -4))
|
|
|
|
(test 0 (ceiling-remainder 0 4))
|
|
(test 0 (ceiling-remainder 0 -4))
|
|
|
|
(test 0 (floor-quotient 0 4))
|
|
(test 0 (floor-quotient 0 -4))
|
|
|
|
(test 0 (floor-remainder 0 4))
|
|
(test 0 (floor-remainder 0 -4))
|
|
|
|
(test 0 (truncate-quotient 0 4))
|
|
(test 0 (truncate-quotient 0 -4))
|
|
|
|
(test 0 (truncate-remainder 0 4))
|
|
(test 0 (truncate-remainder 0 -4))
|
|
|
|
(test 0 (round-quotient 0 4))
|
|
(test 0 (round-quotient 0 -4))
|
|
|
|
(test 0 (round-remainder 0 4))
|
|
(test 0 (round-remainder 0 -4))
|
|
|
|
(test 0 (euclidean-quotient 0 4))
|
|
(test 0 (euclidean-quotient 0 -4))
|
|
|
|
(test 0 (euclidean-remainder 0 4))
|
|
(test 0 (euclidean-remainder 0 -4))
|
|
|
|
(test 0 (balanced-quotient 0 4))
|
|
(test 0 (balanced-quotient 0 -4))
|
|
|
|
(test 0 (balanced-remainder 0 4))
|
|
(test 0 (balanced-remainder 0 -4))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "trivial one dividend")
|
|
|
|
;; The remainder is always zero when dividing by one.
|
|
|
|
(test 13 (ceiling-quotient 13 1))
|
|
(test -13 (ceiling-quotient -13 1))
|
|
|
|
(test 0 (ceiling-remainder 13 1))
|
|
(test 0 (ceiling-remainder -13 1))
|
|
|
|
(test 13 (floor-quotient 13 1))
|
|
(test -13 (floor-quotient -13 1))
|
|
|
|
(test 0 (floor-remainder 13 1))
|
|
(test 0 (floor-remainder -13 1))
|
|
|
|
(test 13 (truncate-quotient 13 1))
|
|
(test -13 (truncate-quotient -13 1))
|
|
|
|
(test 0 (truncate-remainder 13 1))
|
|
(test 0 (truncate-remainder -13 1))
|
|
|
|
(test 13 (round-quotient 13 1))
|
|
(test -13 (round-quotient -13 1))
|
|
|
|
(test 0 (round-remainder 13 1))
|
|
(test 0 (round-remainder -13 1))
|
|
|
|
(test 13 (euclidean-quotient 13 1))
|
|
(test -13 (euclidean-quotient -13 1))
|
|
|
|
(test 0 (euclidean-remainder 13 1))
|
|
(test 0 (euclidean-remainder -13 1))
|
|
|
|
(test 13 (balanced-quotient 13 1))
|
|
(test -13 (balanced-quotient -13 1))
|
|
|
|
(test 0 (balanced-remainder 13 1))
|
|
(test 0 (balanced-remainder -13 1))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "fixnum division")
|
|
|
|
;; Ceiling rounds towards positive infinity.
|
|
|
|
(test 4 (ceiling-quotient 13 4))
|
|
(test -3 (ceiling-quotient -13 4))
|
|
(test -3 (ceiling-quotient 13 -4))
|
|
(test 4 (ceiling-quotient -13 -4))
|
|
|
|
(test -3 (ceiling-remainder 13 4))
|
|
(test -1 (ceiling-remainder -13 4))
|
|
(test 1 (ceiling-remainder 13 -4))
|
|
(test 3 (ceiling-remainder -13 -4))
|
|
|
|
;; Floor rounds towards negative infinity.
|
|
|
|
(test 3 (floor-quotient 13 4))
|
|
(test -4 (floor-quotient -13 4))
|
|
(test -4 (floor-quotient 13 -4))
|
|
(test 3 (floor-quotient -13 -4))
|
|
|
|
(test 1 (floor-remainder 13 4))
|
|
(test 3 (floor-remainder -13 4))
|
|
(test -3 (floor-remainder 13 -4))
|
|
(test -1 (floor-remainder -13 -4))
|
|
|
|
;; Truncate rounds towards zero - the magnitudes never change
|
|
;; regardless of the signs.
|
|
|
|
(test 3 (truncate-quotient 13 4))
|
|
(test -3 (truncate-quotient -13 4))
|
|
(test -3 (truncate-quotient 13 -4))
|
|
(test 3 (truncate-quotient -13 -4))
|
|
|
|
(test 1 (truncate-remainder 13 4))
|
|
(test -1 (truncate-remainder -13 4))
|
|
(test 1 (truncate-remainder 13 -4))
|
|
(test -1 (truncate-remainder -13 -4))
|
|
|
|
;; Round rounds towards the nearest integer - it's equivalent to floor
|
|
;; when signs are the same, and equivalent to ceiling when the signs
|
|
;; differ.
|
|
|
|
(test 3 (round-quotient 13 4))
|
|
(test -3 (round-quotient -13 4))
|
|
(test -3 (round-quotient 13 -4))
|
|
(test 3 (round-quotient -13 -4))
|
|
|
|
(test 1 (round-remainder 13 4))
|
|
(test -1 (round-remainder -13 4))
|
|
(test 1 (round-remainder 13 -4))
|
|
(test -1 (round-remainder -13 -4))
|
|
|
|
;; Euclidean rounds such that the remainder is always in the interval
|
|
;; [0, divisor) - i.e. the remainder is always non-negative. It's
|
|
;; equivalent to floor if the divisor is negative, and ceiling
|
|
;; otherwise.
|
|
|
|
(test 3 (euclidean-quotient 13 4))
|
|
(test -4 (euclidean-quotient -13 4))
|
|
(test -3 (euclidean-quotient 13 -4))
|
|
(test 4 (euclidean-quotient -13 -4))
|
|
|
|
(test 1 (euclidean-remainder 13 4))
|
|
(test 3 (euclidean-remainder -13 4))
|
|
(test 1 (euclidean-remainder 13 -4))
|
|
(test 3 (euclidean-remainder -13 -4))
|
|
|
|
;; Balanced differs from truncate only in the 0.5 remainder border
|
|
;; case in the next test group.
|
|
|
|
(test 3 (balanced-quotient 13 4))
|
|
(test -3 (balanced-quotient -13 4))
|
|
(test -3 (balanced-quotient 13 -4))
|
|
(test 3 (balanced-quotient -13 -4))
|
|
|
|
(test 1 (balanced-remainder 13 4))
|
|
(test -1 (balanced-remainder -13 4))
|
|
(test 1 (balanced-remainder 13 -4))
|
|
(test -1 (balanced-remainder -13 -4))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "one half remainder")
|
|
|
|
;; Testing the 0.5 remainder border cases. Ceiling, floor and
|
|
;; truncate and euclidean don't change.
|
|
|
|
(test 7 (ceiling-quotient 13 2))
|
|
(test -6 (ceiling-quotient -13 2))
|
|
(test -6 (ceiling-quotient 13 -2))
|
|
(test 7 (ceiling-quotient -13 -2))
|
|
|
|
(test -1 (ceiling-remainder 13 2))
|
|
(test -1 (ceiling-remainder -13 2))
|
|
(test 1 (ceiling-remainder 13 -2))
|
|
(test 1 (ceiling-remainder -13 -2))
|
|
|
|
(test 6 (floor-quotient 13 2))
|
|
(test -7 (floor-quotient -13 2))
|
|
(test -7 (floor-quotient 13 -2))
|
|
(test 6 (floor-quotient -13 -2))
|
|
|
|
(test 1 (floor-remainder 13 2))
|
|
(test 1 (floor-remainder -13 2))
|
|
(test -1 (floor-remainder 13 -2))
|
|
(test -1 (floor-remainder -13 -2))
|
|
|
|
(test 6 (truncate-quotient 13 2))
|
|
(test -6 (truncate-quotient -13 2))
|
|
(test -6 (truncate-quotient 13 -2))
|
|
(test 6 (truncate-quotient -13 -2))
|
|
|
|
(test 1 (truncate-remainder 13 2))
|
|
(test -1 (truncate-remainder -13 2))
|
|
(test 1 (truncate-remainder 13 -2))
|
|
(test -1 (truncate-remainder -13 -2))
|
|
|
|
(test 6 (euclidean-quotient 13 2))
|
|
(test -7 (euclidean-quotient -13 2))
|
|
(test -6 (euclidean-quotient 13 -2))
|
|
(test 7 (euclidean-quotient -13 -2))
|
|
|
|
(test 1 (euclidean-remainder 13 2))
|
|
(test 1 (euclidean-remainder -13 2))
|
|
(test 1 (euclidean-remainder 13 -2))
|
|
(test 1 (euclidean-remainder -13 -2))
|
|
|
|
;; For consistency with the default rounding mode specified by the
|
|
;; IEEE floating point standard, round rounds to even when exactly
|
|
;; half-way between two integers.
|
|
|
|
(test 6 (round-quotient 13 2))
|
|
(test -6 (round-quotient -13 2))
|
|
(test -6 (round-quotient 13 -2))
|
|
(test 6 (round-quotient -13 -2))
|
|
|
|
(test 1 (round-remainder 13 2))
|
|
(test -1 (round-remainder -13 2))
|
|
(test 1 (round-remainder 13 -2))
|
|
(test -1 (round-remainder -13 -2))
|
|
|
|
;; Balanced rounds up when exactly half-way between two integers.
|
|
|
|
(test 7 (balanced-quotient 13 2))
|
|
(test -6 (balanced-quotient -13 2))
|
|
(test -7 (balanced-quotient 13 -2))
|
|
(test 6 (balanced-quotient -13 -2))
|
|
|
|
(test -1 (balanced-remainder 13 2))
|
|
(test -1 (balanced-remainder -13 2))
|
|
(test -1 (balanced-remainder 13 -2))
|
|
(test -1 (balanced-remainder -13 -2))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "exactness")
|
|
|
|
(define-syntax values->list
|
|
(syntax-rules ()
|
|
((values->list expr) (call-with-values (lambda () expr) list))))
|
|
|
|
(test '(4.0 -3.0) (values->list (ceiling/ 13.0 4)))
|
|
(test '(4.0 -3.0) (values->list (ceiling/ 13 4.0)))
|
|
(test '(4.0 -3.0) (values->list (ceiling/ 13.0 4.0)))
|
|
|
|
(test 4.0 (ceiling-quotient 13.0 4))
|
|
(test 4.0 (ceiling-quotient 13 4.0))
|
|
(test 4.0 (ceiling-quotient 13.0 4.0))
|
|
|
|
(test -3.0 (ceiling-remainder 13.0 4))
|
|
(test -3.0 (ceiling-remainder 13 4.0))
|
|
(test -3.0 (ceiling-remainder 13.0 4.0))
|
|
|
|
(test '(3.0 1.0) (values->list (floor/ 13.0 4)))
|
|
(test '(3.0 1.0) (values->list (floor/ 13 4.0)))
|
|
(test '(3.0 1.0) (values->list (floor/ 13.0 4.0)))
|
|
|
|
(test 3.0 (floor-quotient 13.0 4))
|
|
(test 3.0 (floor-quotient 13 4.0))
|
|
(test 3.0 (floor-quotient 13.0 4.0))
|
|
|
|
(test 1.0 (floor-remainder 13.0 4))
|
|
(test 1.0 (floor-remainder 13 4.0))
|
|
(test 1.0 (floor-remainder 13.0 4.0))
|
|
|
|
(test '(3.0 1.0) (values->list (truncate/ 13.0 4)))
|
|
(test '(3.0 1.0) (values->list (truncate/ 13 4.0)))
|
|
(test '(3.0 1.0) (values->list (truncate/ 13.0 4.0)))
|
|
|
|
(test 3.0 (truncate-quotient 13.0 4))
|
|
(test 3.0 (truncate-quotient 13 4.0))
|
|
(test 3.0 (truncate-quotient 13.0 4.0))
|
|
|
|
(test 1.0 (truncate-remainder 13.0 4))
|
|
(test 1.0 (truncate-remainder 13 4.0))
|
|
(test 1.0 (truncate-remainder 13.0 4.0))
|
|
|
|
(test '(3.0 1.0) (values->list (round/ 13.0 4)))
|
|
(test '(3.0 1.0) (values->list (round/ 13 4.0)))
|
|
(test '(3.0 1.0) (values->list (round/ 13.0 4.0)))
|
|
|
|
(test 3.0 (round-quotient 13.0 4))
|
|
(test 3.0 (round-quotient 13 4.0))
|
|
(test 3.0 (round-quotient 13.0 4.0))
|
|
|
|
(test 1.0 (round-remainder 13.0 4))
|
|
(test 1.0 (round-remainder 13 4.0))
|
|
(test 1.0 (round-remainder 13.0 4.0))
|
|
|
|
(test '(3.0 1.0) (values->list (euclidean/ 13.0 4)))
|
|
(test '(3.0 1.0) (values->list (euclidean/ 13 4.0)))
|
|
(test '(3.0 1.0) (values->list (euclidean/ 13.0 4.0)))
|
|
|
|
(test 3.0 (euclidean-quotient 13.0 4))
|
|
(test 3.0 (euclidean-quotient 13 4.0))
|
|
(test 3.0 (euclidean-quotient 13.0 4.0))
|
|
|
|
(test 1.0 (euclidean-remainder 13.0 4))
|
|
(test 1.0 (euclidean-remainder 13 4.0))
|
|
(test 1.0 (euclidean-remainder 13.0 4.0))
|
|
|
|
(test '(3.0 1.0) (values->list (balanced/ 13.0 4)))
|
|
(test '(3.0 1.0) (values->list (balanced/ 13 4.0)))
|
|
(test '(3.0 1.0) (values->list (balanced/ 13.0 4.0)))
|
|
|
|
(test 3.0 (balanced-quotient 13.0 4))
|
|
(test 3.0 (balanced-quotient 13 4.0))
|
|
(test 3.0 (balanced-quotient 13.0 4.0))
|
|
|
|
(test 1.0 (balanced-remainder 13.0 4))
|
|
(test 1.0 (balanced-remainder 13 4.0))
|
|
(test 1.0 (balanced-remainder 13.0 4.0))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "bignum division")
|
|
|
|
;; A repeat of the fixnum division tests above, using bignums to test
|
|
;; bignum division.
|
|
|
|
(test 4 (ceiling-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -3 (ceiling-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -3 (ceiling-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 4 (ceiling-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test -300000000000000000000
|
|
(ceiling-remainder 1300000000000000000000 400000000000000000000))
|
|
(test -100000000000000000000
|
|
(ceiling-remainder -1300000000000000000000 400000000000000000000))
|
|
(test 100000000000000000000
|
|
(ceiling-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test 300000000000000000000
|
|
(ceiling-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 3 (floor-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -4 (floor-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -4 (floor-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 3 (floor-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 100000000000000000000
|
|
(floor-remainder 1300000000000000000000 400000000000000000000))
|
|
(test 300000000000000000000
|
|
(floor-remainder -1300000000000000000000 400000000000000000000))
|
|
(test -300000000000000000000
|
|
(floor-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test -100000000000000000000
|
|
(floor-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 3 (truncate-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -3 (truncate-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -3 (truncate-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 3 (truncate-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 100000000000000000000
|
|
(truncate-remainder 1300000000000000000000 400000000000000000000))
|
|
(test -100000000000000000000
|
|
(truncate-remainder -1300000000000000000000 400000000000000000000))
|
|
(test 100000000000000000000
|
|
(truncate-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test -100000000000000000000
|
|
(truncate-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 3 (round-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -3 (round-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -3 (round-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 3 (round-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 100000000000000000000
|
|
(round-remainder 1300000000000000000000 400000000000000000000))
|
|
(test -100000000000000000000
|
|
(round-remainder -1300000000000000000000 400000000000000000000))
|
|
(test 100000000000000000000
|
|
(round-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test -100000000000000000000
|
|
(round-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 3 (euclidean-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -4 (euclidean-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -3 (euclidean-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 4 (euclidean-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 100000000000000000000
|
|
(euclidean-remainder 1300000000000000000000 400000000000000000000))
|
|
(test 300000000000000000000
|
|
(euclidean-remainder -1300000000000000000000 400000000000000000000))
|
|
(test 100000000000000000000
|
|
(euclidean-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test 300000000000000000000
|
|
(euclidean-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 3 (balanced-quotient 1300000000000000000000 400000000000000000000))
|
|
(test -3 (balanced-quotient -1300000000000000000000 400000000000000000000))
|
|
(test -3 (balanced-quotient 1300000000000000000000 -400000000000000000000))
|
|
(test 3 (balanced-quotient -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test 100000000000000000000
|
|
(balanced-remainder 1300000000000000000000 400000000000000000000))
|
|
(test -100000000000000000000
|
|
(balanced-remainder -1300000000000000000000 400000000000000000000))
|
|
(test 100000000000000000000
|
|
(balanced-remainder 1300000000000000000000 -400000000000000000000))
|
|
(test -100000000000000000000
|
|
(balanced-remainder -1300000000000000000000 -400000000000000000000))
|
|
|
|
(test-end)
|
|
|
|
(test-begin "remainder infinity")
|
|
|
|
(test-error (remainder +inf.0 +nan.0))
|
|
(test-error (remainder -inf.0 +nan.0))
|
|
(test-error (remainder +inf.0 2.0))
|
|
(test-error (remainder -inf.0 2.0))
|
|
(test-error (remainder +inf.0 2/1))
|
|
(test-error (remainder -inf.0 2/1))
|
|
(test-error (remainder +inf.0 2))
|
|
(test-error (remainder -inf.0 2))
|
|
|
|
(test-error (remainder +nan.0 +inf.0))
|
|
(test-error (remainder +nan.0 -inf.0))
|
|
(test-error (remainder 2.0 +inf.0))
|
|
(test-error (remainder 2.0 -inf.0))
|
|
(test-error (remainder 2/1 +inf.0))
|
|
(test-error (remainder 2/1 -inf.0))
|
|
(test-error (remainder 2 +inf.0))
|
|
(test-error (remainder 2 -inf.0))
|
|
|
|
(test-end "remainder infinity")
|
|
|
|
(test-end)
|