[Sbcl-commits] CVS: sbcl/tests type.impure.lisp,1.46,1.47

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv26843/tests

Modified Files:
	type.impure.lisp 
Log Message:
0.9.16.1:
	Rework the named :complex-intersection-arg2 method for instance
	and funcallable-instance, making it a lot clearer and fixing 
	bugs in the process...
	... structure-classoids are always subtypep instance and never
		intersect funcallable-instance;
	... standard-classoids are different.  It's possible to make
		a subclass of an instance class which is 
		funcallable-instance (if you pardon the loose 
		construction), while the reverse is not possible.


Index: type.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/type.impure.lisp,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- type.impure.lisp	23 Aug 2006 12:46:26 -0000	1.46
+++ type.impure.lisp	28 Aug 2006 12:08:19 -0000	1.47
@@ -524,11 +524,24 @@
   (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))))
+
 ;;; success