7 #:mock-call-return-values
8 #:mocked-function-called-p
9 #:mocked-function-calls))
14 (calls (make-hash-table :test 'eq)))
19 (defvar *mock-state-chain* nil)
21 (defun binding-name (binding)
26 (defun make-mock-lambda (binding orig-definition state)
27 (let* ((args (gensym "ARGS"))
28 (results (gensym "RESULTS"))
29 (name (binding-name binding))
30 (body (etypecase binding
31 (list `(apply (lambda ,(second binding) ,@(cddr binding))
33 (symbol '(call-mocked-function)))))
34 `(lambda (&rest ,args)
35 (macrolet ((call-mocked-function (&rest changed-args)
36 (if (null changed-args)
37 `(apply ,',orig-definition ,',args)
38 `(funcall ,',orig-definition ,@changed-args))))
39 (let ((,results (multiple-value-list ,body)))
40 (push (make-mock-call :args ,args :return-values ,results)
41 (gethash ',name (mock-state-calls ,state)))
42 (values-list ,results))))))
44 (defmacro mock-labels (bindings &body body)
45 (let ((temps (loop for b in bindings collect (gensym)))
46 (state (gensym "MOCK-STATE")))
47 `(let* ((,state (make-mock-state))
48 (*mock-state-chain* (cons ,state *mock-state-chain*))
52 ,@(loop for binding in bindings
54 for name = (binding-name binding)
55 collect `(setf ,temp (fdefinition ',name))
56 collect `(setf (fdefinition ',name)
57 ,(make-mock-lambda binding temp state)))
59 ,@(loop for binding in bindings
61 for name = (binding-name binding)
62 collect `(setf (fdefinition ',name) ,temp))))))
64 (defmacro call-mocked-function (&rest args)
65 (declare (ignore args))
66 (error "~A used outside of ~A definition"
67 'call-mocked-function 'mock-labels))
69 (defun mocked-function-calls (name)
70 (loop for s in *mock-state-chain*
71 thereis (gethash name (mock-state-calls s))))
73 (defun mocked-function-called-p (name)
74 (not (null (mocked-function-calls name))))
77 ;; (defun foobar (x y)
80 ;; (defun mock-test-1 ()
81 ;; (mock-labels ((foobar (x y) (call-mocked-function x (1+ y))))
82 ;; (values (foobar 2 3)
84 ;; (mocked-function-calls 'foobar))))
86 ;; (defun mock-test-2 ()
87 ;; (mock-labels (foobar)
88 ;; (values (foobar 2 3)
90 ;; (mocked-function-calls 'foobar))))