- (dolist (case cases (values))
- (when (ignore-errors (apply (car case) *arguments*))
- (return (apply (cdr case) *arguments*)))))
-
-(defun call-with-mocks (mock-bindings function &key (recordp T))
- "Calls FUNCTION with the given MOCK-BINDINGS established and returns
-its return values as a LIST. If RECORDP is set, all invocations will be
-recorded and returned as the second return value, else NIL."
- (let* ((mocks (mock-bindings-mocks mock-bindings))
- (functions (mapcar #'car mocks))
- (previous (mapcar #'maybe-fdefinition functions)))
- (with-collector (invocations)
- (call-with-function-bindings
- functions
- (mapcar (lambda (binding previous &aux (name (car binding)) (cases (cdr binding)))
- (lambda (&rest args)
- (when recordp
- (invocations (cons name args)))
- (find-and-invoke-mock previous cases args)))
- mocks previous)
- (lambda ()
- (values
- (multiple-value-list
- (funcall function))
- (invocations)))
- previous))))
+ (when *recordp*
+ (let ((record (list (cons (car binding) *arguments*))))
+ (if (null (car *invocations*))
+ (setf (cdr *invocations*)
+ (setf (car *invocations*) record))
+ (setf (cdr *invocations*)
+ (setf (cddr *invocations*) record)))))
+ (dolist (case (cdddr binding) (values))
+ (let ((*previous* (cadr binding)))
+ (catch 'unhandled
+ (return (apply case *arguments*))))))