1.0.37.43: add RAW-INSTANCE-INIT/* VOPs for PPC

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 3df48f9..5ef755f 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3420,6 +3420,23 @@
     (assert (not warningp))
     (assert (= 1.0d0 (funcall fun)))))
 
+(with-test (:name :%array-data-vector-type-derivation)
+  (let* ((f (compile nil
+                     `(lambda (ary)
+                        (declare (type (simple-array (unsigned-byte 32) (3 3)) ary))
+                        (setf (aref ary 0 0) 0))))
+         (text (with-output-to-string (s)
+                 (disassemble f :stream s))))
+    (assert (not (search "OBJECT-NOT-SIMPLE-ARRAY-UNSIGNED-BYTE-32-ERROR" text)))))
+
+(with-test (:name :array-storage-vector-type-derivation)
+  (let ((f (compile nil
+                    `(lambda (ary)
+                       (declare (type (simple-array (unsigned-byte 32) (3 3)) ary))
+                       (ctu:compiler-derived-type (array-storage-vector ary))))))
+    (assert (equal '(simple-array (unsigned-byte 32) (9))
+                   (funcall f (make-array '(3 3) :element-type '(unsigned-byte 32)))))))
+
 (with-test (:name :bug-523612)
   (let ((fun
          (compile nil
@@ -3429,3 +3446,59 @@
                                  (if toff (list toff 0d0 0d0) (list 0d0 0d0 0d0)))))))
     (assert (equalp (vector 0.0d0 0.0d0 0.0d0) (funcall fun :toff nil)))
     (assert (equalp (vector 2.3d0 0.0d0 0.0d0) (funcall fun :toff 2.3d0)))))
+
+(with-test (:name :bug-309788)
+  (let ((fun
+         (compile nil
+                  `(lambda (x)
+                     (declare (optimize speed))
+                     (let ((env nil))
+                       (typep x 'fixnum env))))))
+    (assert (not (ctu:find-named-callees fun)))))
+
+(with-test (:name :bug-309124)
+  (let ((fun
+         (compile nil
+                  `(lambda (x)
+                     (declare (integer x))
+                     (declare (optimize speed))
+                     (cond ((typep x 'fixnum)
+                            "hala")
+                           ((typep x 'fixnum)
+                            "buba")
+                           ((typep x 'bignum)
+                            "hip")
+                           (t
+                            "zuz"))))))
+    (assert (equal (list "hala" "hip")
+                   (sort (ctu:find-code-constants fun :type 'string)
+                         #'string<)))))
+
+(with-test (:name :bug-316078)
+  (let ((fun
+         (compile nil
+                  `(lambda (x)
+                     (declare (type (and simple-bit-vector (satisfies bar)) x)
+                              (optimize speed))
+                     (elt x 5)))))
+    (assert (not (ctu:find-named-callees fun)))
+    (assert (= 1 (funcall fun #*000001)))
+    (assert (= 0 (funcall fun #*000010)))))
+
+(with-test (:name :mult-by-one-in-float-acc-zero)
+  (assert (eql 1.0 (funcall (compile nil `(lambda (x)
+                                            (declare (optimize (sb-c::float-accuracy 0)))
+                                            (* x 1.0)))
+                            1)))
+  (assert (eql -1.0 (funcall (compile nil `(lambda (x)
+                                             (declare (optimize (sb-c::float-accuracy 0)))
+                                             (* x -1.0)))
+                             1)))
+  (assert (eql 1.0d0 (funcall (compile nil `(lambda (x)
+                                              (declare (optimize (sb-c::float-accuracy 0)))
+                                              (* x 1.0d0)))
+                              1)))
+  (assert (eql -1.0d0 (funcall (compile nil `(lambda (x)
+                                               (declare (optimize (sb-c::float-accuracy 0)))
+                                               (* x -1.0d0)))
+                               1))))