X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Ftype.impure.lisp;h=73301f03e011a0d475e84b854fd3230c7b58b2a1;hb=2b90fd1dbad23322258222a2ef4cef7f6a00831d;hp=bf0bd45f3ba0e7481e9cda1b7b066f12b1191679;hpb=5ec5d0e068ab2b6435e0c841d686a95dbd58cbc4;p=sbcl.git diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index bf0bd45..73301f0 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -511,7 +511,7 @@ (assert win)) ;; See FIXME in type method for CONS :SIMPLE-TYPE-= -#+nil +#+nil (multiple-value-bind (ok win) (sb-kernel:type= (sb-kernel:specifier-type '(cons goldbach1 integer)) (sb-kernel:specifier-type '(cons goldbach1 single-float))) @@ -523,4 +523,39 @@ (sb-kernel:specifier-type '(cons goldbach2 single-float))) (assert (not ok)) (assert (not win))) + +;;; 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