0.6.10.14:

	fixing bug 40..
	UPGRADED-ARRAY-ELEMENT-TYPE now signals an error when the type
		is undefined.
	TYPEP and SUBTYPEP now catch type arguments which are arrays
		with undefined element types.
	also cleaned up UPGRADED-COMPLEX-PART-TYPE a little..
	UPGRADED-COMPLEX-PART-TYPE signals an error for undefined type.
	UPGRADED-COMPLEX-PART-TYPE always returns a value which is a
		subtype of REAL.

diff --git a/BUGS b/BUGS
index 68cbee7..2afa760 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -406,15 +406,6 @@ returning an array as first value always.
   accepting &REST even when it's not followed by an argument name:
        (DEFMETHOD FOO ((X T) &REST) NIL)
 
   accepting &REST even when it's not followed by an argument name:
        (DEFMETHOD FOO ((X T) &REST) NIL)
 

-40:
-  TYPEP treats the result of UPGRADED-ARRAY-ELEMENT-TYPE as gospel,
-  so that (TYPEP (MAKE-ARRAY 3) '(VECTOR SOMETHING-NOT-DEFINED-YET))
-  returns (VALUES T T). Probably it should be an error instead,
-  complaining that the type SOMETHING-NOT-DEFINED-YET is not defined.
-  Or perhaps UPGRADED-ARRAY-ELEMENT-TYPE should just fail when a type
-  isn't defined yet. (What if the definition of
-  SOMETHING-NOT-DEFINED-YET turns out to be SINGLE-FLOAT?) 
-

 41:
   TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in 
        (DEFTYPE INDEXOID () '(INTEGER 0 1000))
 41:
   TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in 
        (DEFTYPE INDEXOID () '(INTEGER 0 1000))

diff --git a/NEWS b/NEWS
index b6e2a51..8c22dbd 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -650,6 +650,9 @@ changes in sbcl-0.6.11 relative to sbcl-0.6.10:
   but like most other programs, it defaults to copying the Unix
   environment from the original process instead of starting the
   new process in an empty environment.
   but like most other programs, it defaults to copying the Unix
   environment from the original process instead of starting the
   new process in an empty environment.

+* fixed bug 40: TYPEP, SUBTYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, 
+  and UPGRADED-COMPLEX-PART-TYPE now work better with of compound
+  types built from undefined types, e.g. '(VECTOR SOME-UNDEF-TYPE).

 * Extensions which manipulate the Unix environment now support
   an :ENVIRONMENT keyword option which doesn't smash case or 
   do other bad things. The CMU-CL-style :ENV option is retained
 * Extensions which manipulate the Unix environment now support
   an :ENVIRONMENT keyword option which doesn't smash case or 
   do other bad things. The CMU-CL-style :ENV option is retained

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 8706017..1e73b31 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1381,8 +1381,8 @@
   (let ((dims1 (array-type-dimensions type1))
        (dims2 (array-type-dimensions type2))
        (complexp2 (array-type-complexp type2)))
   (let ((dims1 (array-type-dimensions type1))
        (dims2 (array-type-dimensions type2))
        (complexp2 (array-type-complexp type2)))

-    ;; See whether dimensions are compatible.
-    (cond ((not (or (eq dims2 '*)
+    (cond (;; not subtypep unless dimensions are compatible
+          (not (or (eq dims2 '*)

                    (and (not (eq dims1 '*))
                         ;; (sbcl-0.6.4 has trouble figuring out that
                         ;; DIMS1 and DIMS2 must be lists at this
                    (and (not (eq dims1 '*))
                         ;; (sbcl-0.6.4 has trouble figuring out that
                         ;; DIMS1 and DIMS2 must be lists at this

@@ -1395,18 +1395,27 @@
                                (the list dims1)
                                (the list dims2)))))
           (values nil t))
                                (the list dims1)
                                (the list dims2)))))
           (values nil t))

-         ;; See whether complexpness is compatible.
+         ;; not subtypep unless complexness is compatible

          ((not (or (eq complexp2 :maybe)
                    (eq (array-type-complexp type1) complexp2)))
           (values nil t))
          ((not (or (eq complexp2 :maybe)
                    (eq (array-type-complexp type1) complexp2)))
           (values nil t))

-         ;; If the TYPE2 eltype is wild, we win. Otherwise, the types
-         ;; must be identical.
-         ((or (eq (array-type-element-type type2) *wild-type*)
-              (type= (specialized-element-type-maybe type1)
-                     (specialized-element-type-maybe type2)))
+         ;; Since we didn't fail any of the tests above, we win
+         ;; if the TYPE2 element type is wild.
+         ((eq (array-type-element-type type2) *wild-type*)

           (values t t))
           (values t t))

-         (t
-          (values nil 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.
+          (or (unknown-type-p (array-type-element-type type1))
+              (unknown-type-p (array-type-element-type type2)))
+          (values nil nil))
+         (;; Otherwise, the subtype relationship holds iff the
+          ;; types are equal, and they're equal iff the specialized
+          ;; element types are identical.
+          t
+          (values (type= (specialized-element-type-maybe type1)
+                         (specialized-element-type-maybe type2))
+                  t)))))

 
 (!define-superclasses array
   ((string string)
 
 (!define-superclasses array
   ((string string)

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index 86bad39..f144d02 100644 (file)
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -141,9 +141,10 @@
   #!+sb-doc
   "Return the element type that will actually be used to implement an array
    with the specifier :ELEMENT-TYPE Spec."
   #!+sb-doc
   "Return the element type that will actually be used to implement an array
    with the specifier :ELEMENT-TYPE Spec."

-  (type-specifier
-   (array-type-specialized-element-type
-    (specifier-type `(array ,spec)))))
+  (if (unknown-type-p (specifier-type spec))
+      (error "undefined type: ~S" spec)
+      (type-specifier (array-type-specialized-element-type
+                      (specifier-type `(array ,spec))))))

 \f
 ;;;; equality predicates
 
 \f
 ;;;; equality predicates
 

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 4292c35..77ae156 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -186,11 +186,12 @@
                     (vlen (car (array-type-dimensions type))))
                 (if (and (numberp vlen) (/= vlen length))
                   (error 'simple-type-error
                     (vlen (car (array-type-dimensions type))))
                 (if (and (numberp vlen) (/= vlen length))
                   (error 'simple-type-error

-                         ;; these two are under-specified by ANSI
+                         ;; These two are under-specified by ANSI.

                          :datum (type-specifier type)
                          :expected-type (type-specifier type)
                          :format-control
                          :datum (type-specifier type)
                          :expected-type (type-specifier type)
                          :format-control

-                         "The length of ~S does not match the specified length  of ~S."
+                         "The length of ~S does not match the specified ~
+                           length=~S."

                          :format-arguments
                          (list (type-specifier type) length)))
                 (if iep
                          :format-arguments
                          (list (type-specifier type) length)))
                 (if iep

diff --git a/src/code/target-numbers.lisp b/src/code/target-numbers.lisp
index 6b8f6c6..f77355d 100644 (file)
--- a/src/code/target-numbers.lisp
+++ b/src/code/target-numbers.lisp
@@ -210,8 +210,10 @@
 (defun upgraded-complex-part-type (spec)
   #!+sb-doc
   "Returns the element type of the most specialized COMPLEX number type that
 (defun upgraded-complex-part-type (spec)
   #!+sb-doc
   "Returns the element type of the most specialized COMPLEX number type that

-   can hold parts of type Spec."
-  (cond ((subtypep spec 'single-float)
+   can hold parts of type SPEC."
+  (cond ((unknown-type-p (specifier-type spec))
+        (error "undefined type: ~S" spec))
+       ((subtypep spec 'single-float)

         'single-float)
        ((subtypep spec 'double-float)
         'double-float)
         'single-float)
        ((subtypep spec 'double-float)
         'double-float)

@@ -220,7 +222,8 @@
         'long-float)
        ((subtypep spec 'rational)
         'rational)
         'long-float)
        ((subtypep spec 'rational)
         'rational)

-       (t)))
+       (t
+        'real)))

 
 (defun complex (realpart &optional (imagpart 0))
   #!+sb-doc
 
 (defun complex (realpart &optional (imagpart 0))
   #!+sb-doc

diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index 8c58fac..a21ec02 100644 (file)
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -9,7 +9,7 @@
 
 (in-package "SB!KERNEL")
 
 
 (in-package "SB!KERNEL")
 

-;;; The actual TYPEP engine. The compiler only generates calls to this
+;;; the actual TYPEP engine. The compiler only generates calls to this

 ;;; function when it can't figure out anything more intelligent to do.
 (defun %typep (object specifier)
   (%%typep object
 ;;; function when it can't figure out anything more intelligent to do.
 (defun %typep (object specifier)
   (%%typep object

@@ -101,6 +101,12 @@
                             (or (eq (car want) '*)
                                 (= (car want) (car got))))
                  (return nil))))
                             (or (eq (car want) '*)
                                 (= (car want) (car got))))
                  (return nil))))

+         (if (unknown-type-p (array-type-element-type type))
+             ;; better to fail this way than to get bogosities like
+             ;;   (TYPEP (MAKE-ARRAY 11) '(ARRAY SOME-UNDEFINED-TYPE)) => T
+             (error "~@<unknown element type in array type: ~2I~_~S~:>"
+                    (type-specifier type))
+             t)

          (or (eq (array-type-element-type type) *wild-type*)
              (values (type= (array-type-specialized-element-type type)
                             (specifier-type (array-element-type
          (or (eq (array-type-element-type type) *wild-type*)
              (values (type= (array-type-specialized-element-type type)
                             (specifier-type (array-element-type

@@ -159,7 +165,7 @@
      (error "Function types are not a legal argument to TYPEP:~%  ~S"
            (type-specifier type)))))
 
      (error "Function types are not a legal argument to TYPEP:~%  ~S"
            (type-specifier type)))))
 

-;;; Do type test from a class cell, allowing forward reference and
+;;; Do a type test from a class cell, allowing forward reference and

 ;;; redefinition.
 (defun class-cell-typep (obj-layout cell object)
   (let ((class (class-cell-class cell)))
 ;;; redefinition.
 (defun class-cell-typep (obj-layout cell object)
   (let ((class (class-cell-class cell)))

@@ -167,7 +173,7 @@
       (error "The class ~S has not yet been defined." (class-cell-name cell)))
     (class-typep obj-layout class object)))
 
       (error "The class ~S has not yet been defined." (class-cell-name cell)))
     (class-typep obj-layout class object)))
 

-;;; Test whether Obj-Layout is from an instance of Class.
+;;; Test whether OBJ-LAYOUT is from an instance of CLASS.

 (defun class-typep (obj-layout class object)
   (declare (optimize speed))
   (when (layout-invalid obj-layout)
 (defun class-typep (obj-layout class object)
   (declare (optimize speed))
   (when (layout-invalid obj-layout)

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index a24de41..8da9e72 100644 (file)
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -122,7 +122,7 @@
 
 ;;; This function is called when the type code wants to find out how
 ;;; an array will actually be implemented. We set the
 
 ;;; This function is called when the type code wants to find out how
 ;;; an array will actually be implemented. We set the

-;;; Specialized-Element-Type to correspond to the actual
+;;; SPECIALIZED-ELEMENT-TYPE to correspond to the actual

 ;;; specialization used in this implementation.
 (declaim (ftype (function (array-type) array-type) specialize-array-type))
 (defun specialize-array-type (type)
 ;;; specialization used in this implementation.
 (declaim (ftype (function (array-type) array-type) specialize-array-type))
 (defun specialize-array-type (type)

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index a883da0..e1071a8 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -460,19 +460,6 @@
                                    ',(find-class-cell name)
                                    object)))))))))
 
                                    ',(find-class-cell name)
                                    object)))))))))
 

-#|
-;;; Return (VALUES BEST-GUESS EXACT?), where BEST-GUESS is a CTYPE
-;;; which corresponds to the value returned by
-;;; CL:UPGRADED-ARRAY-ELEMENT-TYPE, and EXACT? tells whether that
-;;; result might change when we encounter a DEFTYPE.
-(declaim (maybe-inline upgraded-array-element-ctype-2))
-(defun upgraded-array-element-ctype-2 (spec)
-  (let ((ctype (specifier-type `(array ,spec))))
-    (values (array-type-specialized-element-type
-            (specifier-type `(array ,spec)))
-           (not (unknown-type-p (array-type-element-type ctype))))))
-|#
-

 ;;; If the specifier argument is a quoted constant, then we consider
 ;;; converting into a simple predicate or other stuff. If the type is
 ;;; constant, but we can't transform the call, then we convert to
 ;;; If the specifier argument is a quoted constant, then we consider
 ;;; converting into a simple predicate or other stuff. If the type is
 ;;; constant, but we can't transform the call, then we convert to

diff --git a/tests/assertoid.lisp b/tests/assertoid.lisp
index 4b1e9bf..c6dd931 100644 (file)
--- a/tests/assertoid.lisp
+++ b/tests/assertoid.lisp
@@ -14,6 +14,13 @@
 
 (cl:in-package :cl-user)
 
 
 (cl:in-package :cl-user)
 

+(defmacro grab-condition (&body body)
+  `(nth-value 1
+     (ignore-errors ,@body)))
+
+(defmacro raises-error? (&body body)
+  `(typep (nth-value 1 (ignore-errors ,@body)) 'error))
+

 ;;; EXPR is an expression to evaluate (both with EVAL and with
 ;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
 ;;; optimizations to pass to (DECLARE (OPTIMIZE ..)), to cause the
 ;;; EXPR is an expression to evaluate (both with EVAL and with
 ;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
 ;;; optimizations to pass to (DECLARE (OPTIMIZE ..)), to cause the

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 4afbba0..0824498 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -16,9 +16,7 @@
 
 (in-package "CL-USER")
 
 
 (in-package "CL-USER")
 

-(defmacro grab-condition (&body body)
-  `(nth-value 1
-     (ignore-errors ,@body)))
+(load "assertoid.lisp")

 
 (setf (logical-pathname-translations "demo0")
       '(("**;*.*.*" "/tmp/")))
 
 (setf (logical-pathname-translations "demo0")
       '(("**;*.*.*" "/tmp/")))

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 33b3f0c..9784892 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -1,5 +1,7 @@
 (in-package :cl-user)
 
 (in-package :cl-user)
 

+(load "assertoid.lisp")
+

 (let ((types '(character
               integer fixnum (integer 0 10)
               single-float (single-float -1.0 1.0) (single-float 0.1)
 (let ((types '(character
               integer fixnum (integer 0 10)
               single-float (single-float -1.0 1.0) (single-float 0.1)

@@ -22,5 +24,30 @@
 
 (assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10))))
 
 
 (assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10))))
 

+;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T
+;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T.
+(assert (raises-error? (upgraded-array-element-type 'some-undef-type)))
+(assert (eql (upgraded-array-element-type t) t))
+(assert (raises-error? (upgraded-complex-part-type 'some-undef-type)))
+(assert (subtypep (upgraded-complex-part-type 'fixnum) 'real))
+
+;;; Do reasonable things with undefined types, and with compound types
+;;; built from undefined types.
+;;;
+;;; part I: TYPEP
+(assert (typep #(11) '(simple-array t 1)))
+(assert (typep #(11) '(simple-array (or integer symbol) 1)))
+(assert (raises-error? (typep #(11) '(simple-array undef-type 1))))
+(assert (not (typep 11 '(simple-array undef-type 1))))
+;;; part II: SUBTYPEP
+(assert (subtypep '(vector some-undef-type) 'vector))
+(assert (not (subtypep '(vector some-undef-type) 'integer)))
+(macrolet ((nilnil (expr)
+            `(assert (equal '(nil nil) (multiple-value-list ,expr)))))
+  (nilnil (subtypep 'utype-1 'utype-2))
+  (nilnil (subtypep '(vector utype-1) '(vector utype-2)))
+  (nilnil (subtypep '(vector utype-1) '(vector t)))
+  (nilnil (subtypep '(vector t) '(vector utype-2))))
+

 ;;; success
 (quit :unix-status 104)
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 8c7d29b..28fb7e2 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 

-"0.6.10.13"
+"0.6.10.14"