From ba2010734297dc7e9b06b1199afc5bc806b50dfc Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Tue, 14 Feb 2006 17:14:59 +0000 Subject: [PATCH] 0.9.9.29 * fixed type= and csubtypep for arrays of unknown-type --- src/code/late-type.lisp | 43 ++++++++++++++++++++++++------------------- src/pcl/defcombin.lisp | 2 +- src/pcl/defs.lisp | 2 +- tests/type.pure.lisp | 26 ++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 53 insertions(+), 22 deletions(-) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index abe32f2..80916e3 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4