Commit 5053348e authored by pfdietz's avatar pfdietz

Tests for ceiling, fceiling, truncate, ftruncate. These tests are incomplete...

Tests for ceiling, fceiling, truncate, ftruncate.  These tests are incomplete (must test negative floats). Add finish-output call to rt::do-entries*.
parent a40e2ae7
;-*- 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)))
;-*- 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.
;-*- 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)))
;-*- 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)
;-*- 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)))
;-*- 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.
......@@ -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")
......@@ -353,6 +353,7 @@
(length new-failures)
new-failures)))
))
(finish-output s)
(null pending))))
;;; Note handling functions and macros
......
;-*- 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)