Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv24641/ieee754 Modified Files: ieee754-sbcl.lisp Log Message: Implement for sbcl comparison operators from Table 4 of ieee754. Work enough logic into ieeefp-tests to be able to test booleans as well as numerical results Add test vectors for ieee754:= Make sbcl test exceptions by default Date: Mon Aug 2 05:54:13 2004 Author: crhodes Index: ieeefp-tests/ieee754/ieee754-sbcl.lisp diff -u ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.2 ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.3 --- ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.2 Thu Jun 17 10:32:17 2004 +++ ieeefp-tests/ieee754/ieee754-sbcl.lisp Mon Aug 2 05:54:12 2004 @@ -1,5 +1,7 @@ (in-package "IEEE754-INTERNALS") +(defvar ieeefp-tests:*test-exceptions* t) + (defun make-single-float (x) (declare (type (or (unsigned-byte 32) (signed-byte 32)) x)) (typecase x @@ -32,3 +34,23 @@ (defun get-floating-point-modes () (sb-int:get-floating-point-modes)) + +(macrolet + ((def (x &body body) + `(defun ,x (x y) + (declare (type float x y)) + ,@body))) + (def = (cl:= x y)) + (def ?<> (not (= x y))) + (def > (cl:> x y)) + (def >= (cl:>= x y)) + (def < (cl:< x y)) + (def <= (cl:<= x y)) + (def ? (or (sb-ext:float-nan-p x) (sb-ext:float-nan-p y))) + (def <> (or (< x y) (> x y))) + (def <=> (or (< x y) (= x y) (> x y))) + (def ?> (or (? x y) (> x y))) + (def ?>= (or (? x y) (>= x y))) + (def ?< (or (? x y) (< x y))) + (def ?<= (or (? x y) (<= x y))) + (def ?= (or (? x y) (= x y))))