1.0.29.53: some LOAD-TIME-VALUE smartness

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

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 26b12ce..6795171 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1084,6 +1084,21 @@
   (assert (equal "GOOD!"
                  (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
                     *hairy-progv-var*))))
+
+(with-test (:name :fill-complex-single-float)
+  (assert (every (lambda (x) (eql x #c(-1.0 -2.0)))
+                 (funcall
+                  (lambda ()
+                    (make-array 2
+                                :element-type '(complex single-float)
+                                :initial-element #c(-1.0 -2.0)))))))
+
+(with-test (:name :make-array-symbol-as-initial-element)
+  (assert (every (lambda (x) (eq x 'a))
+                 (funcall
+                  (compile nil
+                           `(lambda ()
+                              (make-array 12 :initial-element 'a)))))))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
@@ -1835,27 +1850,4 @@
 (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