diff --git a/ansi-tests/floor-aux.lsp b/ansi-tests/floor-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..4f752c8dd7dd95088644d57bb3fae36ed83e599e --- /dev/null +++ b/ansi-tests/floor-aux.lsp @@ -0,0 +1,104 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Aug 9 08:08:00 2003 +;;;; Contains: Aux. functions used in FLOOR tests + +(in-package :cl-test) + +(defun floor.1-fn () + (loop for n = (- (random 2000000000) + 1000000000) + for d = (1+ (random 10000)) + for vals = (multiple-value-list (floor 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) + (< -1 r d)) + collect (list n d q r n2))) + +(defun floor.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 (floor 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 floor.3-fn (width) + (loop for n = (- (random width) (/ width 2)) + for vals = (multiple-value-list (floor 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 floor.7-fn () + (loop for numerator = (- (random 10000000000) 5000000000) + for denominator = (1+ (random 100000)) + for n = (/ numerator denominator) + for vals = (multiple-value-list (floor 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 floor.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 (floor 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 q d r n2))) + +(defun floor.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 (floor 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 q d r n2))) + diff --git a/ansi-tests/floor.lsp b/ansi-tests/floor.lsp new file mode 100644 index 0000000000000000000000000000000000000000..301284f4b17633d7eba766450be81f89c4b545b0 --- /dev/null +++ b/ansi-tests/floor.lsp @@ -0,0 +1,76 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Mon Aug 4 22:16:00 2003 +;;;; Contains: Tests of FLOOR + +(in-package :cl-test) + +(compile-and-load "numbers-aux.lsp") +(compile-and-load "floor-aux.lsp") + +(deftest floor.error.1 + (classify-error (floor)) + program-error) + +(deftest floor.error.2 + (classify-error (floor 1.0 1 nil)) + program-error) + +;;; + +(deftest floor.1 + (floor.1-fn) + nil) + +(deftest floor.2 + (floor.2-fn) + nil) + +(deftest floor.3 + (floor.3-fn 2.0s4) + nil) + +(deftest floor.4 + (floor.3-fn 2.0f4) + nil) + +(deftest floor.5 + (floor.3-fn 2.0d4) + nil) + +(deftest floor.6 + (floor.3-fn 2.0l4) + nil) + +(deftest floor.7 + (floor.7-fn) + nil) + +(deftest floor.8 + (floor.8-fn) + nil) + +(deftest floor.9 + (floor.9-fn) + nil) + +(deftest floor.10 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (floor x x)) + unless (and (eql q 1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + +(deftest floor.11 + (loop for x in (remove-if #'zerop *reals*) + for (q r) = (multiple-value-list (floor (- x) x)) + unless (and (eql q -1) + (zerop r) + (if (rationalp x) (eql r 0) + (eql r (float 0 x)))) + collect x) + nil) + diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index e8fd49722fdefd98f7b4e6561fc02157c04cc323..0b0d45c68119f26794eabde244712a0def0d3882 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -12,3 +12,4 @@ (load "minusp.lsp") (load "plusp.lsp") (load "zerop.lsp") +(load "floor.lsp") diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index df62793555f38c3c68b3120d5d95000181297c46..b19fb793cb432a0bda4f499d803bc452b6e51072 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -126,3 +126,43 @@ unless (and (<= m x) (<= m y) (or (= m x) (= m y))) collect (list x y m)))) + +(defun random-nonnegative-real () + (if (coin 3) + (random-case + (/ (random 10000) (1+ (random 1000))) + (/ (random 1000000) (1+ (random 100000))) + (/ (random 100000000) (1+ (random 10000000))) + (/ (random 1000000000000) (1+ (random 10000000)))) + (random (random-case + 1000 + 100000 + 10000000 + 1000000000 + (expt 2.0s0 (random 15)) + (expt 2.0f0 (random 32)) + (expt 2.0d0 (random 32)) + (expt 2.0l0 (random 32)))))) + +(defun random-real () + (if (coin) (random-nonnegative-real) + (- (random-nonnegative-real)))) + +(defun epsilon (number) + (etypecase number + (short-float short-float-epsilon) + (single-float single-float-epsilon) + (double-float double-float-epsilon) + (long-float long-float-epsilon) + (rational 0))) + +(defun negative-epsilon (number) + (etypecase number + (short-float short-float-negative-epsilon) + (single-float single-float-negative-epsilon) + (double-float double-float-negative-epsilon) + (long-float long-float-negative-epsilon) + (rational 0))) + + + diff --git a/ansi-tests/random-aux.lsp b/ansi-tests/random-aux.lsp index 15fd7c9a886f802e559a5806a47c4cd08d47d8fb..997b5f56eec2115b66dd553540a4f110dc88cb4c 100644 --- a/ansi-tests/random-aux.lsp +++ b/ansi-tests/random-aux.lsp @@ -16,7 +16,7 @@ (assert (> len 0)) `(case (random ,len) ,@(loop for i from 0 for e in cases collect `(,i ,e)) - (t (error "Can't happen?! (in random-case~%"))))) + (t (error "Can't happen?! (in random-case)~%"))))) (defun coin (&optional (n 2)) "Flip an n-sided coin."