From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 19 Nov 2010 05:02:58 +0000 (+0000)
Subject: Implement a complete set of integer division operator pairs.
X-Git-Tag: 20101212-Gtk~14^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e17a939d40dd799435f9d6e03ce17b8288d3638f;p=mit-scheme.git

Implement a complete set of integer division operator pairs.

Given a numerator n and a denominator d, each operator pair computes
an integral quotient q and the induced remainder r = n - d q such
that |r| < |d|.  There are five pairs: ceiling, euclidean, floor,
round, and truncate.  Ceiling, floor, round, and truncate compute the
rounded quotient as their names suggest.  Euclidean division is floor
division for positive denominators, and ceiling division for negative
denominators, so that it exhibits the stronger property 0 <= r < |d|.
---

diff --git a/src/runtime/division.scm b/src/runtime/division.scm
new file mode 100644
index 000000000..dbea87910
--- /dev/null
+++ b/src/runtime/division.scm
@@ -0,0 +1,237 @@
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+    2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; Integer Division
+;;;; package: (runtime integer-division)
+
+(declare (usual-integrations))
+
+;;;; Ceiling
+
+(define (ceiling/ n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (ceiling-/- n d))
+            ((negative? n)
+             (let ((n (- 0 n)))
+               (values (- 0 (quotient n d)) (- 0 (remainder n d)))))
+            ((negative? d)
+             (let ((d (- 0 d)))
+               (values (- 0 (quotient n d)) (remainder n d))))
+            (else
+             (ceiling+/+ n d)))
+      (let ((q (ceiling (/ n d))))
+        (values q (- n (* d q))))))
+
+(define (ceiling-/- n d)
+  (let ((n (- 0 n)) (d (- 0 d)))
+    (let ((q (quotient n d)) (r (remainder n d)))
+      (if (zero? r)
+          (values q r)
+          (values (+ q 1) (- d r))))))
+
+(define (ceiling+/+ n d)
+  (let ((q (quotient n d)) (r (remainder n d)))
+    (if (zero? r)
+        (values q r)
+        (values (+ q 1) (- r d)))))
+
+(define (ceiling-quotient n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (receive (q r) (ceiling-/- n d) r q))
+            ((negative? n) (- 0 (quotient (- 0 n) d)))
+            ((negative? d) (- 0 (quotient n (- 0 d))))
+            (else (receive (q r) (ceiling+/+ n d) r q)))
+      (ceiling (/ n d))))
+
+(define (ceiling-remainder n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (receive (q r) (ceiling-/- n d) q r))
+            ((negative? n) (- 0 (remainder (- 0 n) d)))
+            ((negative? d) (remainder n (- 0 d)))
+            (else (receive (q r) (ceiling+/+ n d) q r)))
+      (- n (* d (ceiling (/ n d))))))
+
+;;;; Euclidean Division
+
+;;; 0 < r < |d|
+
+(define (euclidean/ n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d)) (ceiling-/- n d))
+            ((negative? n) (floor-/+ n d))
+            ((negative? d)
+             (let ((d (- 0 d)))
+               (values (- 0 (quotient n d)) (remainder n d))))
+            (else (values (quotient n d) (remainder n d))))
+      (let ((q (if (negative? d) (ceiling (/ n d)) (floor (/ n d)))))
+        (values q (- n (* d q))))))
+
+(define (euclidean-quotient n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (receive (q r) (ceiling-/- n d) r q))
+            ((negative? n) (receive (q r) (floor-/+ n d) r q))
+            ((negative? d) (- 0 (quotient n (- 0 d))))
+            (else (quotient n d)))
+      (if (negative? d) (ceiling (/ n d)) (floor (/ n d)))))
+
+(define (euclidean-remainder n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (receive (q r) (ceiling-/- n d) q r))
+            ((negative? n) (receive (q r) (floor-/+ n d) q r))
+            ((negative? d) (remainder n (- 0 d)))
+            (else (remainder n d)))
+      (- n (* d (if (negative? d) (ceiling (/ n d)) (floor (/ n d)))))))
+
+;;;; Floor
+
+(define (floor/ n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (let ((n (- 0 n)) (d (- 0 d)))
+               (values (quotient n d) (- 0 (remainder n d)))))
+            ((negative? n) (floor-/+ n d))
+            ((negative? d) (floor+/- n d))
+            (else (values (quotient n d) (remainder n d))))
+      (let ((q (floor (/ n d))))
+        (values q (- n (* d q))))))
+
+(define (floor-/+ n d)
+  (let ((n (- 0 n)))
+    (let ((q (quotient n d)) (r (remainder n d)))
+      (if (zero? r)
+          (values (- 0 q) r)
+          (values (- (- 0 q) 1) (- d r))))))
+
+(define (floor+/- n d)
+  (let ((d (- 0 d)))
+    (let ((q (quotient n d)) (r (remainder n d)))
+      (if (zero? r)
+          (values (- 0 q) r)
+          (values (- (- 0 q) 1) (- r d))))))
+
+(define (floor-quotient n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d)) (quotient (- 0 n) (- 0 d)))
+            ((negative? n) (receive (q r) (floor-/+ n d) r q))
+            ((negative? d) (receive (q r) (floor+/- n d) r q))
+            (else (quotient n d)))
+      (floor (/ n d))))
+
+(define (floor-remainder n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (- 0 (remainder (- 0 n) (- 0 d))))
+            ((negative? n) (receive (q r) (floor-/+ n d) q r))
+            ((negative? d) (receive (q r) (floor+/- n d) q r))
+            (else (remainder n d)))
+      (- n (* d (floor (/ n d))))))
+
+;;;; Round Ties to Even
+
+(define (round/ n d)
+  (define (divide n d adjust leave)
+    (let ((q (quotient n d)) (r (remainder n d)))
+      (if (and (not (zero? r))
+               (or (and (odd? q) (even? d) (divisible? n (quotient d 2)))
+                   (< d (* 2 r))))
+          (adjust (+ q 1) (- r d))
+          (leave q r))))
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (divide (- 0 n) (- 0 d)
+               (lambda (q r) (values q (- 0 r)))
+               (lambda (q r) (values q (- 0 r)))))
+            ((negative? n)
+             (divide (- 0 n) d
+               (lambda (q r) (values (- 0 q) (- 0 r)))
+               (lambda (q r) (values (- 0 q) (- 0 r)))))
+            ((negative? d)
+             (divide n (- 0 d)
+               (lambda (q r) (values (- 0 q) r))
+               (lambda (q r) (values (- 0 q) r))))
+            (else
+             (let ((return (lambda (q r) (values q r))))
+               (divide n d return return))))
+      (let ((q (round (/ n d))))
+        (values q (- n (* d q))))))
+
+(define (divisible? n d)
+  ;; This operation admits a faster implementation than the one given
+  ;; here.
+  (zero? (remainder n d)))
+
+(define (round-quotient n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (receive (q r) (round/ n d)
+        r                               ;ignore
+        q)
+      (round (/ n d))))
+
+(define (round-remainder n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (receive (q r) (round/ n d)
+        q                               ;ignore
+        r)
+      (- n (* d (round (/ n d))))))
+
+;;;; Truncate
+
+(define (truncate/ n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (let ((n (- 0 n)) (d (- 0 d)))
+               (values (quotient n d) (- 0 (remainder n d)))))
+            ((negative? n)
+             (let ((n (- 0 n)))
+               (values (- 0 (quotient n d)) (- 0 (remainder n d)))))
+            ((negative? d)
+             (let ((d (- 0 d)))
+               (values (- 0 (quotient n d)) (remainder n d))))
+            (else
+             (values (quotient n d) (remainder n d))))
+      (let ((q (truncate (/ n d))))
+        (values q (- n (* d q))))))
+
+(define (truncate-quotient n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d)) (quotient (- 0 n) (- 0 d)))
+            ((negative? n) (- 0 (quotient (- 0 n) d)))
+            ((negative? d) (- 0 (quotient n (- 0 d))))
+            (else (quotient n d)))
+      (truncate (/ n d))))
+
+(define (truncate-remainder n d)
+  (if (and (exact-integer? n) (exact-integer? d))
+      (cond ((and (negative? n) (negative? d))
+             (- 0 (remainder (- 0 n) (- 0 d))))
+            ((negative? n) (- 0 (remainder (- 0 n) d)))
+            ((negative? d) (remainder n (- 0 d)))
+            (else (remainder n d)))
+      (- n (* d (truncate (/ n d))))))
\ No newline at end of file
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 2c93ef3df..594bffa1c 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -328,6 +328,26 @@ USA.
 	  bitwise-orc1
 	  bitwise-nand))
 
