1.0.43.1: better handling of complex array types in fill-pointer ops

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 118fce2..531acc1 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3519,7 +3519,7 @@
                           (let ((iterator+976 #'iterator+976))
                             (funcall iterator+976))))))))
 
-(with-test (:name :complex-float-local-fun-args :fails-on :x86-64)
+(with-test (:name :complex-float-local-fun-args)
   ;; As of 1.0.27.14, the lambda below failed to compile due to the
   ;; compiler attempting to pass unboxed complex floats to Z and the
   ;; MOVE-ARG method not expecting the register being used as a
@@ -3531,3 +3531,30 @@
                               (* b (z b c))))
                           (loop for i below 10 do
                                 (setf a (z a a)))))))
+
+(with-test (:name :bug-309130)
+  (assert (eq :warning
+              (handler-case
+                  (compile nil `(lambda () (svref (make-array 8 :adjustable t) 1)))
+                ((and warning (not style-warning)) ()
+                  :warning))))
+  (assert (eq :warning
+              (handler-case
+                  (compile nil `(lambda (x)
+                                  (declare (optimize (debug 0)))
+                                  (declare (type vector x))
+                                  (list (fill-pointer x) (svref x 1))))
+                ((and warning (not style-warning)) ()
+                  :warning))))
+  (assert (eq :warning
+              (handler-case
+                  (compile nil `(lambda (x)
+                                  (list (vector-push (svref x 0) x))))
+                ((and warning (not style-warning)) ()
+                  :warning))))
+  (assert (eq :warning
+              (handler-case
+                  (compile nil `(lambda (x)
+                                  (list (vector-push-extend (svref x 0) x))))
+                ((and warning (not style-warning)) ()
+                  :warning)))))