X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.impure.lisp;h=73301f03e011a0d475e84b854fd3230c7b58b2a1;hb=2b90fd1dbad23322258222a2ef4cef7f6a00831d;hp=e9891c9afdfa406ebfed94edb256e31e1b46a448;hpb=98c725660502dc1a761e60ac935f95ed60143021;p=sbcl.git

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index e9891c9..73301f0 100644
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -524,11 +524,38 @@
   (assert (not ok))
   (assert (not win)))
 
-;;; precice unions of array types (was bug 306a)
+;;; precise unions of array types (was bug 306a)
 (defun bug-306-a (x)
   (declare (optimize speed)
            (type (or (array cons) (array vector)) x))
   (elt (aref x 0) 0))
 (assert (= 0 (bug-306-a #((0)))))
+
+;;; FUNCALLABLE-INSTANCE is a subtype of function.
+(assert-t-t (subtypep '(and pathname function) nil))
+(assert-t-t (subtypep '(and pathname sb-kernel:funcallable-instance) nil))
+(assert (not (subtypep '(and stream function) nil)))
+(assert (not (subtypep '(and stream sb-kernel:funcallable-instance) nil)))
+(assert (not (subtypep '(and function standard-object) nil)))
+(assert (not (subtypep '(and sb-kernel:funcallable-instance standard-object) nil)))
+
+;;; also, intersections of classes with INSTANCE should not be too
+;;; general
+(assert (not (typep #'print-object '(and standard-object sb-kernel:instance))))
+(assert (not (subtypep 'standard-object '(and standard-object sb-kernel:instance))))
+
+(assert-t-t
+ (subtypep '(or simple-array simple-string) '(or simple-string simple-array)))
+(assert-t-t
+ (subtypep '(or simple-string simple-array) '(or simple-array simple-string)))
+(assert-t-t
+ (subtypep '(or fixnum simple-string end-of-file parse-error fixnum vector)
+           '(or fixnum vector end-of-file parse-error fixnum simple-string)))
+
+#+sb-eval
+(assert-t-t
+ (subtypep '(and function (not compiled-function)
+             (not sb-eval:interpreted-function))
+           nil))
 
 ;;; success