Index: /branches/working-0711/ccl/level-1/l1-typesys.lisp
===================================================================
--- /branches/working-0711/ccl/level-1/l1-typesys.lisp	(revision 7923)
+++ /branches/working-0711/ccl/level-1/l1-typesys.lisp	(revision 7924)
@@ -3641,11 +3641,16 @@
               ((* :maybe) t))
             (or (eq (array-ctype-dimensions type) '*)
-                (do ((want (array-ctype-dimensions type) (cdr want))
-                     (got (array-dimensions object) (cdr got)))
-                    ((and (null want) (null got)) t)
-                  (unless (and want got
-                               (or (eq (car want) '*)
-                                   (= (car want) (car got))))
-                    (return nil))))
+                (let ((rank (array-rank object)))
+                  (declare (fixnum rank))
+                  (do* ((n 0 (1+ n))
+                        (want (array-ctype-dimensions type) (cdr want))
+                        (got (and (< n rank) (array-dimension object n))
+                             (and (< n rank) (array-dimension object n))))
+                       ((and (null want) (null got)) t)
+                    (declare (fixnum n))
+                    (unless (and want got
+                                 (or (eq (car want) '*)
+                                     (= (car want) got)))
+                      (return nil)))))
             (or (eq (array-ctype-element-type type) *wild-type*)
                 (type= (array-ctype-specialized-element-type type)