From 5053348e33a487244528292266a69fddf57a4c12 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 20 Aug 2003 12:38:33 +0000 Subject: [PATCH] Tests for ceiling, fceiling, truncate, ftruncate. These tests are incomplete (must test negative floats). Add finish-output call to rt::do-entries*. --- ansi-tests/ceiling-aux.lsp | 106 +++++++++++++++++++++ ansi-tests/ceiling.lsp | 176 +++++++++++++++++++++++++++++++++++ ansi-tests/fceiling-aux.lsp | 21 +++++ ansi-tests/fceiling.lsp | 147 +++++++++++++++++++++++++++++ ansi-tests/ftruncate-aux.lsp | 23 +++++ ansi-tests/ftruncate.lsp | 150 +++++++++++++++++++++++++++++ ansi-tests/load-numbers.lsp | 4 + ansi-tests/rt.lsp | 1 + ansi-tests/truncate-aux.lsp | 113 ++++++++++++++++++++++ ansi-tests/truncate.lsp | 171 ++++++++++++++++++++++++++++++++++ 10 files changed, 912 insertions(+) create mode 100644 ansi-tests/ceiling-aux.lsp create mode 100644 ansi-tests/ceiling.lsp create mode 100644 ansi-tests/fceiling-aux.lsp create mode 100644 ansi-tests/fceiling.lsp create mode 100644 ansi-tests/ftruncate-aux.lsp create mode 100644 ansi-tests/ftruncate.lsp create mode 100644 ansi-tests/truncate-aux.lsp create mode 100644 ansi-tests/truncate.lsp diff --git a/ansi-tests/ceiling-aux.lsp b/ansi-tests/ceiling-aux.lsp new file mode 100644 index 00000000..11f846b6 --- /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 00000000..0fe33885 --- /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 00000000..dd6581d8 --- /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 00000000..b7caefd0 --- /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 00000000..157fe7e0 --- /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 00000000..86df3340 --- /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 b6da241a..bcf3c5cb 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 48e4729b..9794c1a9 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 00000000..0ab7aadd --- /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 00000000..74378681 --- /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) -- GitLab