From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 10 Aug 2009 09:58:45 +0000 (+0000)
Subject: 1.0.30.42: missing array predicate definitions
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=877c7683fc42a2350a6a422433a1a9be02fe3c4f;p=sbcl.git

1.0.30.42: missing array predicate definitions

 * Not all specialized array predicates had an out-of-line predicate.
   Generate them from the SAETP vector. Reported by Stelian Ionescu.

 * Test case.
---

diff --git a/NEWS b/NEWS
index f368e7e..fea08fb 100644
--- a/NEWS
+++ b/NEWS
@@ -50,6 +50,8 @@ changes relative to sbcl-1.0.30:
     Elsasser)
   * improvement: pretty-printing of various Lisp forms has been improved
     (thanks to Tobias Rittweiler)
+  * bug fix: some out-of-line array predicates were missing (reported by
+    Stelian Ionescu)
   * bug fix: a failing AVER in CONVERT-MV-CALL has been fixed. (thanks to
     Larry D'Anna)
   * bug fix: a failing AVER in %ALLOCATE-CLOSURES conversion has been fixed
diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index 2830c51..346e388 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -115,43 +115,33 @@
   (def-type-predicate-wrapper ratiop)
   (def-type-predicate-wrapper realp)
   (def-type-predicate-wrapper short-float-p)
-  (def-type-predicate-wrapper simple-array-p)
-  (def-type-predicate-wrapper simple-bit-vector-p)
-  (def-type-predicate-wrapper simple-base-string-p)
-  #!+sb-unicode (def-type-predicate-wrapper simple-character-string-p)
-  (def-type-predicate-wrapper simple-string-p)
-  (def-type-predicate-wrapper simple-vector-p)
   (def-type-predicate-wrapper single-float-p)
-  (def-type-predicate-wrapper stringp)
   (def-type-predicate-wrapper %instancep)
   (def-type-predicate-wrapper symbolp)
   (def-type-predicate-wrapper system-area-pointer-p)
   (def-type-predicate-wrapper weak-pointer-p)
-  (def-type-predicate-wrapper vectorp)
-  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-  (def-type-predicate-wrapper unsigned-byte-32-p)
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-  (def-type-predicate-wrapper signed-byte-32-p)
+  (progn
+    (def-type-predicate-wrapper unsigned-byte-32-p)
+    (def-type-predicate-wrapper signed-byte-32-p))
   #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-  (def-type-predicate-wrapper unsigned-byte-64-p)
-  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-  (def-type-predicate-wrapper signed-byte-64-p)
-  (def-type-predicate-wrapper simple-array-nil-p)
-  (def-type-predicate-wrapper simple-array-unsigned-byte-2-p)
-  (def-type-predicate-wrapper simple-array-unsigned-byte-4-p)
-  (def-type-predicate-wrapper simple-array-unsigned-byte-8-p)
-  (def-type-predicate-wrapper simple-array-unsigned-byte-16-p)
-  (def-type-predicate-wrapper simple-array-unsigned-byte-32-p)
-  (def-type-predicate-wrapper simple-array-signed-byte-8-p)
-  (def-type-predicate-wrapper simple-array-signed-byte-16-p)
-  (def-type-predicate-wrapper simple-array-signed-byte-30-p)
-  (def-type-predicate-wrapper simple-array-signed-byte-32-p)
-  (def-type-predicate-wrapper simple-array-single-float-p)
-  (def-type-predicate-wrapper simple-array-double-float-p)
-  #!+long-float (def-type-predicate-wrapper simple-array-long-float-p)
-  (def-type-predicate-wrapper simple-array-complex-single-float-p)
-  (def-type-predicate-wrapper simple-array-complex-double-float-p)
-  #!+long-float (def-type-predicate-wrapper simple-array-complex-long-float-p)
+  (progn
+    (def-type-predicate-wrapper unsigned-byte-64-p)
+    (def-type-predicate-wrapper signed-byte-64-p))
+  ;; Specialized array types
+  (macrolet ((saetp-defs ()
+               `(progn
+                  ,@(map 'list
+                         (lambda (saetp)
+                           `(def-type-predicate-wrapper
+                                ,(symbolicate (sb!vm:saetp-primitive-type-name saetp) "-P")))
+                         sb!vm:*specialized-array-element-type-properties*))))
+    (saetp-defs))
+  ;; Other array types
+  (def-type-predicate-wrapper simple-array-p)
+  (def-type-predicate-wrapper simple-string-p)
+  (def-type-predicate-wrapper stringp)
+  (def-type-predicate-wrapper vectorp)
   (def-type-predicate-wrapper vector-nil-p))
 
 ;;; Return the specifier for the type of object. This is not simply
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index e8309c7..48cf250 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3233,6 +3233,20 @@
                            t))))
     (ctu:assert-no-consing (funcall f))))
 
+(with-test (:name :array-type-predicates)
+  (dolist (et sb-kernel::*specialized-array-element-types*)
+    (when et
+      (let* ((v (make-array 3 :element-type et))
+             (fun (compile nil `(lambda ()
+                                  (list
+                                   (if (typep ,v '(simple-array ,et (*)))
+                                       :good
+                                       :bad)
+                                   (if (typep (elt ,v 0) '(simple-array ,et (*)))
+                                       :bad
+                                       :good))))))
+        (assert (equal '(:good :good) (funcall fun)))))))
+
 (with-test (:name :truncate-float)
   (let ((s (compile nil `(lambda (x)
                            (declare (single-float x))
diff --git a/version.lisp-expr b/version.lisp-expr
index edf1472..189db65 100644
--- 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.30.41"
+"1.0.30.42"