1 ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
5 ;;; syntactic sugar for defining the mock interactions
7 (defun make-lambda-pattern (literal-pattern)
8 (let (lambda-pattern values)
10 for (car . cdr) = literal-pattern
12 do (let ((sym (gensym)))
13 (setf lambda-pattern (append lambda-pattern (list sym)))
14 (push `(,sym . ,(if (or (symbolp car) (listp car)) `(quote ,car) car)) values)
15 (pop literal-pattern)))
16 (values lambda-pattern values)))
18 (defun make-test-pattern (values)
19 `(and ,.(mapcar (lambda (value)
20 `(equal ,(car value) ,(cdr value)))
23 (defmacro when-called (mock-bindings call &body forms)
24 (let ((name (if (listp call) (car call) call))
30 (multiple-value-bind (lambda-pattern values)
31 (make-lambda-pattern (cdr call))
33 (destructuring-bind ,lambda-pattern args
34 ,(make-test-pattern values))))
36 (let ((,sym (fdefinition ',name)))
37 (declare (ignorable ,sym))
41 (declare (ignorable args))
42 (case (prog1 times (incf times))
45 for (form . rest) on forms
46 collect `(,(if rest i T) ,form)))))
48 (declare (ignorable args))
51 (defun invocation-count (name invocations)
52 (count name invocations :key #'car :test #'eq))
54 (defun was-called-p (name invocations)
55 (member name invocations :key #'car :test #'eq))