+ (let ((ctors (find-named-callees fun :type 'sb-pcl::ctor)))
+ (assert ctors)
+ (assert (not (cdr ctors)))
+ (assert (find-named-callees (car ctors) :name 'sb-pcl::fast-make-instance)))))
+
+;;; Make sure we get default initargs right with on the FAST-MAKE-INSTANCE path CTORs
+;;; in more interesting cases as well...
+(defparameter *some-counter* 0)
+(let* ((x 'success2))
+ (defclass some-class2 ()
+ ((aroundp :initform nil :reader aroundp))
+ (:default-initargs :x (progn (incf *some-counter*) x))))
+
+(defmethod initialize-instance :around ((some-class some-class2) &key (x :fail2?))
+ (unless (eq x 'success2)
+ (error "Default initarg lossage"))
+ (setf (slot-value some-class 'aroundp) t)
+ (when (next-method-p)
+ (call-next-method)))
+
+(with-test (:name (make-instance :ctor-default-initargs-2))
+ (assert (= 0 *some-counter*))
+ (assert (aroundp (eval `(make-instance 'some-class2))))
+ (assert (= 1 *some-counter*))
+ (let ((fun (compile nil `(lambda () (make-instance 'some-class2)))))
+ (assert (= 1 *some-counter*))
+ (assert (aroundp (funcall fun)))
+ (assert (= 2 *some-counter*))
+ ;; make sure we tested what we think we tested...
+ (let ((ctors (find-named-callees fun :type 'sb-pcl::ctor)))
+ (assert ctors)
+ (assert (not (cdr ctors)))
+ (assert (find-named-callees (car ctors) :name 'sb-pcl::fast-make-instance)))))
+
+;;; No compiler notes, please
+(locally (declare (optimize safety))
+ (defclass type-check-thing ()
+ ((slot :type (integer 0) :initarg :slot))))
+(with-test (:name (make-instance :no-compile-note-at-runtime))
+ (let ((fun (compile nil `(lambda (x)
+ (declare (optimize safety))
+ (make-instance 'type-check-thing :slot x)))))
+ (handler-bind ((sb-ext:compiler-note #'error))
+ (funcall fun 41)
+ (funcall fun 13))))
+
+;;; NO-APPLICABLE-METHOD called
+(defmethod no-applicable-method ((gf (eql #'make-instance)) &rest args)
+ (cons :no-applicable-method args))
+(with-test (:name :constant-invalid-class-arg)
+ (assert (equal
+ '(:no-applicable-method "FOO" :quux 14)
+ (funcall (compile nil `(lambda (x) (make-instance "FOO" :quux x))) 14)))
+ (assert (equal
+ '(:no-applicable-method 'abc zot 1 bar 2)
+ (funcall (compile nil `(lambda (x y) (make-instance ''abc 'zot x 'bar y)))
+ 1 2))))
+(with-test (:name :variable-invalid-class-arg)
+ (assert (equal
+ '(:no-applicable-method "FOO" :quux 14)
+ (funcall (compile nil `(lambda (c x) (make-instance c :quux x))) "FOO" 14)))
+ (assert (equal
+ '(:no-applicable-method 'abc zot 1 bar 2)
+ (funcall (compile nil `(lambda (c x y) (make-instance c 'zot x 'bar y)))
+ ''abc 1 2))))