From 7d163d59311b7a2c7db2ae67fd9c515d6ea7a4a5 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 9 Aug 2003 18:13:35 +0000
Subject: [PATCH] Tests of FLOOR, and some infrastructure for generating random
 inputs (not fully used).  I haven't fully tested FLOOR since its standardized
 behavior in the face of float imprecision is not entirely clear.

---
 ansi-tests/floor-aux.lsp    | 104 ++++++++++++++++++++++++++++++++++++
 ansi-tests/floor.lsp        |  76 ++++++++++++++++++++++++++
 ansi-tests/load-numbers.lsp |   1 +
 ansi-tests/numbers-aux.lsp  |  40 ++++++++++++++
 ansi-tests/random-aux.lsp   |   2 +-
 5 files changed, 222 insertions(+), 1 deletion(-)
 create mode 100644 ansi-tests/floor-aux.lsp
 create mode 100644 ansi-tests/floor.lsp

diff --git a/ansi-tests/floor-aux.lsp b/ansi-tests/floor-aux.lsp
new file mode 100644
index 00000000..4f752c8d
--- /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 00000000..301284f4
--- /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 e8fd4972..0b0d45c6 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 df627935..b19fb793 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 15fd7c9a..997b5f56 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."
-- 
GitLab