+(define-package (runtime integer-division)
+  (files "division")
+  (parent (runtime))
+  (export ()
+          ceiling-quotient
+          ceiling-remainder
+          ceiling/
+          euclidean-quotient
+          euclidean-remainder
+          euclidean/
+          floor-quotient
+          floor-remainder
+          floor/
+          round-quotient
+          round-remainder
+          round/
+          truncate-quotient
+          truncate-remainder
+          truncate/))
+
 (define-package (runtime keyword)
   (files "keyword")
   (parent (runtime))
diff --git a/tests/runtime/test-division.scm b/tests/runtime/test-division.scm
new file mode 100644
index 000000000..b1a320865
--- /dev/null
+++ b/tests/runtime/test-division.scm
@@ -0,0 +1,318 @@
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+    2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; Tests of integer division operators
+
+(declare (usual-integrations))
+
+(define (check-division n d correct-q q r)
+  (let ((correct-r (- n (* d correct-q))))
+    (assert-eqv q correct-q)
+    (assert-eqv r correct-r)))
+
+(define division-test-iterations #x1000)
+
+;; Such a huge bound as this tests bignum arithmetic, not just fixnum
+;; arithmetic.
+(define division-test-bound #x100000000000000000000000000000000)
+
+(define (random-sign a b)
+  ((if (zero? (random-integer 2)) - +) a b))
+
+(define (randomly-generate-operands n+ d+ receiver)
+  (do ((i 0 (+ i 1))) ((>= i division-test-iterations))
+    (let ((n (n+ 0 (random-integer division-test-bound)))
+          (d (d+ 0 (+ 1 (random-integer (- division-test-bound 1))))))
+      (receiver n d))))
+
+(define (randomly-generate-divisors d+ receiver)
+  (do ((i 0 (+ i 1))) ((>= i division-test-iterations))
+    (let ((d (d+ 0 (+ 1 (random-integer (- division-test-bound 1))))))
+      (receiver d))))
+
+(define (randomly-test-division n+ d+ / quotient remainder divider)
+  (randomly-generate-operands n+ d+
+    (lambda (n d)
+      (let ((correct-q (divider n d)))
+        (check-division n d correct-q (quotient n d) (remainder n d))
+        (receive (q r) (/ n d)
+          (check-division n d correct-q q r))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:CEILING+/+
+  (lambda ()
+    (randomly-test-division + + ceiling/ ceiling-quotient ceiling-remainder
+      (lambda (n d) (ceiling (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:CEILING-/+
+  (lambda ()
+    (randomly-test-division - + ceiling/ ceiling-quotient ceiling-remainder
+      (lambda (n d) (ceiling (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:CEILING+/-
+  (lambda ()
+    (randomly-test-division + - ceiling/ ceiling-quotient ceiling-remainder
+      (lambda (n d) (ceiling (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:CEILING-/-
+  (lambda ()
+    (randomly-test-division - - ceiling/ ceiling-quotient ceiling-remainder
+      (lambda (n d) (ceiling (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:EUCLIDEAN+/+
+  (lambda ()
+    (randomly-test-division
+        + + euclidean/ euclidean-quotient euclidean-remainder
+      (lambda (n d) ((if (< d 0) ceiling floor) (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:EUCLIDEAN-/+
+  (lambda ()
+    (randomly-test-division
+        - + euclidean/ euclidean-quotient euclidean-remainder
+      (lambda (n d) ((if (< d 0) ceiling floor) (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:EUCLIDEAN+/-
+  (lambda ()
+    (randomly-test-division
+        + - euclidean/ euclidean-quotient euclidean-remainder
+      (lambda (n d) ((if (< d 0) ceiling floor) (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:EUCLIDEAN-/-
+  (lambda ()
+    (randomly-test-division
+        - - euclidean/ euclidean-quotient euclidean-remainder
+      (lambda (n d) ((if (< d 0) ceiling floor) (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:FLOOR+/+
+  (lambda ()
+    (randomly-test-division + + floor/ floor-quotient floor-remainder
+      (lambda (n d) (floor (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:FLOOR-/+
+  (lambda ()
+    (randomly-test-division - + floor/ floor-quotient floor-remainder
+      (lambda (n d) (floor (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:FLOOR+/-
+  (lambda ()
+    (randomly-test-division + - floor/ floor-quotient floor-remainder
+      (lambda (n d) (floor (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:FLOOR-/-
+  (lambda ()
+    (randomly-test-division - - floor/ floor-quotient floor-remainder
+      (lambda (n d) (floor (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:ROUND+/+
+  (lambda ()
+    (randomly-test-division + + round/ round-quotient round-remainder
+      (lambda (n d) (round (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:ROUND-/+
+  (lambda ()
+    (randomly-test-division - + round/ round-quotient round-remainder
+      (lambda (n d) (round (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:ROUND+/-
+  (lambda ()
+    (randomly-test-division + - round/ round-quotient round-remainder
+      (lambda (n d) (round (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:ROUND-/-
+  (lambda ()
+    (randomly-test-division - - round/ round-quotient round-remainder
+      (lambda (n d) (round (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:TRUNCATE+/+
+  (lambda ()
+    (randomly-test-division + + truncate/ truncate-quotient truncate-remainder
+      (lambda (n d) (truncate (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:TRUNCATE-/+
+  (lambda ()
+    (randomly-test-division - + truncate/ truncate-quotient truncate-remainder
+      (lambda (n d) (truncate (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:TRUNCATE+/-
+  (lambda ()
+    (randomly-test-division + - truncate/ truncate-quotient truncate-remainder
+      (lambda (n d) (truncate (/ n d))))))
+
+(define-test 'RANDOM-CORRECTNESS-TESTS:TRUNCATE-/-
+  (lambda ()
+    (randomly-test-division - - truncate/ truncate-quotient truncate-remainder
+      (lambda (n d) (truncate (/ n d))))))
+
+(define (randomly-test-properties / assert-property)
+  (randomly-generate-operands random-sign random-sign
+    (lambda (n d) (receive (q r) (/ n d) (assert-property n d q r)))))
+
+(define (assert-n=dq+r n d q r)
+  (assert-eqv (+ (* d q) r) n))
+
+(define-test 'N=DQ+R-TESTS:EUCLIDEAN
+  (lambda () (randomly-test-properties euclidean/ assert-n=dq+r)))
+
+(define-test 'N=DQ+R-TESTS:FLOOR
+  (lambda () (randomly-test-properties floor/ assert-n=dq+r)))
+
+(define-test 'N=DQ+R-TESTS:ROUND
+  (lambda () (randomly-test-properties round/ assert-n=dq+r)))
+
+(define-test 'N=DQ+R-TESTS:TRUNCATE
+  (lambda () (randomly-test-properties truncate/ assert-n=dq+r)))
+
+(define (assert-r<d n d q r)
+  n q                                   ;ignore
+  (assert-< (abs r) (abs d)))
+
+(define (assert-r<d* n d q r)
+  n q                                   ;ignore
+  (assert-< r (abs d)))
+
+(define-test 'R<D-TESTS:CEILING
+  (lambda () (randomly-test-properties ceiling/ assert-r<d)))
+
+(define-test 'R<D-TESTS:EUCLIDEAN
+  (lambda () (randomly-test-properties euclidean/ assert-r<d)))
+
+(define-test 'R<D-TESTS:EUCLIDEAN*
+  (lambda () (randomly-test-properties euclidean/ assert-r<d*)))
+
+(define-test 'R<D-TESTS:FLOOR
+  (lambda () (randomly-test-properties floor/ assert-r<d)))
+
+(define-test 'R<D-TESTS:ROUND
+  (lambda () (randomly-test-properties round/ assert-r<d)))
+
+(define-test 'R<D-TESTS:TRUNCATE
+  (lambda () (randomly-test-properties truncate/ assert-r<d)))
+
+(define (assert-integral-quotient n d q r)
+  n d r                                 ;ignore
+  (assert integer? "integer" q))
+
+(define-test 'INTEGRAL-QUOTIENT-TESTS:CEILING
+  (lambda () (randomly-test-properties ceiling/ assert-integral-quotient)))
+
+(define-test 'INTEGRAL-QUOTIENT-TESTS:EUCLIDEAN
+  (lambda () (randomly-test-properties euclidean/ assert-integral-quotient)))
+
+(define-test 'INTEGRAL-QUOTIENT-TESTS:FLOOR
+  (lambda () (randomly-test-properties floor/ assert-integral-quotient)))
+
+(define-test 'INTEGRAL-QUOTIENT-TESTS:ROUND
+  (lambda () (randomly-test-properties round/ assert-integral-quotient)))
+
+(define-test 'INTEGRAL-QUOTIENT-TESTS:TRUNCATE
+  (lambda () (randomly-test-properties truncate/ assert-integral-quotient)))
+
+(define (test-trivial-quotient quotient)
+  (assert-eqv (quotient +1 +1) +1)
+  (assert-eqv (quotient -1 +1) -1)
+  (assert-eqv (quotient +1 -1) -1)
+  (assert-eqv (quotient -1 -1) +1)
+  (assert-eqv (quotient 0 +1) 0)
+  (assert-eqv (quotient 0 -1) 0))
+
+(define (test-trivial/ /)
+  (test-trivial-quotient (lambda (n d) (receive (q r) (/ n d) r q))))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:CEILING-QUOTIENT
+  (lambda () (test-trivial-quotient ceiling-quotient)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:CEILING/
+  (lambda () (test-trivial/ ceiling/)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:EUCLIDEAN-QUOTIENT
+  (lambda () (test-trivial-quotient euclidean-quotient)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:EUCLIDEAN/
+  (lambda () (test-trivial/ euclidean/)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:FLOOR-QUOTIENT
+  (lambda () (test-trivial-quotient floor-quotient)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:FLOOR/
+  (lambda () (test-trivial/ floor/)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:ROUND-QUOTIENT
+  (lambda () (test-trivial-quotient round-quotient)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:ROUND/
+  (lambda () (test-trivial/ round/)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:TRUNCATE-QUOTIENT
+  (lambda () (test-trivial-quotient truncate-quotient)))
+
+(define-test 'TRIVIAL-DIVIDEND/TRIVIAL-DIVISOR-TESTS:TRUNCATE/
+  (lambda () (test-trivial/ truncate/)))
+
+(define-test 'TRIVIAL-DIVIDEND/RANDOM-DIVISOR-TESTS:CEILING
+  (lambda ()
+    (randomly-generate-divisors random-sign
+      (lambda (d)
+        (assert-eqv (ceiling-quotient 0 d) 0)
+        (if (< 1 (abs d))
+            (begin
+              (assert-eqv (ceiling-quotient +1 d) (if (negative? d) 0 +1))
+              (assert-eqv (ceiling-quotient -1 d)
+                          (if (negative? d) +1 0))))))))
+
+(define-test 'TRIVIAL-DIVIDEND/RANDOM-DIVISOR-TESTS:EUCLIDEAN
+  (lambda ()
+    (randomly-generate-divisors random-sign
+      (lambda (d)
+        (assert-eqv (euclidean-quotient 0 d) 0)
+        (if (< 1 (abs d))
+            (begin
+              (assert-eqv (euclidean-quotient +1 d) 0)
+              (assert-eqv (euclidean-quotient -1 d)
+                          (if (negative? d) +1 -1))))))))
+
+(define-test 'TRIVIAL-DIVIDEND/RANDOM-DIVISOR-TESTS:FLOOR
+  (lambda ()
+    (randomly-generate-divisors random-sign
+      (lambda (d)
+        (assert-eqv (floor-quotient 0 d) 0)
+        (if (< 1 (abs d))
+            (begin
+              (assert-eqv (floor-quotient -1 d) (if (negative? d) 0 -1))
+              (assert-eqv (floor-quotient +1 d) (if (negative? d) -1 0))))))))
+
+(define-test 'TRIVIAL-DIVIDEND/RANDOM-DIVISOR-TESTS:ROUND
+  (lambda ()
+    (randomly-generate-divisors random-sign
+      (lambda (d)
+        (assert-eqv (round-quotient -1 d) 0)
+        (assert-eqv (round-quotient 0 d) 0)
+        (assert-eqv (round-quotient +1 d) 0)))))
+
+(define-test 'TRIVIAL-DIVIDEND/RANDOM-DIVISOR-TESTS:TRUNCATE
+  (lambda ()
+    (randomly-generate-divisors random-sign
+      (lambda (d)
+        (assert-eqv (truncate-quotient -1 d) 0)
+        (assert-eqv (truncate-quotient 0 d) 0)
+        (assert-eqv (truncate-quotient +1 d) 0)))))
\ No newline at end of file