X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffloat.pure.lisp;h=d287b4aa9d5d8928951e06c574daa8141190703b;hb=73d8c340050371085f25cb87d0c676ce7c7928f9;hp=9b87d638e0a953eb8a2d24597a0d50fee764d67e;hpb=c8af15e61b030c8d4b0e950bc9b7618530044618;p=sbcl.git

diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index 9b87d63..d287b4a 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -13,16 +13,42 @@
 
 (cl:in-package :cl-user)
 
-(let ((+ifni single-float-positive-infinity)
-      (-ifni single-float-negative-infinity))
-  (assert (= (* +ifni 1) +ifni))
-  (assert (= (* +ifni -0.1) -ifni))
-  (assert (= (+ +ifni -0.1) +ifni))
-  (assert (= (- +ifni -0.1) +ifni))
-  (assert (= (sqrt +ifni) +ifni))
-  (assert (= (* -ifni -14) +ifni))
-  (assert (= (/ -ifni 0.1) -ifni))
-  (assert (= (/ -ifni 100/3) -ifni))
-  (assert (< -ifni +ifni))
-  (assert (not (< +ifni 100)))
-  (assert (not (< +ifni -ifni))))
+(dolist (ifnis (list (cons single-float-positive-infinity
+			   single-float-negative-infinity)
+		     (cons double-float-positive-infinity
+			   double-float-negative-infinity)))
+  (destructuring-bind (+ifni . -ifni) ifnis
+    (assert (= (* +ifni 1) +ifni))
+    (assert (= (* +ifni -0.1) -ifni))
+    (assert (= (+ +ifni -0.1) +ifni))
+    (assert (= (- +ifni -0.1) +ifni))
+    (assert (= (sqrt +ifni) +ifni))
+    (assert (= (* -ifni -14) +ifni))
+    (assert (= (/ -ifni 0.1) -ifni))
+    (assert (= (/ -ifni 100/3) -ifni))
+    (assert (not (= +ifni -ifni)))
+    (assert (= -ifni -ifni))
+    (assert (not (= +ifni 100/3)))
+    (assert (not (= -ifni -1.0 -ifni)))
+    (assert (not (= -ifni -17/02 -ifni)))
+    (assert (< -ifni +ifni))
+    (assert (not (< +ifni 100)))
+    (assert (not (< +ifni 100.0)))
+    (assert (not (< +ifni -ifni)))
+    (assert (< 100 +ifni))
+    (assert (< 100.0 +ifni))
+    (assert (>= 100 -ifni))
+    (assert (not (<= 6/7 (* 3 -ifni))))
+    (assert (not (> +ifni +ifni)))))
+
+;;; ANSI: FLOAT-RADIX should signal an error if its argument is not a
+;;; float.
+;;;
+;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden
+;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.)
+(assert (typep (nth-value 1 (ignore-errors (float-radix "notfloat")))
+	       'type-error))
+
+(assert (typep (nth-value 1 (ignore-errors
+                              (funcall (fdefinition 'float-radix) "notfloat")))
+               'type-error))