Index: /trunk/source/level-1/l1-typesys.lisp
===================================================================
--- /trunk/source/level-1/l1-typesys.lisp	(revision 8523)
+++ /trunk/source/level-1/l1-typesys.lisp	(revision 8524)
@@ -3643,27 +3643,27 @@
            ((nil) (simple-array-p object))
            ((* :maybe) t))
-         (let* ((ctype-dimensions (array-ctype-dimensions type))
-                (header-p (= typecode target::subtag-arrayH)))
-           (or (eq (array-ctype-dimensions type) '*)
-               (and (null (cdr ctype-dimensions)) (not header-p))
-               (and header-p
-                    (let* ((rank (%svref object target::arrayH.rank-cell)))
-                      (declare (fixnum rank))
-                      (and (= rank (length ctype-dimensions))
-                           (do* ((i 0 (1+ i))
-                                 (dim target::arrayH.dim0-cell (1+ dim))
-                                 (want (array-ctype-dimensions type) (cdr want))
-                                 (got (%svref object dim) (%svref object dim)))
-                                ((= i rank) t)
-                             (unless (or (eq (car want) '*)
-                                         (= (car want) got))
-                               (return nil)))))))
-           (or (eq (array-ctype-element-type type) *wild-type*)
-               (eql (array-ctype-typecode type)
-                    (if (> typecode target::subtag-vectorH)
+         (let* ((ctype-dimensions (array-ctype-dimensions type)))
+           (or (eq ctype-dimensions '*)
+	       (if (eql typecode target::subtag-arrayH)
+		   (let* ((rank (%svref object target::arrayH.rank-cell)))
+		     (declare (fixnum rank))
+		     (and (eql rank (length ctype-dimensions))
+			  (do* ((i 0 (1+ i))
+				(dim target::arrayH.dim0-cell (1+ dim))
+				(want (array-ctype-dimensions type) (cdr want))
+				(got (%svref object dim) (%svref object dim)))
+			       ((eql i rank) t)
+			    (unless (or (eq (car want) '*)
+					(eql (car want) (the fixnum got)))
+			      (return nil)))))
+		   (and (null (cdr ctype-dimensions))
+			(eql (car ctype-dimensions) (array-total-size object))))))
+	 (or (eq (array-ctype-element-type type) *wild-type*)
+	     (eql (array-ctype-typecode type)
+		  (if (> typecode target::subtag-vectorH)
                       typecode
                       (ldb target::arrayH.flags-cell-subtag-byte (the fixnum (%svref object target::arrayH.flags-cell)))))
-               (type= (array-ctype-specialized-element-type type)
-                      (specifier-type (array-element-type object))))))))
+	     (type= (array-ctype-specialized-element-type type)
+		    (specifier-type (array-element-type object)))))))
 
 
