From 9dfc672dd7d301041c8193f2276b415ccfed8a9c Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 23 Aug 2003 13:42:35 +0000 Subject: [PATCH] Fixed test lossage revealed by ACL when trying to compare integers or rationals that are out of the range of valid values of a float type. --- ansi-tests/number-comparison.lsp | 55 +++++++++++++++++++++-- ansi-tests/numbers-aux.lsp | 76 ++++++++++++++++++++++++-------- 2 files changed, 109 insertions(+), 22 deletions(-) diff --git a/ansi-tests/number-comparison.lsp b/ansi-tests/number-comparison.lsp index 95355568..87a9e40e 100644 --- a/ansi-tests/number-comparison.lsp +++ b/ansi-tests/number-comparison.lsp @@ -378,13 +378,20 @@ most-positive-single-float most-positive-double-float most-positive-long-float) + for lower-bound in (list most-negative-short-float + most-negative-single-float + most-negative-double-float + most-negative-long-float) for one in '(1.0s0 1.0f0 1.0d0 1.0l0) - when (<= x bound) + when (if (floatp x) (subtypep (class-of x) (class-of bound)) + (<= (rationalize lower-bound) + x (rationalize bound))) nconc (let* ((y (float x one)) (z (* y (- one (* 2 epsilon))))) (list (list y z nil) (list z y t))))) + (loop for x in *universe* when (and (realp x) (<= x -1)) nconc @@ -396,8 +403,13 @@ most-negative-single-float most-negative-double-float most-negative-long-float) + for upper-bound in (list most-positive-short-float + most-positive-single-float + most-positive-double-float + most-positive-long-float) for one in '(1.0s0 1.0f0 1.0d0 1.0l0) - when (>= x bound) + when (if (floatp x) (subtypep (class-of x) (class-of bound)) + (<= (rationalize bound) x (rationalize upper-bound))) nconc (let* ((y (float x one)) (z (* y (- one (* 2 epsilon))))) @@ -410,7 +422,19 @@ single-float-epsilon double-float-epsilon long-float-epsilon) + for lower-bound in (list most-negative-short-float + most-negative-single-float + most-negative-double-float + most-negative-long-float) + for upper-bound in (list most-positive-short-float + most-positive-single-float + most-positive-double-float + 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 lower-bound)) + (<= (rationalize lower-bound) + x (rationalize upper-bound))) nconc (let* ((y (float x one)) (z1 (+ y epsilon)) @@ -554,8 +578,14 @@ most-positive-single-float most-positive-double-float most-positive-long-float) + for lower-bound in (list most-negative-short-float + most-negative-single-float + most-negative-double-float + most-negative-long-float) for one in '(1.0s0 1.0f0 1.0d0 1.0l0) - when (<= x bound) + when (if (floatp x) (subtypep (class-of x) + (class-of lower-bound)) + (<= (rationalize lower-bound) x (rationalize bound))) nconc (let* ((y (float x one)) (z (* y (- one (* 2 epsilon))))) @@ -572,8 +602,13 @@ most-negative-single-float most-negative-double-float most-negative-long-float) + for upper-bound in (list most-positive-short-float + most-positive-single-float + most-positive-double-float + most-positive-long-float) for one in '(1.0s0 1.0f0 1.0d0 1.0l0) - when (>= x bound) + when (if (floatp x) (subtypep (class-of x) (class-of bound)) + (<= (rationalize bound) x (rationalize upper-bound))) nconc (let* ((y (float x one)) (z (* y (- one (* 2 epsilon))))) @@ -586,7 +621,19 @@ single-float-epsilon double-float-epsilon long-float-epsilon) + for lower-bound in (list most-negative-short-float + most-negative-single-float + most-negative-double-float + most-negative-long-float) + for upper-bound in (list most-positive-short-float + most-positive-single-float + most-positive-double-float + 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 lower-bound)) + (<= (rationalize lower-bound) + x (rationalize 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 b19fb793..f9e00ef6 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -5,82 +5,122 @@ (in-package :cl-test) +(defun numbers-are-compatible (x y) + (cond + ((complexp x) + (and (numbers-are-compatible (realpart x) y) + (numbers-are-compatible (imagpart x) y))) + ((complexp y) + (and (numbers-are-compatible x (realpart y)) + (numbers-are-compatible x (imagpart y)))) + (t + (when (floatp x) (rotatef x y)) + (or (floatp x) + (not (floatp y)) + (etypecase y + (short-float + (<= #.(rationalize most-negative-short-float) + x + #.(rationalize most-positive-short-float))) + (single-float + (<= #.(rationalize most-negative-single-float) + x + #.(rationalize most-positive-single-float))) + (double-float + (<= #.(rationalize most-negative-double-float) + x + #.(rationalize most-positive-double-float))) + (long-float + (<= #.(rationalize most-negative-long-float) + x + #.(rationalize most-positive-long-float)))))))) + (defun =.4-fn () (loop for x in *numbers* append (loop for y in *numbers* - unless (if (= x y) (= y x) (not (= y x))) + unless (or (not (numbers-are-compatible x y)) + (if (= x y) (= y x) (not (= y x)))) collect (list x y)))) (defun /=.4-fn () (loop for x in *numbers* append (loop for y in *numbers* - unless (if (/= x y) (/= y x) (not (/= y x))) + unless (or (not (numbers-are-compatible x y)) + (if (/= x y) (/= y x) (not (/= y x)))) collect (list x y)))) (defun /=.4a-fn () (loop for x in *numbers* append (loop for y in *numbers* - when (if (= x y) - (/= x y) - (not (/= x y))) + when (and (numbers-are-compatible x y) + (if (= x y) + (/= x y) + (not (/= x y)))) collect (list x y)))) (defun <.8-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (and (< x y) (> x y)) + when (and (numbers-are-compatible x y) + (and (< x y) (> x y))) collect (list x y)))) (defun <.9-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (< x y) (not (> y x)) - (> y x)) + when (and (numbers-are-compatible x y) + (if (< x y) (not (> y x)) + (> y x))) collect (list x y)))) (defun <.10-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (< x y) (>= x y) - (not (>= x y))) + when (and (numbers-are-compatible x y) + (if (< x y) (>= x y) + (not (>= x y)))) collect (list x y)))) (defun <=.8-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (<= x y) (not (>= y x)) - (>= y x)) + when (and (numbers-are-compatible x y) + (if (<= x y) (not (>= y x)) + (>= y x))) collect (list x y)))) (defun <=.9-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (<= x y) (not (or (= x y) (< x y))) - (or (= x y) (< x y))) + when (and (numbers-are-compatible x y) + (if (<= x y) (not (or (= x y) (< x y))) + (or (= x y) (< x y)))) collect (list x y)))) (defun >.8-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (> x y) (<= x y) - (not (<= x y))) + when (and (numbers-are-compatible x y) + (if (> x y) (<= x y) + (not (<= x y)))) collect (list x y)))) (defun >=.8-fn () (loop for x in *reals* nconc (loop for y in *reals* - when (if (>= x y) (not (or (= x y) (> x y))) - (or (= x y) (> x y))) + when (and (numbers-are-compatible x y) + (if (>= x y) (not (or (= x y) (> x y))) + (or (= x y) (> x y)))) collect (list x y)))) ;;; Comparison of rationsls -- GitLab