Commit 17afbab3 authored by pfdietz's avatar pfdietz
Browse files

Tests of ROUND, FROUND.

parent 73421c7c
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Aug 21 16:08:55 2003
;;;; Contains: Aux. functions for testing FROUND
(in-package :cl-test)
(defun fround.1-fn ()
(loop for n = (- (random 200000)
100000)
for d = (1+ (random 10000))
for vals = (multiple-value-list (fround 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 2)) r (/ d 2))
(or (/= (abs r) (/ d 2))
(evenp (coerce q 'integer))))
collect (list n d q r n2)))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Aug 21 16:07:59 2003
;;;; Contains: Tests of FROUND
(in-package :cl-test)
(compile-and-load "numbers-aux.lsp")
(compile-and-load "fround-aux.lsp")
(deftest fround.error.1
(classify-error (fround))
program-error)
(deftest fround.error.2
(classify-error (fround 1.0 1 nil))
program-error)
;;;
(deftest fround.1
(fround.1-fn)
nil)
(deftest fround.10
(loop for x in (remove-if #'zerop *reals*)
for (q r) = (multiple-value-list (fround 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 fround.11
(loop for x in (remove-if-not #'floatp (remove-if #'zerop *reals*))
for (q r) = (multiple-value-list (fround (- 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 fround.12
(let* ((radix (float-radix 1.0s0))
(rad (float radix 1.0s0))
(rrad (/ 0.5s0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'short-float))
(eql r rrad))
collect (list i x q r)))
nil)
(deftest fround.13
(let* ((radix (float-radix 1.0s0))
(rad (float radix 1.0s0))
(rrad (/ 0.5s0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'short-float))
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest fround.14
(let* ((radix (float-radix 1.0f0))
(rad (float radix 1.0f0))
(rrad (/ 0.5f0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'single-float))
(eql r rrad))
collect (list i x q r)))
nil)
(deftest fround.15
(let* ((radix (float-radix 1.0f0))
(rad (float radix 1.0f0))
(rrad (/ 0.5f0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'single-float))
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest fround.16
(let* ((radix (float-radix 1.0d0))
(rad (float radix 1.0d0))
(rrad (/ 0.5d0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'double-float))
(eql r rrad))
collect (list i x q r)))
nil)
(deftest fround.17
(let* ((radix (float-radix 1.0d0))
(rad (float radix 1.0d0))
(rrad (/ 0.5d0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'double-float))
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest fround.18
(let* ((radix (float-radix 1.0l0))
(rad (float radix 1.0l0))
(rrad (/ 0.5l0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'long-float))
(eql r rrad))
collect (list i x q r)))
nil)
(deftest fround.19
(let* ((radix (float-radix 1.0l0))
(rad (float radix 1.0l0))
(rrad (/ 0.5l0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (fround x))
unless (and (eql q (coerce i 'long-float))
(eql r (- rrad)))
collect (list i x q r)))
nil)
......@@ -18,5 +18,7 @@
(load "fceiling.lsp")
(load "truncate.lsp")
(load "ftruncate.lsp")
(load "round.lsp")
(load "fround.lsp")
(load "epsilons.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Aug 21 14:21:07 2003
;;;; Contains: Aux. functions for testing ROUND
(in-package :cl-test)
(defun round.1-fn ()
(loop for n = (- (random 2000000000)
1000000000)
for d = (1+ (random 10000))
for vals = (multiple-value-list (round n d))
for (q r) = vals
for n2 = (+ (* q d) r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(= n n2)
(integerp r)
(<= (- (/ d 2)) r (/ d 2)))
unless (or (not (= (abs r) (/ d 2)))
(evenp q))
collect (list n d q r n2)))
(defun round.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 (round n d))
for (q r) = vals
for n2 = (+ (* q d) r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(<= (- (/ d 2)) r (/ d 2))
(or (not (= (abs r) (/ d 2)))
(evenp q))
(= n n2))
collect (list n d q r n2)))
(defun round.3-fn (width)
(loop for n = (- (random width) (/ width 2))
for vals = (multiple-value-list (round n))
for (q r) = vals
for n2 = (+ q r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(= n n2)
(<= -1/2 r 1/2)
(or (not (= (abs r) 1/2))
(evenp q))
)
collect (list n q r n2)))
(defun round.7-fn ()
(loop for numerator = (- (random 10000000000) 5000000000)
for denominator = (1+ (random 100000))
for n = (/ numerator denominator)
for vals = (multiple-value-list (round n))
for (q r) = vals
for n2 = (+ q r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(rationalp r)
(= n n2)
(<= -1/2 r 1/2)
(or (not (= (abs r) 1/2))
(evenp q))
)
collect (list n q r n2)))
(defun round.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 (round n d))
for (q r) = vals
for n2 = (+ (* q d) r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(rationalp r)
(<= (/ d 2) r (- (/ d 2)))
(or (not (= (abs r) (- (/ d 2))))
(evenp q))
(= n n2))
collect (list n q d r n2)))
(defun round.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 (round n d))
for (q r) = vals
for n2 = (+ (* q d) r)
repeat 10
unless (and (eql (length vals) 2)
(integerp q)
(rationalp r)
(<= (/ d 2) r (- (/ d 2)))
(or (not (= (abs r) (- (/ d 2))))
(evenp q))
(= n n2))
collect (list n q d r n2)))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Aug 21 13:39:56 2003
;;;; Contains: Tests of ROUND
(in-package :cl-test)
(compile-and-load "numbers-aux.lsp")
(compile-and-load "round-aux.lsp")
(deftest round.error.1
(classify-error (round))
program-error)
(deftest round.error.2
(classify-error (round 1.0 1 nil))
program-error)
;;;
(deftest round.1
(round.1-fn)
nil)
(deftest round.2
(round.2-fn)
nil)
(deftest round.3
(round.3-fn 2.0s4)
nil)
(deftest round.4
(round.3-fn 2.0f4)
nil)
(deftest round.5
(round.3-fn 2.0d4)
nil)
(deftest round.6
(round.3-fn 2.0l4)
nil)
(deftest round.7
(round.7-fn)
nil)
(deftest round.8
(round.8-fn)
nil)
(deftest round.9
(round.9-fn)
nil)
(deftest round.10
(loop for x in (remove-if #'zerop *reals*)
for (q r) = (multiple-value-list (round x x))
unless (and (eql q 1)
(zerop r)
(if (rationalp x) (eql r 0)
(eql r (float 0 x))))
collect x)
nil)
(deftest round.11
(loop for x in (remove-if #'zerop *reals*)
for (q r) = (multiple-value-list (round (- x) x))
unless (and (eql q -1)
(zerop r)
(if (rationalp x) (eql r 0)
(eql r (float 0 x))))
collect x)
nil)
(deftest round.12
(let* ((radix (float-radix 1.0s0))
(rad (float radix 1.0s0))
(rrad (/ 0.5s0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r rrad))
collect (list i x q r)))
nil)
(deftest round.13
(let* ((radix (float-radix 1.0s0))
(rad (float radix 1.0s0))
(rrad (/ 0.5s0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest round.14
(let* ((radix (float-radix 1.0f0))
(rad (float radix 1.0f0))
(rrad (/ 0.5f0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r rrad))
collect (list i x q r)))
nil)
(deftest round.15
(let* ((radix (float-radix 1.0f0))
(rad (float radix 1.0f0))
(rrad (/ 0.5f0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest round.16
(let* ((radix (float-radix 1.0d0))
(rad (float radix 1.0d0))
(rrad (/ 0.5d0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r rrad))
collect (list i x q r)))
nil)
(deftest round.17
(let* ((radix (float-radix 1.0d0))
(rad (float radix 1.0d0))
(rrad (/ 0.5d0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest round.18
(let* ((radix (float-radix 1.0l0))
(rad (float radix 1.0l0))
(rrad (/ 0.5l0 rad)))
(loop for i from 1 to 1000
for x = (+ i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r rrad))
collect (list i x q r)))
nil)
(deftest round.19
(let* ((radix (float-radix 1.0l0))
(rad (float radix 1.0l0))
(rrad (/ 0.5l0 rad)))
(loop for i from 1 to 1000
for x = (- i rrad)
for (q r) = (multiple-value-list (round x))
unless (and (eql q i)
(eql r (- rrad)))
collect (list i x q r)))
nil)
(deftest round.20
(round 1/2)
0 1/2)
(deftest round.21
(round 3/2)
2 -1/2)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment