Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 240 lines (204 sloc) 8.937 kB
857a89c @sigma first version
authored
1 ;;; mocker.el --- mocking framework for emacs
2
3 ;; Copyright (C) 2011 Yann Hodique.
4
5 ;; Author: Yann Hodique <yann.hodique@gmail.com>
7a58d8c @sigma use default var for mocker-record
authored
6 ;; Keywords: lisp, testing
857a89c @sigma first version
authored
7
8 ;; This file is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version.
12
13 ;; This file is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to
20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA.
22
23 ;;; Commentary:
24
25 ;;
26
27 ;;; Code:
28
29 (require 'eieio)
30
7a58d8c @sigma use default var for mocker-record
authored
31 (defvar mocker-mock-default-record-cls 'mocker-record)
32
cd92c29 @sigma better abstraction of records
authored
33 ;;; Mock object
857a89c @sigma first version
authored
34 (defclass mocker-mock ()
35 ((function :initarg :function :type symbol)
36 (argspec :initarg :argspec :initform nil :type list)
37 (mode :initarg :mode :initform :ordered :type symbol)
38 (records :initarg :records :initform nil :type list)
7a58d8c @sigma use default var for mocker-record
authored
39 (record-cls :initarg :record-cls :type symbol)))
857a89c @sigma first version
authored
40
41 (defmethod constructor :static ((mock mocker-mock) newname &rest args)
7a58d8c @sigma use default var for mocker-record
authored
42 (let ((obj (call-next-method)))
43 (unless (slot-boundp obj :record-cls)
9cc7784 @sigma fix typo
authored
44 (oset obj :record-cls mocker-mock-default-record-cls))
7a58d8c @sigma use default var for mocker-record
authored
45 (let ((cls (oref obj :record-cls)))
46 (oset obj :records (mapcar #'(lambda (r)
47 (apply 'make-instance cls :-mock obj r))
48 (oref obj :records))))
857a89c @sigma first version
authored
49 obj))
50
5cc0206 @sigma stricter verifications
authored
51 (defmethod mocker-fail-mock ((mock mocker-mock) args)
52 (error (format (concat "Unexpected call to mock `%s'"
53 " with input `%s'")
54 (oref mock :function) args)))
857a89c @sigma first version
authored
55
56 (defmethod mocker-run ((mock mocker-mock) &rest args)
5cc0206 @sigma stricter verifications
authored
57 (let ((rec (mocker-find-active-record mock args))
857a89c @sigma first version
authored
58 (ordered (eq (oref mock :mode) :ordered)))
5cc0206 @sigma stricter verifications
authored
59 (cond ((null rec)
60 (mocker-fail-mock mock args))
61 ((or (not ordered) (mocker-test-record rec args))
77bb1ef @sigma refactoring to make records a bit more abstract
authored
62 (mocker-run-record rec args))
5cc0206 @sigma stricter verifications
authored
63 (t
64 (mocker-fail-record rec args)))))
65
66 (defmethod mocker-find-active-record ((mock mocker-mock) args)
8496ebc @sigma remove usage of cl's some to silence compiler
authored
67 (flet ((first-match (pred seq)
68 (let ((x nil))
69 (while (and seq
70 (not (setq x (funcall pred (pop seq))))))
71 x)))
72 (let* ((ordered (eq (oref mock :mode) :ordered))
73 rec)
74 (if ordered
75 (setq rec (first-match
76 #'(lambda (r)
77 (when (oref r :-active)
78 (if (mocker-test-record r args)
79 (progn
80 (mocker-use-record r)
81 r)
cd92c29 @sigma better abstraction of records
authored
82 (mocker-skip-record r args))))
8496ebc @sigma remove usage of cl's some to silence compiler
authored
83 (oref mock :records)))
84 (setq rec (first-match
85 #'(lambda (r)
86 (and
cd92c29 @sigma better abstraction of records
authored
87 (oref r :-active)
8496ebc @sigma remove usage of cl's some to silence compiler
authored
88 (mocker-test-record r args)
89 (progn
90 (mocker-use-record r)
91 r)))
92 (oref mock :records))))
93 rec)))
5cc0206 @sigma stricter verifications
authored
94
95 (defmethod mocker-verify ((mock mocker-mock))
96 (mapc #'(lambda (r) (when (and (oref r :-active)
97 (< (oref r :-occurrences)
98 (oref r :min-occur)))
99 (error (format (concat "Expected call to mock `%s'"
100 " with input matching `%s'"
101 " was not run.")
102 (oref mock :function)
103 (or (oref r :input-matcher)
104 (oref r :input))))))
105 (oref mock :records)))
857a89c @sigma first version
authored
106
cd92c29 @sigma better abstraction of records
authored
107 ;;; Mock record base object
108 (defclass mocker-record-base ()
109 ((min-occur :initarg :min-occur :initform 1 :type number)
264b072 @sigma better min/max handling
authored
110 (max-occur :initarg :max-occur :type (or null number))
857a89c @sigma first version
authored
111 (-occurrences :initarg :-occurrences :initform 0 :type number
9115ae5 @sigma better error handling
authored
112 :protection :protected)
5cc0206 @sigma stricter verifications
authored
113 (-mock :initarg :-mock)
114 (-active :initarg :-active :initform t :protection :protected)))
857a89c @sigma first version
authored
115
cd92c29 @sigma better abstraction of records
authored
116 (defmethod constructor :static ((rec mocker-record-base) newname &rest args)
264b072 @sigma better min/max handling
authored
117 (let* ((obj (call-next-method)))
118 (when (or (not (slot-boundp obj :max-occur))
119 (< (oref obj :max-occur)
120 (oref obj :min-occur)))
121 (oset obj :max-occur (oref obj :min-occur)))
122 obj))
123
cd92c29 @sigma better abstraction of records
authored
124 (defmethod mocker-use-record ((rec mocker-record-base))
125 (let ((max (oref rec :max-occur))
126 (n (1+ (oref rec :-occurrences))))
127 (oset rec :-occurrences n)
128 (when (and (not (null max))
129 (= n max))
130 (oset rec :-active nil))))
131
132 (defmethod mocker-skip-record ((rec mocker-record-base) args)
133 (if (>= (oref rec :-occurrences)
134 (oref rec :min-occur))
135 (oset rec :-active nil)
136 (mocker-fail-record rec args)))
137
77bb1ef @sigma refactoring to make records a bit more abstract
authored
138 (defmethod mocker-test-record ((rec mocker-record-base) args)
139 (error "not implemented in base class"))
140
141 (defmethod mocker-run-record ((rec mocker-record-base) args)
142 (error "not implemented in base class"))
143
144 (defmethod mocker-get-record-expectations ((rec mocker-record-base)))
145
146 (defmethod mocker-fail-record ((rec mocker-record-base) args)
147 (error (format (concat "Violated record while mocking `%s'."
148 " Expected input like: `%s', got: `%s' instead")
149 (oref (oref rec :-mock) :function)
150 (mocker-get-record-expectations rec)
151 args)))
152
cd92c29 @sigma better abstraction of records
authored
153 ;;; Mock record default object
154 (defclass mocker-record (mocker-record-base)
155 ((input :initarg :input :initform nil :type list)
156 (output :initarg :output :initform nil)
157 (input-matcher :initarg :input-matcher :initform nil)
158 (output-generator :initarg :output-generator :initform nil)))
159
5cc0206 @sigma stricter verifications
authored
160 (defmethod mocker-test-record ((rec mocker-record) args)
857a89c @sigma first version
authored
161 (let ((matcher (oref rec :input-matcher))
162 (input (oref rec :input)))
163 (cond (matcher
164 (apply matcher args))
165 (t
166 (equal input args)))))
167
77bb1ef @sigma refactoring to make records a bit more abstract
authored
168 (defmethod mocker-run-record ((rec mocker-record) args)
857a89c @sigma first version
authored
169 (let ((generator (oref rec :output-generator))
170 (output (oref rec :output)))
171 (cond (generator
172 (apply generator args))
173 (t
174 output))))
175
77bb1ef @sigma refactoring to make records a bit more abstract
authored
176 (defmethod mocker-get-record-expectations ((rec mocker-record))
177 (or (oref rec :input-matcher) (oref rec :input)))
178
179 ;;; Mock simple stub object
180 (defclass mocker-stub-record (mocker-record-base)
181 ((output :initarg :output :initform nil)))
182
0f30722 @sigma disable limits for stubs by default
authored
183 (defmethod constructor :static ((rec mocker-stub-record) newname &rest args)
184 (let* ((obj (call-next-method)))
185 (unless (slot-boundp obj :min-occur)
186 (oset obj :min-occur 0))
187 (unless (slot-boundp obj :max-occur)
188 (oset obj :max-occur nil))
189 obj))
190
77bb1ef @sigma refactoring to make records a bit more abstract
authored
191 (defmethod mocker-test-record ((rec mocker-stub-record) args)
192 t)
193
194 (defmethod mocker-run-record ((rec mocker-stub-record) args)
195 (oref rec :output))
857a89c @sigma first version
authored
196
197 (defun mocker-gen-mocks (mockspecs)
cd92c29 @sigma better abstraction of records
authored
198 "helper to generate mocks from the input of `mocker-let'"
857a89c @sigma first version
authored
199 (mapcar #'(lambda (m)
0e5adc1 @sigma generate better code from mocker-let
authored
200 (list (make-symbol (concat (symbol-name (car m))
201 "--mock"))
202 (apply 'make-instance 'mocker-mock
203 :function (car m)
204 :argspec (cadr m)
205 (cddr m))))
857a89c @sigma first version
authored
206 mockspecs))
207
cd92c29 @sigma better abstraction of records
authored
208 ;;;###autoload
857a89c @sigma first version
authored
209 (defmacro mocker-let (mockspecs &rest body)
210 (declare (indent 1) (debug t))
211 (let* ((mocks (mocker-gen-mocks mockspecs))
0e5adc1 @sigma generate better code from mocker-let
authored
212 (specs (mapcar
213 #'(lambda (m)
214 (let* ((mock-sym (car m))
215 (mock (cadr m))
216 (func (oref mock :function))
217 (spec (oref mock :argspec))
218 (args (loop for el in spec
219 if (or (not (symbolp el))
220 (not (equal
221 (elt (symbol-name el) 0)
222 ?&)))
223 collect el)))
224 (list func
225 spec
226 `(mocker-run ,mock-sym ,@args))))
227 mocks))
5cc0206 @sigma stricter verifications
authored
228 (verifs (mapcar #'(lambda (m)
0e5adc1 @sigma generate better code from mocker-let
authored
229 `(mocker-verify ,(car m)))
5cc0206 @sigma stricter verifications
authored
230 mocks)))
0e5adc1 @sigma generate better code from mocker-let
authored
231 `(let (,@mocks)
232 (flet (,@specs)
233 (prog1
234 (progn
235 ,@body)
236 ,@verifs)))))
857a89c @sigma first version
authored
237
238 (provide 'mocker)
239 ;;; mocker.el ends here
Something went wrong with that request. Please try again.