1.0.16.16: Use declared element type in AREF short-circuit transform

[sbcl.git] / tests / compiler.pure.lisp

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 5d12ac0..b5df3b9 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -528,11 +528,19 @@
     (funcall f y 1)
     (assert (equal y #*10))))
 
+;;; use of declared array types
 (handler-bind ((sb-ext:compiler-note #'error))
   (compile nil '(lambda (x)
-                 (declare (type (simple-array (simple-string 3) (5)) x))
+                 (declare (type (simple-array (simple-string 3) (5)) x)
+                          (optimize speed))
                  (aref (aref x 0) 0))))
 
+(handler-bind ((sb-ext:compiler-note #'error))
+  (compile nil '(lambda (x)
+                 (declare (type (simple-array (simple-array bit (10)) (10)) x)
+                          (optimize speed))
+                 (1+ (aref (aref x 0) 0)))))
+
 ;;; compiler failure
 (let ((f (compile nil '(lambda (x) (typep x '(not (member 0d0)))))))
   (assert (funcall f 1d0)))
@@ -2316,3 +2324,29 @@
                      t)
                    t
                    (error "~a" y)))))
+
+;;; Compiling W-P-O when the pinned objects are known to be fixnums
+;;; or characters.
+(compile nil '(lambda (x y)
+               (declare (fixnum y) (character x))
+               (sb-sys:with-pinned-objects (x y)
+                 (some-random-function))))
+
+;;; *CHECK-CONSISTENCY* and TRULY-THE
+
+(with-test (:name :bug-423)
+  (let ((sb-c::*check-consistency* t))
+    (handler-bind ((warning #'error))
+      (flet ((make-lambda (type)
+               `(lambda (x)
+                  ((lambda (z)
+                     (if (listp z)
+                         (let ((q (truly-the list z)))
+                           (length q))
+                         (if (arrayp z)
+                             (let ((q (truly-the vector z)))
+                               (length q))
+                             (error "oops"))))
+                   (the ,type x)))))
+        (compile nil (make-lambda 'list))
+        (compile nil (make-lambda 'vector))))))