X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Ftype.impure.lisp;h=31b42e9cc047dd0d405183d338150321bf978466;hb=a18f0a95bc9a457e4d2d00c702b746f29c2662b1;hp=6ec22b95911df07b016926d7d3db2f4f1e35406b;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 6ec22b9..31b42e9 100644
--- 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)