-;;; PROGV compilation and type checking when the declared type
-;;; includes a FUNCTION subtype.
-(declaim (type (or (function (t) (values boolean &optional)) string)
- *hairy-progv-var*))
-(defvar *hairy-progv-var* #'null)
-(with-test (:name :hairy-progv-type-checking)
- (assert (eq :error
- (handler-case
- (progv '(*hairy-progv-var*) (list (eval 42))
- *hairy-progv-var*)
- (type-error () :error))))
- (assert (equal "GOOD!"
- (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
- *hairy-progv-var*))))
+;;; 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)))))))
+