0.9.9.29

  * fixed type= and csubtypep for arrays of unknown-type

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index abe32f2..80916e3 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2246,23 +2246,25 @@ used for a COMPLEX component.~:@>"
       (array-type-element-type type)))
 
 (!define-type-method (array :simple-=) (type1 type2)
-  (if (or (unknown-type-p (array-type-element-type type1))
-          (unknown-type-p (array-type-element-type type2)))
-      (multiple-value-bind (equalp certainp)
-          (type= (array-type-element-type type1)
-                 (array-type-element-type type2))
-        ;; By its nature, the call to TYPE= should never return NIL,
-        ;; T, as we don't know what the UNKNOWN-TYPE will grow up to
-        ;; be.  -- CSR, 2002-08-19
-        (aver (not (and (not equalp) certainp)))
-        (values equalp certainp))
-      (values (and (equal (array-type-dimensions type1)
+  (cond ((not (and (equal (array-type-dimensions type1)
                           (array-type-dimensions type2))
                    (eq (array-type-complexp type1)
-                       (array-type-complexp type2))
-                   (type= (specialized-element-type-maybe type1)
-                          (specialized-element-type-maybe type2)))
-              t)))
+                       (array-type-complexp type2))))
+         (values nil t))
+        ((or (unknown-type-p (array-type-element-type type1))
+             (unknown-type-p (array-type-element-type type2)))
+         (multiple-value-bind (equalp certainp)
+             (type= (array-type-element-type type1)
+                    (array-type-element-type type2))
+           ;; By its nature, the call to TYPE= should never return
+           ;; NIL, T, as we don't know what the UNKNOWN-TYPE will grow
+           ;; up to be.  -- CSR, 2002-08-19
+           (aver (not (and (not equalp) certainp)))
+           (values equalp certainp)))
+        (t
+         (values (type= (specialized-element-type-maybe type1)
+                        (specialized-element-type-maybe type2))
+                 t))))
 
 (!define-type-method (array :negate) (type)
   ;; FIXME (and hint to PFD): we're vulnerable here to attacks of the
@@ -2334,12 +2336,15 @@ used for a COMPLEX component.~:@>"
           ;; if the TYPE2 element type is wild.
           ((eq (array-type-element-type type2) *wild-type*)
            (values t t))
-          (;; Since we didn't match any of the special cases above, we
-           ;; can't give a good answer unless both the element types
-           ;; have been defined.
+          (;; Since we didn't match any of the special cases above, if
+           ;; either element type is unknown we can only give a good
+           ;; answer if they are the same.
            (or (unknown-type-p (array-type-element-type type1))
                (unknown-type-p (array-type-element-type type2)))
-           (values nil nil))
+           (if (type= (array-type-element-type type1)
+                      (array-type-element-type type2))
+               (values t t)
+               (values nil nil)))
           (;; Otherwise, the subtype relationship holds iff the
            ;; types are equal, and they're equal iff the specialized
            ;; element types are identical.

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index eac8820..4edc8bd 100644 (file)
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -221,7 +221,7 @@
 
 (defvar *long-method-combination-functions* (make-hash-table :test 'eq))
 
-(defun load-long-defcombin 
+(defun load-long-defcombin
     (type-name doc function args-lambda-list source-location)
   (let* ((specializers
            (list (find-class 'generic-function)

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 61f7cb7..7a2e36b 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -456,7 +456,7 @@
     :initarg :initargs
     :accessor slot-definition-initargs)
    (%type :initform t :initarg :type :accessor slot-definition-type)
-   (%documentation 
+   (%documentation
     :initform nil :initarg :documentation
     ;; KLUDGE: we need a reader for bootstrapping purposes, in
     ;; COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS.

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 3c42e2d..55e2575 100644 (file)
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -304,3 +304,29 @@ ACTUAL ~D DERIVED ~D~%"
 ;;; all sorts of answers are right for this one, but it used to
 ;;; trigger an AVER instead.
 (subtypep '(function ()) '(and (function ()) (satisfies identity)))
+
+(assert (sb-kernel:unknown-type-p (sb-kernel:specifier-type 'an-unkown-type)))
+
+(assert
+ (sb-kernel:type=
+  (sb-kernel:specifier-type '(or (simple-array an-unkown-type (*))
+                              (simple-array an-unkown-type)))
+  (sb-kernel:specifier-type '(or (simple-array an-unkown-type (*))
+                              (simple-array an-unkown-type)))))
+
+(assert
+ (sb-kernel:type=
+  (sb-kernel:specifier-type '(simple-array an-unkown-type (*)))
+  (sb-kernel:specifier-type '(simple-array an-unkown-type (*)))))
+
+(assert
+ (not
+  (sb-kernel:type=
+   (sb-kernel:specifier-type '(simple-array an-unkown-type (*)))
+   (sb-kernel:specifier-type '(array an-unkown-type (*))))))
+
+(assert
+ (not
+  (sb-kernel:type=
+   (sb-kernel:specifier-type '(simple-array an-unkown-type (7)))
+   (sb-kernel:specifier-type '(simple-array an-unkown-type (8))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 6ee12c9..cc83ade 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +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.9.28"
+"0.9.9.29"