[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-sbcl.lisp

[Christophe Rhodes]

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))
+	   , at 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))))