0.9.16.10:

	Massage the new ARRAY :SIMPLE-UNION2 type method into a little
	bit more of acceptability.
	... now (or simple-string simple-array) is the same as
		(or simple-array simple-string)
	... really quite complicated unions still seem to work, judging
		by ETYPECASE.15 and SUBTYPEP.OR.4
	... include some simple test cases.

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 2fb73b6..e1d2e25 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2418,15 +2418,10 @@ used for a COMPLEX component.~:@>"
           (wild1 (eq eltype1 *wild-type*))
           (wild2 (eq eltype2 *wild-type*))
           (e2 nil))
-     ;; This is possibly a bit more conservative then it needs to be:
-     ;; it seems that wild eltype in either should lead to wild eltype
-     ;; in result, but the rest of the type-system doesn't seem too
-     ;; happy about that. --NS 2006-08-23
-     (when (and (or (and wild1 wild2)
-                    (and (not (or wild1 wild2))
-                         (or (setf e2 (csubtypep eltype1 eltype2))
-                             (csubtypep eltype2 eltype1))))
-                (type= stype1 stype2))
+     (when (or wild1 wild2
+               (and (or (setf e2 (csubtypep eltype1 eltype2))
+                        (csubtypep eltype2 eltype1))
+                    (type= stype1 stype2)))
        (make-array-type
         :dimensions (cond ((or (eq dims1 '*) (eq dims2 '*))
                            '*)
@@ -2439,7 +2434,7 @@ used for a COMPLEX component.~:@>"
                            '*))
         :complexp (if (eq complexp1 complexp2) complexp1 :maybe)
         :element-type (if (or wild2 e2) eltype2 eltype1)
-        :specialized-element-type stype1))))
+        :specialized-element-type (if wild2 stype2 stype1)))))
 
 (!define-type-method (array :simple-intersection2) (type1 type2)
   (declare (type array-type type1 type2))

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index caaefaf..5e6540a 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -544,4 +544,11 @@
 (assert (not (typep #'print-object '(and standard-object sb-kernel:instance))))
 (assert (not (subtypep 'standard-object '(and standard-object sb-kernel:instance))))
 \f
+(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)))
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index aeead58..8bfe9d3 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,5 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.16.9"
-
+"0.9.16.10"