Skip to content
Snippets Groups Projects
Commit 750aff4b authored by pfdietz's avatar pfdietz
Browse files

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
No related branches found
No related tags found
No related merge requests found
...@@ -32,3 +32,5 @@ ...@@ -32,3 +32,5 @@
#+ecl (setq c:*suppress-compiler-warnings* t #+ecl (setq c:*suppress-compiler-warnings* t
c:*suppress-compiler-notes* t) c:*suppress-compiler-notes* t)
#+clisp (setq custom::*warn-on-floating-point-contagion* nil)
...@@ -417,14 +417,12 @@ ...@@ -417,14 +417,12 @@
when (<= (rational bound) when (<= (rational bound)
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
;; do (print x)
;; (print epsilon) (print bound) (print upper-bound) (print one) (terpri)
;; (finish-output)
nconc nconc
(let* ((y (float x one)) (let* ((y (float x one)))
(z (* y (- one (* 2 epsilon))))) (let ((z (* y (- one (* 2 epsilon)))))
(list (list y z t) (list (list y z t)
(list z y nil))))) (list z y nil))))))
(loop for x in *universe* (loop for x in *universe*
when (and (realp x) (< -1 x 1)) when (and (realp x) (< -1 x 1))
nconc nconc
...@@ -448,16 +446,16 @@ ...@@ -448,16 +446,16 @@
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
nconc nconc
(let* ((y (float x one)) (handler-case
(z1 (+ y epsilon)) (let* ((y (float x one))
(z2 (- y epsilon))) (z1 (+ y epsilon))
(list (list y z1 t) (z2 (- y epsilon)))
(list z1 y nil) (list (list y z1 t)
(list y z2 nil) (list z1 y nil)
(list z2 y t))))) (list y z2 nil)
))) (list z2 y t)))
(arithmetic-error () nil)))
))))
(deftest <.4 (deftest <.4
(loop for (x y result . rest) in *number-less-tests* (loop for (x y result . rest) in *number-less-tests*
...@@ -657,13 +655,15 @@ ...@@ -657,13 +655,15 @@
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
nconc nconc
(let* ((y (float x one)) (handler-case
(z1 (+ y epsilon)) (let* ((y (float x one))
(z2 (- y epsilon))) (z1 (+ y epsilon))
(list (list y z1 t) (z2 (- y epsilon)))
(list z1 y nil) (list (list y z1 t)
(list y z2 nil) (list z1 y nil)
(list z2 y t))))) (list y z2 nil)
(list z2 y t)))
(floating-point-underflow () nil))))
))) )))
(deftest <=.4 (deftest <=.4
......
...@@ -130,62 +130,83 @@ ...@@ -130,62 +130,83 @@
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(and (< x y) (> x y))) (handler-case
(and ;; (numbers-are-compatible x y)
(and (< x y) (> x y)))
(arithmetic-error () nil))
collect (list x y)))) collect (list x y))))
(defun <.9-fn () (defun <.9-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (< x y) (not (> y x)) (handler-case
(> y x))) (and ;; (numbers-are-compatible x y)
(if (< x y) (not (> y x))
(> y x)))
(arithmetic-error () nil))
collect (list x y)))) collect (list x y))))
(defun <.10-fn () (defun <.10-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (< x y) (>= x y) (handler-case
(not (>= x y)))) (and ;; (numbers-are-compatible x y)
(if (< x y) (>= x y)
(not (>= x y))))
(arithmetic-error () nil))
collect (list x y)))) collect (list x y))))
(defun <=.8-fn () (defun <=.8-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (<= x y) (not (>= y x)) (handler-case
(>= y x))) (and ;; (numbers-are-compatible x y)
(if (<= x y) (not (>= y x))
(>= y x)))
(arithmetic-error () nil))
collect (list x y)))) collect (list x y))))
(defun <=.9-fn () (defun <=.9-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (<= x y) (not (or (= x y) (< x y))) (handler-case
(or (= x y) (< x y)))) (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)))) collect (list x y))))
(defun >.8-fn () (defun >.8-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (> x y) (<= x y) (handler-case
(not (<= x y)))) (and ;; (numbers-are-compatible x y)
(if (> x y) (<= x y)
(not (<= x y))))
(arithmetic-error () nil))
collect (list x y)))) collect (list x y))))
(defun >=.8-fn () (defun >=.8-fn ()
(loop for x in *reals* (loop for x in *reals*
nconc nconc
(loop for y in *reals* (loop for y in *reals*
when (and ;; (numbers-are-compatible x y) when
(if (>= x y) (not (or (= x y) (> x y))) (handler-case
(or (= x y) (> x y)))) (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)))) collect (list x y))))
;;; Comparison of rationsls ;;; Comparison of rationsls
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment