From cf94915abfb59f74f6e4852cd791e9e348f0e5ed Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 8 Feb 2004 22:06:55 +0000 Subject: [PATCH] Fix various test problems exposed by clisp. --- ansi-tests/divide.lsp | 13 +++---------- ansi-tests/float.lsp | 4 +++- ansi-tests/numbers-aux.lsp | 20 ++++++++++++++------ ansi-tests/phase.lsp | 11 +++++++---- ansi-tests/rational.lsp | 5 ++++- ansi-tests/rationalize.lsp | 5 ++++- ansi-tests/times.lsp | 2 +- 7 files changed, 36 insertions(+), 24 deletions(-) diff --git a/ansi-tests/divide.lsp b/ansi-tests/divide.lsp index a0d0b47b..ea142c71 100644 --- a/ansi-tests/divide.lsp +++ b/ansi-tests/divide.lsp @@ -115,12 +115,11 @@ 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))) + collect (list i c q (complex one zero)))) nil) @@ -176,12 +175,12 @@ (deftest /.12 (loop for type in '(short-float single-float double-float long-float) for lower in (mapcar - #'rational + #'rational-safely (list least-positive-short-float least-positive-single-float least-positive-double-float least-positive-long-float)) for upper in (mapcar - #'rational + #'rational-safely (list most-positive-short-float most-positive-single-float most-positive-double-float most-positive-long-float)) @@ -205,9 +204,3 @@ (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/float.lsp b/ansi-tests/float.lsp index 04fba84b..8f097df0 100644 --- a/ansi-tests/float.lsp +++ b/ansi-tests/float.lsp @@ -44,10 +44,12 @@ (deftest float.6 (loop for x in *reals* - unless (or (not (typep x 'short-float)) + unless (handler-case + (or (not (typep x 'short-float)) (let ((y (float x 0.0f0))) (and (typep y 'single-float) (= x y)))) + (arithmetic-error () t)) collect x) nil) diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index 3fcc00c5..eb5c7199 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -240,9 +240,13 @@ nconc (loop for y in *reals* when (numbers-are-compatible x y) - unless (let ((m (max x y))) - (and (>= m x) (>= m y) - (or (= m x) (= m y)))) + unless + (handler-case + (let ((m (max x y))) + (and (>= m x) (>= m y) + (or (= m x) (= m y)))) + (floating-point-underflow () t) + (floating-point-overflow () t)) collect (list x y (max x y))))) (defun min.2-fn () @@ -250,9 +254,13 @@ nconc (loop for y in *reals* when (numbers-are-compatible x y) - unless (let ((m (min x y))) - (and (<= m x) (<= m y) - (or (= m x) (= m y)))) + unless + (handler-case + (let ((m (min x y))) + (and (<= m x) (<= m y) + (or (= m x) (= m y)))) + (floating-point-underflow () t) + (floating-point-overflow () t)) collect (list x y (min x y))))) (defun epsilon (number) diff --git a/ansi-tests/phase.lsp b/ansi-tests/phase.lsp index 21fa1a1b..0035eacd 100644 --- a/ansi-tests/phase.lsp +++ b/ansi-tests/phase.lsp @@ -82,22 +82,25 @@ (let ((p1 (phase #c(1 1))) (p2 (phase #c(1.0f0 1.0f0)))) (and (eql p1 p2) - (approx= p1 (coerce (/ pi 4) 'single-float)))) + (approx= p1 (coerce (/ pi 4) 'single-float) + (* 2 single-float-epsilon)))) t) (deftest phase.15 (let ((p (phase #c(1.0d0 1.0d0)))) - (approx= p (coerce (/ pi 4) 'double-float))) + (approx= p (coerce (/ pi 4) 'double-float) + (* 2 double-float-epsilon))) t) (deftest phase.16 (let ((p (phase #c(1.0s0 1.0s0)))) - (approx= p (coerce (/ pi 4) 'single-float))) + (approx= p (coerce (/ pi 4) 'single-float) + (* 2 short-float-epsilon))) t) (deftest phase.17 (let ((p (phase #c(1.0l0 1.0l0)))) - (approx= p (/ pi 4))) + (approx= p (/ pi 4) (* 2 long-float-epsilon))) t) ;;; Negative zeros diff --git a/ansi-tests/rational.lsp b/ansi-tests/rational.lsp index ee6e9590..0c1082a6 100644 --- a/ansi-tests/rational.lsp +++ b/ansi-tests/rational.lsp @@ -25,7 +25,10 @@ nil) (deftest rational.1 - (loop for x in *reals* + (loop for x in (loop for r in *reals* + when (or (not (floatp r)) + (<= -1000 (nth-value 1 (integer-decode-float r)) 1000)) + collect r) for r = (rational x) unless (and (rationalp r) (if (floatp x) diff --git a/ansi-tests/rationalize.lsp b/ansi-tests/rationalize.lsp index 5c003782..8bd92c8f 100644 --- a/ansi-tests/rationalize.lsp +++ b/ansi-tests/rationalize.lsp @@ -25,7 +25,10 @@ nil) (deftest rationalize.1 - (loop for x in *reals* + (loop for x in (loop for r in *reals* + when (or (not (floatp r)) + (<= -1000 (nth-value 1 (integer-decode-float r)) 1000)) + collect r) for r = (rationalize x) unless (and (rationalp r) (if (floatp x) diff --git a/ansi-tests/times.lsp b/ansi-tests/times.lsp index dd648704..942f0364 100644 --- a/ansi-tests/times.lsp +++ b/ansi-tests/times.lsp @@ -356,7 +356,7 @@ unless (and (eql prod (complex (coerce (- 1 (* i j)) type) (coerce (+ i j) type))) (eql prod (* cy cx))) - collect (list i j x y (* cx cy)))) + collect (list type i j x y (* cx cy)))) nil) (deftest times.order.1 -- GitLab