X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.pure.lisp;h=3c42e2d4550b30a5e5092a23805a92e3ec6f6a3b;hb=d4d6c4b16a3655ce99a87d43f411391363531260;hp=5e4b98d2ca7e52d24ce6f6fb6a28e6f29dfd46ea;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 5e4b98d..3c42e2d 100644
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -266,3 +266,41 @@
 ACTUAL ~D DERIVED ~D~%"
                                               op a b c d minimize brute derived)
                                       (assert (= brute derived)))))))))))))
+
+;;; subtypep on CONS types wasn't taking account of the fact that a
+;;; CONS type could be the empty type (but no other non-CONS type) in
+;;; disguise.
+(multiple-value-bind (yes win)
+    (subtypep '(and function stream) 'nil)
+  (multiple-value-bind (cyes cwin)
+      (subtypep '(cons (and function stream) t)
+                '(cons nil t))
+    (assert (eq yes cyes))
+    (assert (eq win cwin))))
+
+;;; CONS type subtypep could be too enthusiastic about thinking it was
+;;; certain
+(multiple-value-bind (yes win)
+    (subtypep '(satisfies foo) '(satisfies bar))
+  (assert (null yes))
+  (assert (null win))
+  (multiple-value-bind (cyes cwin)
+      (subtypep '(cons (satisfies foo) t)
+                '(cons (satisfies bar) t))
+    (assert (null cyes))
+    (assert (null cwin))))
+
+(multiple-value-bind (yes win)
+    (subtypep 'generic-function 'function)
+  (assert yes)
+  (assert win))
+;;; this would be in some internal test suite like type.before-xc.lisp
+;;; except that generic functions don't exist at that stage.
+(multiple-value-bind (yes win)
+    (subtypep 'generic-function 'sb-kernel:funcallable-instance)
+  (assert yes)
+  (assert win))
+
+;;; all sorts of answers are right for this one, but it used to
+;;; trigger an AVER instead.
+(subtypep '(function ()) '(and (function ()) (satisfies identity)))