0.6.11.40:

[sbcl.git] / tests / type.impure.lisp

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 6ec22b9..31b42e9 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -13,7 +13,13 @@
               integer fixnum (integer 0 10)
               single-float (single-float -1.0 1.0) (single-float 0.1)
               (real 4 8) (real -1 7) (real 2 11)
-              (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3))))
+              (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3)
+              ;; FIXME: When bug 91 is fixed, add these to the list:
+              ;;   (INTEGER -1 1)
+              ;;   UNSIGNED-BYTE
+              ;;   (RATIONAL -1 7) (RATIONAL -2 4)
+              ;;   RATIO
+              )))
   (dolist (i types)
     (format t "type I=~S~%" i)
     (dolist (j types)
@@ -25,13 +31,10 @@
       (dolist (k types)
        (format t "    type K=~S~%" k)
        (assert (subtypep `(or ,i ,j) `(or ,i ,j ,k)))
-       ;; FIXME: The old code (including original CMU CL code)
-       ;; fails this test. When this is fixed, we can re-enable it.
-       #+nil (assert (subtypep `(or ,i ,j) `(or ,k ,j ,i)))))))
+       (assert (subtypep `(or ,i ,j) `(or ,k ,j ,i)))))))
 
 ;;; gotchas that can come up in handling subtypeness as "X is a
 ;;; subtype of Y if each of the elements of X is a subtype of Y"
-#+nil ; FIXME: suppressed until we can fix old CMU CL big
 (let ((subtypep-values (multiple-value-list
                        (subtypep '(single-float -1.0 1.0)
                                  '(or (real -100.0 0.0)
@@ -43,7 +46,8 @@
                    ;; But if it does, that'd be neat.
                    (t t)
                    ;; (And any other return would be wrong.)
-                   ))))
+                   )
+                 :test #'equal)))
 
 (defun type-evidently-= (x y)
   (and (subtypep x y)
@@ -85,5 +89,13 @@
 (assert (typep 11 '(and)))
 (assert (not (typep 11 '(or))))
 
+;;; bug 12: type system didn't grok nontrivial intersections
+(assert (subtypep '(and symbol (satisfies keywordp)) 'symbol))
+(assert (not (subtypep '(and symbol (satisfies keywordp)) 'null)))
+(assert (subtypep 'keyword 'symbol))
+(assert (not (subtypep 'symbol 'keyword)))
+(assert (subtypep 'ratio 'real))
+(assert (subtypep 'ratio 'number))
+
 ;;; success
 (quit :unix-status 104)