- (let* ((binding (list name (maybe-fdefinition name) NIL))
- (function (lambda (&rest arguments)
- (find-and-invoke-mock binding arguments))))
- (setf (caddr binding) function)
- (push binding *mock-bindings*)
- (set-fdefinition name function)
+ (let* ((fdefinition (maybe-fdefinition name))
+ (binding (list name fdefinition NIL)))
+ #+(or)
+ (when fdefinition
+ (when (and (typep fdefinition '(and function (not generic-function)))
+ method)
+ (warn "Rebinding regular function ~S to generic function." name))
+ (when (and (typep fdefinition 'generic-function)
+ (not method))
+ (warn "Rebinding generic function ~S to regular function." name)))
+ (if method
+ (let* ((qualifiers (car method))
+ (specializers-form (cadr method))
+ (specializers (mapcar #'classify specializers-form))
+ (method (find-method fdefinition qualifiers specializers NIL)))
+ (ensure-method fdefinition
+ `(lambda (list)
+ (let ((*arguments* (list list)))
+ (when *recordp*
+ (record-invocation (cons ',name *arguments*)))
+ (values)))
+ :qualifiers qualifiers))
+ (let ((function (lambda (&rest arguments)
+ (find-and-invoke-mock binding arguments))))
+ (setf (caddr binding) function)
+ (push binding *mock-bindings*)
+ (set-fdefinition name function)))