Skip to content
Snippets Groups Projects
Commit 9dfc672d authored by pfdietz's avatar pfdietz
Browse files

Fixed test lossage revealed by ACL when trying to compare integers or...

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.
parent 17afbab3
No related branches found
No related tags found
No related merge requests found
......@@ -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))
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment