(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
(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