1.0.28.73: regression from 1.0.28.21

 * One leg of logic lost in the refactoring: if the type to verify is
   (SIMPLE-ARRAY * (*)) we need to check that there is no array
   header.

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 2f10b1e..bada4f6 100644 (file)
--- 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)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index db2bfc4..a7fd779 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2917,3 +2917,9 @@
                                           :initial-element x)))
                   10
                   #c(1.0 2.0)))))
+
+(with-test (:name :regression-1.0.28.21)
+  (let ((fun (compile nil `(lambda (x) (typep x '(simple-array * 1))))))
+    (assert (funcall fun (vector 1 2 3)))
+    (assert (funcall fun "abc"))
+    (assert (not (funcall fun (make-array '(2 2)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index fe9eba3..f650062 100644 (file)
--- 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".)
-"1.0.28.72"
+"1.0.28.73"