X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=d5ec1ca09fa1e2eb432465c2b4fbf31c46128cf1;hb=fd79e33e6b6dacdc52cf6668a5bb7adf75aad6c1;hp=151f4002e8a97fea64f831c5e9f2c94e3edfb2bd;hpb=7c5a4db7b036edb8969b93db5c114df88995ee6e;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 151f400..d5ec1ca 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1084,6 +1084,15 @@
   (assert (equal "GOOD!"
                  (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
                     *hairy-progv-var*))))
+
+(with-test (:name :fill-complex-single-float)
+  (assert (eql #c(-1.0 2.0)
+               (aref (funcall
+                      (lambda ()
+                        (make-array 2
+                                    :element-type '(complex single-float)
+                                    :initial-element #c(-1.0 2.0))))
+                     0))))
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
@@ -1835,4 +1844,27 @@
 (setf *mystery* :mystery)
 (assert (eq :ok (test-mystery (make-thing :slot :mystery))))
 
+;;; optimizing make-array
+(defun count-code-callees (f)
+  (let ((code (sb-kernel:fun-code-header f))
+        (n 0))
+    (loop for i from sb-vm::code-constants-offset below (sb-kernel:get-header-data code)
+          for c = (sb-kernel:code-header-ref code i)
+          do (when (typep c 'fdefn)
+               (print c)
+               (incf n)))
+    n))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '(3) :initial-contents (list x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents (vector x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents `(,x ,y ,z)))))))
+
 ;;; success