diff --git a/ansi-tests/ceiling-aux.lsp b/ansi-tests/ceiling-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..11f846b67f419eb419d77dbd9751ed0d1edac50a --- /dev/null +++ b/ansi-tests/ceiling-aux.lsp @@ -0,0 +1,106 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 19 06:52:02 2003 +;;;; Contains: Aux. functions for CEILING + +(in-package :cl-test) + +(defun ceiling.1-fn () + (loop for n = (- (random 2000000000) + 1000000000) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (ceiling n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (= n n2) + (integerp r) + (< (- d) r 1)) + collect (list n d q r n2))) + +(defun ceiling.2-fn () + (loop for num = (random 1000000000) + for denom = (1+ (random 1000)) + for n = (/ num denom) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (ceiling n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (<= r 0) + (< (- d) r) + (= n n2)) + collect (list n d q r n2))) + +(defun ceiling.3-fn (width) + (loop for n = (- (random width) (/ width 2)) + for vals = (multiple-value-list (ceiling n)) + for (q r) = vals + for n2 = (+ q r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (= n n2) + (<= 0 (- r)) + (< (- r) 1) + ) + collect (list n q r n2))) + +(defun ceiling.7-fn () + (loop for numerator = (- (random 10000000000) 5000000000) + for denominator = (1+ (random 100000)) + for n = (/ numerator denominator) + for vals = (multiple-value-list (ceiling n)) + for (q r) = vals + for n2 = (+ q r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (= n n2) + (<= 0 (- r)) + (< (- r) 1) + ) + collect (list n q r n2))) + +(defun ceiling.8-fn () + (loop for num1 = (- (random 10000000000) 5000000000) + for den1 = (1+ (random 100000)) + for n = (/ num1 den1) + for num2 = (- (1+ (random 1000000))) + for den2 = (1+ (random 1000000)) + for d = (/ num2 den2) + for vals = (multiple-value-list (ceiling n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (<= 0 r) + (< r (- d)) + (= n n2)) + collect (list n q d r n2))) + +(defun ceiling.9-fn () + (loop for num1 = (- (random 1000000000000000) 500000000000000) + for den1 = (1+ (random 10000000000)) + for n = (/ num1 den1) + for num2 = (- (1+ (random 1000000000))) + for den2 = (1+ (random 10000000)) + for d = (/ num2 den2) + for vals = (multiple-value-list (ceiling n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (<= 0 r) + (< r (- d)) + (= n n2)) + collect (list n q d r n2))) diff --git a/ansi-tests/ceiling.lsp b/ansi-tests/ceiling.lsp new file mode 100644 index 0000000000000000000000000000000000000000..0fe33885a13c4bbfc2ce1f41df65c6cf38da8dff --- /dev/null +++ b/ansi-tests/ceiling.lsp @@ -0,0 +1,176 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Aug 19 06:50:44 2003 +;;;; Contains: Tests of CEILING + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "ceiling-aux.lsp") + +(deftest ceiling.error.1 + (classify-error (ceiling)) + program-error) + +(deftest ceiling.error.2 + (classify-error (ceiling 1.0 1 nil)) + program-error) + +;;; + +(deftest ceiling.1 + (ceiling.1-fn) + nil) + +(deftest ceiling.2 + (ceiling.2-fn) + nil) + +(deftest ceiling.3 + (ceiling.3-fn 2.0s4) + nil) + +(deftest ceiling.4 + (ceiling.3-fn 2.0f4) + nil) + +(deftest ceiling.5 + (ceiling.3-fn 2.0d4) + nil) + +(deftest ceiling.6 + (ceiling.3-fn 2.0l4) + nil) + +(deftest ceiling.7 + (ceiling.7-fn) + nil) + +(deftest ceiling.8 + (ceiling.8-fn) + nil) + +(deftest ceiling.9 + (ceiling.9-fn) + nil) + +(deftest ceiling.10 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (ceiling x x)) + unless (and (eql q 1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + +(deftest ceiling.11 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (ceiling (- x) x)) + unless (and (eql q -1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + +(deftest ceiling.12 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q (1+ i)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.13 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q i) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.14 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q (1+ i)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.15 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q i) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.16 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q (1+ i)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.17 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q i) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.18 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q (1+ i)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest ceiling.19 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ceiling x)) + unless (and (eql q i) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +;;; To add: tests that involve adding/subtracting EPSILON constants +;;; (suitably scaled) to floated integers. + + diff --git a/ansi-tests/fceiling-aux.lsp b/ansi-tests/fceiling-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..dd6581d85b5b86eb6e03f95bcc2dae4a50c25f37 --- /dev/null +++ b/ansi-tests/fceiling-aux.lsp @@ -0,0 +1,21 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 06:24:45 2003 +;;;; Contains: Tests of FCEILING + +(in-package :cl-test) + +(defun fceiling.1-fn () + (loop for n = (- (random 200000) + 100000) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (fceiling n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 100 + unless (and (eql (length vals) 2) + (floatp q) + (= n n2) + (integerp r) + (< (- d) r 1)) + collect (list n d q r n2))) diff --git a/ansi-tests/fceiling.lsp b/ansi-tests/fceiling.lsp new file mode 100644 index 0000000000000000000000000000000000000000..b7caefd0f2295684d0b9747002d9fe500f2e96f2 --- /dev/null +++ b/ansi-tests/fceiling.lsp @@ -0,0 +1,147 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 06:22:23 2003 +;;;; Contains: Tests of FCEILING + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "fceiling-aux.lsp") + +(deftest fceiling.error.1 + (classify-error (fceiling)) + program-error) + +(deftest fceiling.error.2 + (classify-error (fceiling 1.0 1 nil)) + program-error) + +;;; + +(deftest fceiling.1 + (fceiling.1-fn) + nil) + +(deftest fceiling.10 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (fceiling x x)) + unless (and (floatp q) + (if (floatp x) + (eql q (float 1 x)) + (= q 1)) + (zerop r) + (if (floatp x) + (eql r (float 0 x)) + (= r 0))) + collect x) + nil) + +(deftest fceiling.11 + (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*)) + for (q r) = (multiple-value-list (fceiling (- x) x)) + unless (and (floatp q) + (if (floatp x) + (eql q (float -1 x)) + (= q -1)) + (zerop r) + (if (floatp x) + (eql r (float 0 x)) + (= r 0))) + collect x) + nil) + +(deftest fceiling.12 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce (1+ i) 'short-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.13 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce i 'short-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.14 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce (1+ i) 'single-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.15 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce i 'single-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.16 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce (1+ i) 'double-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.17 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce i 'double-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.18 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce (1+ i) 'long-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) + +(deftest fceiling.19 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (fceiling x)) + unless (and (eql q (coerce i 'long-float)) + (eql r (- rrad 1))) + collect (list i x q r))) + nil) diff --git a/ansi-tests/ftruncate-aux.lsp b/ansi-tests/ftruncate-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..157fe7e0794d1d1bd2c8aa9d3cda5a4ebe507d60 --- /dev/null +++ b/ansi-tests/ftruncate-aux.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 06:37:01 2003 +;;;; Contains: Aux. functions for testing FTRUNCATE + +(in-package :cl-test) + +(defun ftruncate.1-fn () + (loop for n = (- (random 200000) + 100000) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (ftruncate n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 100 + unless (and (eql (length vals) 2) + (floatp q) + (= n n2) + (integerp r) + (if (>= n 0) + (< -1 r d) + (< -1 (- r) d))) + collect (list n d q r n2))) diff --git a/ansi-tests/ftruncate.lsp b/ansi-tests/ftruncate.lsp new file mode 100644 index 0000000000000000000000000000000000000000..86df3340b43d5b21a56a64017f006146204bab0b --- /dev/null +++ b/ansi-tests/ftruncate.lsp @@ -0,0 +1,150 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 06:36:35 2003 +;;;; Contains: Tests of FTRUNCATE + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "ftruncate-aux.lsp") + +(deftest ftruncate.error.1 + (classify-error (ftruncate)) + program-error) + +(deftest ftruncate.error.2 + (classify-error (ftruncate 1.0 1 nil)) + program-error) + +;;; + +(deftest ftruncate.1 + (ftruncate.1-fn) + nil) + +(deftest ftruncate.10 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (ftruncate x x)) + unless (and (floatp q) + (if (floatp x) + (eql q (float 1 x)) + (= q 1)) + (zerop r) + (if (floatp x) + (eql r (float 0 x)) + (= r 0))) + collect x) + nil) + +(deftest ftruncate.11 + (loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*)) + for (q r) = (multiple-value-list (ftruncate (- x) x)) + unless (and (floatp q) + (if (floatp x) + (eql q (float -1 x)) + (= q -1)) + (zerop r) + (if (floatp x) + (eql r (float 0 x)) + (= r 0))) + collect x) + nil) + +(deftest ftruncate.12 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce i 'short-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.13 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce (1- i) 'short-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.14 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce i 'single-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.15 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce (1- i) 'single-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.16 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce i 'double-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.17 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce (1- i) 'double-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.18 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce i 'long-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest ftruncate.19 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (ftruncate x)) + unless (and (eql q (coerce (1- i) 'long-float)) + (eql r rrad)) + collect (list i x q r))) + nil) + +;;; To add: tests that involve adding/subtracting EPSILON constants +;;; (suitably scaled) to floated integers. diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index b6da241ac3d425b7721ae8affbd01120c416dfe9..bcf3c5cbafd6eb466c4d896f5c859d119ad3e93c 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -14,3 +14,7 @@ (load "zerop.lsp") (load "floor.lsp") (load "ffloor.lsp") +(load "ceiling.lsp") +(load "fceiling.lsp") +(load "truncate.lsp") +(load "ftruncate.lsp") diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp index 48e4729b323add5e05d27aa6e694c4d80c55fe1c..9794c1a960557166b5bb8ed22f40f9e5bb7f0dda 100644 --- a/ansi-tests/rt.lsp +++ b/ansi-tests/rt.lsp @@ -353,6 +353,7 @@ (length new-failures) new-failures))) )) + (finish-output s) (null pending)))) ;;; Note handling functions and macros diff --git a/ansi-tests/truncate-aux.lsp b/ansi-tests/truncate-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..0ab7aadd11c9832a30bb7a6c929fb9277acaf348 --- /dev/null +++ b/ansi-tests/truncate-aux.lsp @@ -0,0 +1,113 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 05:15:17 2003 +;;;; Contains: Aux. functions associated with tests of TRUNCATE + +(in-package :cl-test) + +(defun truncate.1-fn () + (loop for n = (- (random 2000000000) + 1000000000) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (truncate n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (= n n2) + (integerp r) + (if (>= n 0) (< -1 r d) + (< (- d) r 1))) + collect (list n d q r n2))) + +(defun truncate.2-fn () + (loop for num = (random 1000000000) + for denom = (1+ (random 1000)) + for n = (/ num denom) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (truncate n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (<= 0 r) + (< r d) + (= n n2)) + collect (list n d q r n2))) + +(defun truncate.3-fn (width) + (loop for n = (- (random width) (/ width 2)) + for vals = (multiple-value-list (truncate n)) + for (q r) = vals + for n2 = (+ q r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (= n n2) + (if (>= n 0) + (and (<= 0 r) (< r 1)) + (and (< -1 r) (<= r 0))) + ) + collect (list n q r n2))) + +(defun truncate.7-fn () + (loop for numerator = (- (random 10000000000) 5000000000) + for denominator = (1+ (random 100000)) + for n = (/ numerator denominator) + for vals = (multiple-value-list (truncate n)) + for (q r) = vals + for n2 = (+ q r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (= n n2) + (if (>= n 0) + (and (<= 0 r) (< r 1)) + (and (< -1 r) (<= r 0))) + ) + collect (list n q r n2))) + +(defun truncate.8-fn () + (loop for num1 = (- (random 10000000000) 5000000000) + for den1 = (1+ (random 100000)) + for n = (/ num1 den1) + for num2 = (- (1+ (random 1000000))) + for den2 = (1+ (random 1000000)) + for d = (/ num2 den2) + for vals = (multiple-value-list (truncate n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (if (> n 0) + (and (<= 0 r) (< r (- d))) + (and (>= 0 r) (> r d))) + (= n n2)) + collect (list n q d r n2))) + +(defun truncate.9-fn () + (loop for num1 = (- (random 1000000000000000) 500000000000000) + for den1 = (1+ (random 10000000000)) + for n = (/ num1 den1) + for num2 = (- (1+ (random 1000000000))) + for den2 = (1+ (random 10000000)) + for d = (/ num2 den2) + for vals = (multiple-value-list (truncate n d)) + for (q r) = vals + for n2 = (+ (* q d) r) + repeat 10000 + unless (and (eql (length vals) 2) + (integerp q) + (rationalp r) + (if (> n 0) + (and (<= 0 r) (< r (- d))) + (and (>= 0 r) (> r d))) + (= n n2)) + collect (list n q d r n2))) + + diff --git a/ansi-tests/truncate.lsp b/ansi-tests/truncate.lsp new file mode 100644 index 0000000000000000000000000000000000000000..74378681e6fc60104782ba5b0d32774774ba5c5f --- /dev/null +++ b/ansi-tests/truncate.lsp @@ -0,0 +1,171 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Aug 20 05:13:26 2003 +;;;; Contains: Tests of TRUNCATE + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "truncate-aux.lsp") + +(deftest truncate.error.1 + (classify-error (truncate)) + program-error) + +(deftest truncate.error.2 + (classify-error (truncate 1.0 1 nil)) + program-error) + +;;; + +(deftest truncate.1 + (truncate.1-fn) + nil) + +(deftest truncate.2 + (truncate.2-fn) + nil) + +(deftest truncate.3 + (truncate.3-fn 2.0s4) + nil) + +(deftest truncate.4 + (truncate.3-fn 2.0f4) + nil) + +(deftest truncate.5 + (truncate.3-fn 2.0d4) + nil) + +(deftest truncate.6 + (truncate.3-fn 2.0l4) + nil) + +(deftest truncate.7 + (truncate.7-fn) + nil) + +(deftest truncate.8 + (truncate.8-fn) + nil) + +(deftest truncate.9 + (truncate.9-fn) + nil) + +(deftest truncate.10 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (truncate x x)) + unless (and (eql q 1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + +(deftest truncate.11 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (truncate (- x) x)) + unless (and (eql q -1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + +(deftest truncate.12 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q i) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.13 + (let* ((radix (float-radix 1.0s0)) + (rad (float radix 1.0s0)) + (rrad (/ 1.0s0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q (1- i)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.14 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q i) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.15 + (let* ((radix (float-radix 1.0f0)) + (rad (float radix 1.0f0)) + (rrad (/ 1.0f0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q (1- i)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.16 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q i) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.17 + (let* ((radix (float-radix 1.0d0)) + (rad (float radix 1.0d0)) + (rrad (/ 1.0d0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q (1- i)) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.18 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (+ i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q i) + (eql r rrad)) + collect (list i x q r))) + nil) + +(deftest truncate.19 + (let* ((radix (float-radix 1.0l0)) + (rad (float radix 1.0l0)) + (rrad (/ 1.0l0 rad))) + (loop for i from 1 to 1000 + for x = (- i rrad) + for (q r) = (multiple-value-list (truncate x)) + unless (and (eql q (1- i)) + (eql r rrad)) + collect (list i x q r))) + nil)