Commit 750aff4b authored by pfdietz's avatar pfdietz

Some fixups to make the tests run under clisp. There are still some spurious...

Some fixups to make the tests run under clisp.  There are still some spurious failures due to over/underflows.
parent ed0c71e8
......@@ -32,3 +32,5 @@
#+ecl (setq c:*suppress-compiler-warnings* t
c:*suppress-compiler-notes* t)
#+clisp (setq custom::*warn-on-floating-point-contagion* nil)
......@@ -417,14 +417,12 @@
when (<= (rational bound)
(rational x)
(rational upper-bound))
;; do (print x)
;; (print epsilon) (print bound) (print upper-bound) (print one) (terpri)
;; (finish-output)
nconc
(let* ((y (float x one))
(z (* y (- one (* 2 epsilon)))))
(list (list y z t)
(list z y nil)))))
(let* ((y (float x one)))
(let ((z (* y (- one (* 2 epsilon)))))
(list (list y z t)
(list z y nil))))))
(loop for x in *universe*
when (and (realp x) (< -1 x 1))
nconc
......@@ -448,16 +446,16 @@
(rational x)
(rational upper-bound))
nconc
(let* ((y (float x one))
(z1 (+ y epsilon))
(z2 (- y epsilon)))
(list (list y z1 t)
(list z1 y nil)
(list y z2 nil)
(list z2 y t)))))
)))
(handler-case
(let* ((y (float x one))
(z1 (+ y epsilon))
(z2 (- y epsilon)))
(list (list y z1 t)
(list z1 y nil)
(list y z2 nil)
(list z2 y t)))
(arithmetic-error () nil)))
))))
(deftest <.4
(loop for (x y result . rest) in *number-less-tests*
......@@ -657,13 +655,15 @@
(rational x)
(rational upper-bound))
nconc
(let* ((y (float x one))
(z1 (+ y epsilon))
(z2 (- y epsilon)))
(list (list y z1 t)
(list z1 y nil)
(list y z2 nil)
(list z2 y t)))))
(handler-case
(let* ((y (float x one))
(z1 (+ y epsilon))
(z2 (- y epsilon)))
(list (list y z1 t)
(list z1 y nil)
(list y z2 nil)
(list z2 y t)))
(floating-point-underflow () nil))))
)))
(deftest <=.4
......
......@@ -130,62 +130,83 @@
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(and (< x y) (> x y)))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(and (< x y) (> x y)))
(arithmetic-error () nil))
collect (list x y))))
(defun <.9-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (< x y) (not (> y x))
(> y x)))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (< x y) (not (> y x))
(> y x)))
(arithmetic-error () nil))
collect (list x y))))
(defun <.10-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (< x y) (>= x y)
(not (>= x y))))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (< x y) (>= x y)
(not (>= x y))))
(arithmetic-error () nil))
collect (list x y))))
(defun <=.8-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (<= x y) (not (>= y x))
(>= y x)))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (<= x y) (not (>= y x))
(>= y x)))
(arithmetic-error () nil))
collect (list x y))))
(defun <=.9-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (<= x y) (not (or (= x y) (< x y)))
(or (= x y) (< x y))))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (<= x y) (not (or (= x y) (< x y)))
(or (= x y) (< x y))))
(arithmetic-error () nil))
collect (list x y))))
(defun >.8-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (> x y) (<= x y)
(not (<= x y))))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (> x y) (<= x y)
(not (<= x y))))
(arithmetic-error () nil))
collect (list x y))))
(defun >=.8-fn ()
(loop for x in *reals*
nconc
(loop for y in *reals*
when (and ;; (numbers-are-compatible x y)
(if (>= x y) (not (or (= x y) (> x y)))
(or (= x y) (> x y))))
when
(handler-case
(and ;; (numbers-are-compatible x y)
(if (>= x y) (not (or (= x y) (> x y)))
(or (= x y) (> x y))))
(arithmetic-error () nil))
collect (list x y))))
;;; Comparison of rationsls
......
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