diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index fd5563dc8d443fc8bad032a0c97b810dface4a7e..124238c6a659763868333ae42c03ebb08f13f18d 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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) ))) diff --git a/ansi-tests/divide.lsp b/ansi-tests/divide.lsp new file mode 100644 index 0000000000000000000000000000000000000000..3ee4a5677ffeec897f067926fefa1501ecefe9d3 --- /dev/null +++ b/ansi-tests/divide.lsp @@ -0,0 +1,211 @@ +;-*- 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 diff --git a/ansi-tests/division-aux.lsp b/ansi-tests/division-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..d129a67c375f393391bf9ab413f1b5a13e66be63 --- /dev/null +++ b/ansi-tests/division-aux.lsp @@ -0,0 +1,16 @@ +;-*- 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))) + + + + diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index 6e815522ebf92338c2a5b2776dafe2fefcfc88a6..7fd8566af864bff8b370d0e67e75e48b15b33be5 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -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") diff --git a/ansi-tests/number-comparison.lsp b/ansi-tests/number-comparison.lsp index 87a9e40eb70f5a64222424984debc0c9cabd44e6..ee8c42148d5a6c5c1b1a0967080d5c8eaabc8e45 100644 --- a/ansi-tests/number-comparison.lsp +++ b/ansi-tests/number-comparison.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)) diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index cd54be8d5cc794db9954497a9380eb6a70d0f7c3..2c7789d7fc19324bc236b17e2ee2f8945b3b3525 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -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* diff --git a/ansi-tests/rational.lsp b/ansi-tests/rational.lsp new file mode 100644 index 0000000000000000000000000000000000000000..a2e0dfed8bbca89ef6bb30b7a3bb8b98c8e00a8a --- /dev/null +++ b/ansi-tests/rational.lsp @@ -0,0 +1,57 @@ +;-*- 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 diff --git a/ansi-tests/rationalize.lsp b/ansi-tests/rationalize.lsp new file mode 100644 index 0000000000000000000000000000000000000000..1a38b409c32e5fd0508e9b8bda7656e442ed4772 --- /dev/null +++ b/ansi-tests/rationalize.lsp @@ -0,0 +1,57 @@ +;-*- 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) diff --git a/ansi-tests/times.lsp b/ansi-tests/times.lsp index ac9bcf4ea61ba9b538694fb7eb62edddaec10585..66865e559ad056ce5653cb87d02d22b5842b0e5c 100644 --- a/ansi-tests/times.lsp +++ b/ansi-tests/times.lsp @@ -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)