Commit ae351789 authored by pfdietz's avatar pfdietz

Use RATIONAL in place of RATIONALIZE in some places. Add tests for /, RATIONAL, RATIONALIZE.

parent e90c7cc4
......@@ -302,8 +302,11 @@ the condition to go uncaught if it cannot be classified."
(stream-error () 'stream-error)
(reader-error () 'reader-error)
(file-error () 'file-error)
(control-error () 'control-error)
(cell-error () 'cell-error)
(division-by-zero () 'division-by-zero)
(floating-pointer-overflow () 'floating-point-overflow)
(floating-pointer-underflow () 'floating-point-underflow)
(arithmethic-error () 'arithmetic-error)
(error () 'error)
)))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 31 20:20:15 2003
;;;; Contains: Tests of the / function
(in-package :cl-test)
(compile-and-load "numbers-aux.lsp")
(compile-and-load "division-aux.lsp")
(deftest /.error.1
(classify-error (/))
program-error)
(deftest /.error.2
(divide-by-zero-test 0))
(deftest /.error.3
(divide-by-zero-test 1 0))
(deftest /.error.4
(divide-by-zero-test 17 10 0 11))
(deftest /.error.5
(divide-by-zero-test 0.0s0))
(deftest /.error.6
(divide-by-zero-test 0.0f0))
(deftest /.error.7
(divide-by-zero-test 0.0d0))
(deftest /.error.8
(divide-by-zero-test 0.0l0))
;;;;;;;;;;
(deftest /.1
(/ 1)
1)
(deftest /.2
(/ -1)
-1)
(deftest /.3
(loop for i = (random-fixnum)
repeat 10000
unless (or (zerop i)
(let ((q1 (/ i))
(q2 (/ 1 i)))
(and (rationalp q1)
(eql (denominator q1) (abs i))
(eql (numerator q1) (signum i))
(eql q1 q2)
(eql (* q1 i) 1))))
collect i)
nil)
(deftest /.4
(loop for i = (random-from-interval 1000000 1)
for j = (random-from-interval 1000000 1)
for g = (gcd i j)
for q = (/ i j)
for q2 = (/ j)
repeat 10000
unless (and (integerp g)
(zerop (mod i g))
(zerop (mod j g))
(eql (numerator q) (/ i g))
(eql (denominator q) (/ j g))
(eql (/ q) (/ j i))
(eql q (* i q2)))
collect (list i j q))
nil)
(deftest /.5
(loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
nconc
(loop for i = (1+ (random bound))
for r1 = (/ i)
for r2 = (/ 1 i)
repeat 10000
unless (eql r1 r2)
collect (list i r1 r2)))
nil)
;; Complex division
(deftest /.6
(loop for i1 = (random-fixnum)
for i = (if (zerop i1) 1 i1)
for c = (complex 0 i)
for r = (/ c)
repeat 10000
unless (eql r (complex 0 (- (/ i))))
collect (list i c r))
nil)
(deftest /.7
(loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
nconc
(loop for i = (1+ (random bound))
for c = (complex 0 i)
for r = (/ c)
repeat 10000
unless (eql r (complex 0 (- (/ i))))
collect (list i c r)))
nil)
(deftest /.8
(loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20)
for one = (float 1.0 bound)
for zero = (float 0.0 bound)
nconc
(loop for i = (1+ (random bound))
for j = (1+ (random bound))
for c = (complex i zero)
for q = (/ c c)
repeat 100
unless (eql q (complex one zero))
collect (list i j c q)))
nil)
(deftest /.9
(loop for a = (random-fixnum)
for b = (random-fixnum)
for m = (+ (* a a) (* b b))
repeat 10000
unless
(or (zerop m)
(let* ((q (/ (complex a b)))
(c (/ a m))
(d (/ (- b) m))
(expected (complex c d)))
(eql q expected)))
collect (list a b (/ (complex a b))))
nil)
(deftest /.10
(let ((bound 1000000000000000000))
(loop for a = (random-from-interval bound)
for b = (random-from-interval bound)
for m = (+ (* a a) (* b b))
repeat 10000
unless
(or (zerop m)
(let* ((q (/ (complex a b)))
(c (/ a m))
(d (/ (- b) m))
(expected (complex c d)))
(eql q expected)))
collect (list a b (/ (complex a b)))))
nil)
(deftest /.11
(loop for a = (random-fixnum)
for b = (random-fixnum)
for n = (complex (random-fixnum) (random-fixnum))
for m = (+ (* a a) (* b b))
repeat 10000
unless
(or (zerop m)
(let* ((q (/ n (complex a b)))
(c (/ a m))
(d (/ (- b) m))
(expected (* n (complex c d))))
(eql q expected)))
collect (list a b (/ n (complex a b))))
nil)
;;; More floating point tests
(deftest /.12
(loop for type in '(short-float single-float double-float long-float)
for lower in (mapcar
#'rational
(list
least-positive-short-float least-positive-single-float
least-positive-double-float least-positive-long-float))
for upper in (mapcar
#'rational
(list
most-positive-short-float most-positive-single-float
most-positive-double-float most-positive-long-float))
for one = (coerce 1 type)
for radix = (float-radix one)
nconc
(loop
for i from 1
for rpos = radix then (* rpos radix)
for rneg = (/ radix) then (/ rneg radix)
while (<= lower rneg rpos upper)
unless
(let ((frpos (float rpos one))
(frneg (float rneg one)))
(and (eql (/ frpos) (/ one frpos))
(eql (/ frpos) (/ 1.0s0 frpos))
(eql (/ frpos) (/ 1 frpos))
(eql (/ frpos) frneg)
(eql (/ frneg) (/ 1.0s0 frneg))
(eql (/ frneg) (/ 1 frneg))
(eql (/ frneg) frpos)))
collect (list i rpos rneg (float rpos one) (float rneg one))))
nil)
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Sep 1 07:57:02 2003
;;;; Contains: Aux. functions for testing /
(in-package :cl-test)
(defun divide-by-zero-test (&rest args)
(handler-case
(progn (apply #'/ args) (values))
(division-by-zero () (values))
(condition (c) c)))
......@@ -26,6 +26,10 @@
(load "times.lsp")
(load "plus.lsp")
(load "minus.lsp")
(load "divide.lsp")
(load "rational.lsp")
(load "rationalize.lsp")
(load "evenp.lsp")
(load "oddp.lsp")
......
......@@ -384,8 +384,8 @@
most-negative-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x) (class-of bound))
(<= (rationalize lower-bound)
x (rationalize bound)))
(<= (rational lower-bound)
x (rational bound)))
nconc
(let* ((y (float x one))
(z (* y (- one (* 2 epsilon)))))
......@@ -409,7 +409,7 @@
most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x) (class-of bound))
(<= (rationalize bound) x (rationalize upper-bound)))
(<= (rational bound) x (rational upper-bound)))
nconc
(let* ((y (float x one))
(z (* y (- one (* 2 epsilon)))))
......@@ -433,8 +433,8 @@
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x)
(class-of lower-bound))
(<= (rationalize lower-bound)
x (rationalize upper-bound)))
(<= (rational lower-bound)
x (rational upper-bound)))
nconc
(let* ((y (float x one))
(z1 (+ y epsilon))
......@@ -585,7 +585,7 @@
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x)
(class-of lower-bound))
(<= (rationalize lower-bound) x (rationalize bound)))
(<= (rational lower-bound) x (rational bound)))
nconc
(let* ((y (float x one))
(z (* y (- one (* 2 epsilon)))))
......@@ -608,7 +608,7 @@
most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x) (class-of bound))
(<= (rationalize bound) x (rationalize upper-bound)))
(<= (rational bound) x (rational upper-bound)))
nconc
(let* ((y (float x one))
(z (* y (- one (* 2 epsilon)))))
......@@ -632,8 +632,8 @@
for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (if (floatp x) (subtypep (class-of x)
(class-of lower-bound))
(<= (rationalize lower-bound)
x (rationalize upper-bound)))
(<= (rational lower-bound)
x (rational upper-bound)))
nconc
(let* ((y (float x one))
(z1 (+ y epsilon))
......
......@@ -19,21 +19,21 @@
(not (floatp y))
(etypecase y
(short-float
(<= #.(rationalize most-negative-short-float)
(<= #.(rational most-negative-short-float)
x
#.(rationalize most-positive-short-float)))
#.(rational most-positive-short-float)))
(single-float
(<= #.(rationalize most-negative-single-float)
(<= #.(rational most-negative-single-float)
x
#.(rationalize most-positive-single-float)))
#.(rational most-positive-single-float)))
(double-float
(<= #.(rationalize most-negative-double-float)
(<= #.(rational most-negative-double-float)
x
#.(rationalize most-positive-double-float)))
#.(rational most-positive-double-float)))
(long-float
(<= #.(rationalize most-negative-long-float)
(<= #.(rational most-negative-long-float)
x
#.(rationalize most-positive-long-float))))))))
#.(rational most-positive-long-float))))))))
(defun =.4-fn ()
(loop for x in *numbers*
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Sep 1 13:49:18 2003
;;;; Contains: Tests of RATIONAL
(in-package :cl-test)
(deftest rational.error.1
(classify-error (rational))
program-error)
(deftest rational.error.2
(classify-error (rational 0 nil))
program-error)
(deftest rational.error.3
(classify-error (rational 0 0))
program-error)
(deftest rational.error.4
(loop for x in *mini-universe*
unless (or (realp x)
(eq (eval `(classify-error (rational (quote ,x))))
'type-error))
collect x)
nil)
(deftest rational.1
(loop for x in *reals*
for r = (rational x)
unless (and (rationalp r)
(if (floatp x)
(= (float r x) x)
(eql x r)))
collect (list x r))
nil)
(deftest rational.2
(loop for type in '(short-float single-float double-float long-float)
collect
(loop for i from -10000 to 10000
for x = (coerce i type)
for r = (rational x)
count (not (eql r i))))
(0 0 0 0))
(deftest rational.3
(loop for type in '(short-float single-float double-float long-float)
for bound in '(1.0s5 1.0f10 1.0d20 1.0l30)
nconc
(loop for x = (random-from-interval bound)
for r = (rational x)
for x2 = (float r x)
repeat 1000
unless (and (rationalp r) (= x x2))
collect (list x r x2)))
nil)
\ No newline at end of file
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Sep 1 14:00:45 2003
;;;; Contains: Tests of RATIONALIZE
(in-package :cl-test)
(deftest rationalize.error.1
(classify-error (rationalize))
program-error)
(deftest rationalize.error.2
(classify-error (rationalize 0 nil))
program-error)
(deftest rationalize.error.3
(classify-error (rationalize 0 0))
program-error)
(deftest rationalize.error.4
(loop for x in *mini-universe*
unless (or (realp x)
(eq (eval `(classify-error (rationalize (quote ,x))))
'type-error))
collect x)
nil)
(deftest rationalize.1
(loop for x in *reals*
for r = (rationalize x)
unless (and (rationalp r)
(if (floatp x)
(= (float r x) x)
(eql x r)))
collect (list x r))
nil)
(deftest rationalize.2
(loop for type in '(short-float single-float double-float long-float)
collect
(loop for i from -10000 to 10000
for x = (coerce i type)
for r = (rationalize x)
count (not (eql r i))))
(0 0 0 0))
(deftest rationalize.3
(loop for type in '(short-float single-float double-float long-float)
for bound in '(1.0s5 1.0f10 1.0d20 1.0l30)
nconc
(loop for x = (random-from-interval bound)
for r = (rationalize x)
for x2 = (float r x)
repeat 1000
unless (and (rationalp r) (= x x2))
collect (list x r x2)))
nil)
......@@ -65,8 +65,8 @@
(let* ((upper-bound (* 1000 1000 1000))
(lower-bound (- upper-bound))
(spread (1+ (- upper-bound lower-bound))))
(loop for x = (+ (rationalize (random (float spread 1.0f0))) lower-bound)
for y = (+ (rationalize (random (float spread 1.0f0))) lower-bound)
(loop for x = (+ (rational (random (float spread 1.0f0))) lower-bound)
for y = (+ (rational (random (float spread 1.0f0))) lower-bound)
for prod = (* x y)
for prod2 = (rat-times x y)
repeat 1000
......@@ -114,7 +114,7 @@
(let* ((upper-bound (* 1000 1000 1000 1000))
(lower-bound (- upper-bound))
(spread (1+ (- upper-bound lower-bound))))
(flet ((%r () (+ (rationalize (random (float spread 1.0f0))) lower-bound)))
(flet ((%r () (+ (rational (random (float spread 1.0f0))) lower-bound)))
(loop for xr = (%r)
for xc = (%r)
for x = (complex xr xc)
......
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