0.9.14.6:

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

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index be9e55b..d5edc2e 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -445,4 +445,46 @@
                  t)))
   (assert (null (values (subtypep `(not ,t2) `(not ,t1))))))
 \f
+(defstruct misc-629a)
+(defclass misc-629b () ())
+(defclass misc-629c () () (:metaclass sb-mop:funcallable-standard-class))
+
+(assert (typep (make-misc-629a) 'sb-kernel:instance))
+(assert-t-t (subtypep `(member ,(make-misc-629a)) 'sb-kernel:instance))
+(assert-nil-t (subtypep `(and (member ,(make-misc-629a)) sb-kernel:instance)
+                        nil))
+(let ((misc-629a (make-misc-629a)))
+  (assert-t-t (subtypep `(member ,misc-629a)
+                        `(and (member ,misc-629a) sb-kernel:instance)))
+  (assert-t-t (subtypep `(and (member ,misc-629a)
+                          sb-kernel:funcallable-instance)
+                        nil)))
+
+(assert (typep (make-instance 'misc-629b) 'sb-kernel:instance))
+(assert-t-t (subtypep `(member ,(make-instance 'misc-629b))
+                      'sb-kernel:instance))
+(assert-nil-t (subtypep `(and (member ,(make-instance 'misc-629b))
+                          sb-kernel:instance)
+                        nil))
+(let ((misc-629b (make-instance 'misc-629b)))
+  (assert-t-t (subtypep `(member ,misc-629b)
+                        `(and (member ,misc-629b) sb-kernel:instance)))
+  (assert-t-t (subtypep `(and (member ,misc-629b)
+                          sb-kernel:funcallable-instance)
+                        nil)))
+
+(assert (typep (make-instance 'misc-629c) 'sb-kernel:funcallable-instance))
+(assert-t-t (subtypep `(member ,(make-instance 'misc-629c))
+                      'sb-kernel:funcallable-instance))
+(assert-nil-t (subtypep `(and (member ,(make-instance 'misc-629c))
+                          sb-kernel:funcallable-instance)
+                        nil))
+(let ((misc-629c (make-instance 'misc-629c)))
+  (assert-t-t (subtypep `(member ,misc-629c)
+                        `(and (member ,misc-629c)
+                          sb-kernel:funcallable-instance)))
+  (assert-t-t (subtypep `(and (member ,misc-629c)
+                          sb-kernel:instance)
+                        nil)))
+
 ;;; success