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 4b3d1de..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)))
@@ -774,6 +782,35 @@
                          (declare (type (integer 4303063 101130078) a))
                          (mask-field (byte 18 2) (ash a 77))))
               57132532)))
+;;; rewrite the test case to get the unsigned-byte 32/64
+;;; implementation even after implementing some modular arithmetic
+;;; with signed-byte 30:
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (mask-field (byte 30 2) (ash a 77))))
+              57132532)))
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (mask-field (byte 64 2) (ash a 77))))
+              57132532)))
+;;; and a similar test case for the signed masking extension (not the
+;;; final interface, so change the call when necessary):
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (sb-c::mask-signed-field 30 (ash a 77))))
+              57132532)))
+(assert (= 0 (funcall
+              (compile nil
+                       '(lambda (a)
+                         (declare (type (integer 4303063 101130078) a))
+                         (sb-c::mask-signed-field 61 (ash a 77))))
+              57132532)))
 
 ;;; MISC.101 and MISC.103: FLUSH-DEST did not mark the USE's block for
 ;;; type check regeneration
@@ -1947,7 +1984,7 @@
                                              (bit #*1001101001001
                                                   (min 12 (max 0 lv3))))))))))))
 
-;;; MISC.624: erronous AVER in x86's %LOGBITP VOPs
+;;; MISC.624: erroneous AVER in x86's %LOGBITP VOPs
 (assert (eql 0
              (funcall
               (compile
@@ -2251,3 +2288,65 @@
 
 ;;; bug in adding DATA-VECTOR-REF-WITH-OFFSET to x86-64
 (assert (not (mismatch #(1.0f0 2.0f0) (make-array 2 :element-type 'single-float :initial-contents (list 1.0f0 2.0f0)))))
+
+;;; bug in interval-arithmetic used by the compiler: needless attempt to coerce too
+;;; large bignums to floats
+(dolist (op '(* / + -))
+  (let ((fun (compile
+              nil
+              `(lambda (x)
+                 (declare (type (integer 0 #.(* 2 (truncate most-positive-double-float))) x))
+                 (,op 0.0d0 x)))))
+    (loop repeat 10
+          do (let ((arg (random (truncate most-positive-double-float))))
+               (assert (eql (funcall fun arg)
+                            (funcall op 0.0d0 arg)))))))
+
+(with-test (:name :high-debug-known-function-inlining)
+  (let ((fun (compile nil
+                      '(lambda ()
+                        (declare (optimize (debug 3)) (inline append))
+                        (let ((fun (lambda (body)
+                                     (append
+                                      (first body)
+                                      nil))))
+                          (funcall fun
+                                   '((foo (bar)))))))))
+    (funcall fun)))
+
+(with-test (:name :high-debug-known-function-transform-with-optional-arguments)
+  (compile nil '(lambda (x y)
+               (declare (optimize sb-c::preserve-single-use-debug-variables))
+               (if (block nil
+                     (some-unknown-function
+                      (lambda ()
+                        (return (member x y))))
+                     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))))))