X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=bada4f66f376ffed35033c2c587d236a946360d6;hb=9af8ab0a80bbd4d579ed4a12d2a2819a7490901a;hp=2f10b1e98ee33b5cac10ad5d32441642a14cbb70;hpb=321fff35923fc7621307f3d8d6105cbef8511341;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 2f10b1e..bada4f6 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -335,8 +335,8 @@
 ;;; specified by TYPE, where STYPE is the type we have checked against
 ;;; (which is the same but for dimensions and element type).
 ;;;
-;;; Secondary return value is true if generated tests passing imply
-;;; that the array has a header.
+;;; Secondary return value is true if passing the generated tests implies that
+;;; the array has a header.
 (defun test-array-dimensions (obj type stype)
   (declare (type array-type type stype))
   (let ((obj `(truly-the ,(type-specifier stype) ,obj))
@@ -357,9 +357,15 @@
                        (= (%array-rank ,obj) 0))
                      t))
             ((not (array-type-complexp type))
-             (values (unless (eq '* (car dims))
-                       `((= (vector-length ,obj) ,@dims)))
-                     nil))
+             (if (csubtypep stype (specifier-type 'vector))
+                 (values (unless (eq '* (car dims))
+                           `((= (vector-length ,obj) ,@dims)))
+                         nil)
+                 (values (if (eq '* (car dims))
+                             `((not (array-header-p ,obj)))
+                             `((not (array-header-p ,obj))
+                               (= (vector-length ,obj) ,@dims)))
+                         nil)))
             (t
              (values (unless (eq '* (car dims))
                        `((if (array-header-p ,obj)