-
Notifications
You must be signed in to change notification settings - Fork 0
/
unit-test.el
235 lines (209 loc) · 8.94 KB
/
unit-test.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
;;; unit-test.el --- Run unit tests from Emacs with visual feedback
;;
;; Author: Mark Triggs <[email protected]>
;;
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;; Commentary:
;;
;; This code displays the results of unit tests with a small image in the
;; mode line. To use this code, bind the functions `run-unit-tests',
;; `open-unit-test-file' and `set-unit-test-command' to convenient keys
;; with something like:
;;
;; (define-key global-map (kbd "C-c t") 'run-unit-tests)
;; (define-key global-map (kbd "C-c s") 'set-unit-test-command)
;; (define-key global-map (kbd "C-c o") 'open-unit-test-file)
;;
;; You will need to define a value for `unit-test-command' in any buffer you
;; are interested in running tests from. This should be a function that does
;; whatever is necessary to run your unit tests, and returns:
;;
;; * nil if some tests failed.
;; * `handled' if the unit-test-command will update the mode line itself
;; (using `show-test-status' as described below) at some later time.
;; * any other non-nil value if all tests passed.
;;
;; The `handled' case is intended to allow you to use asynchronous commands to
;; run your unit tests. To signal the test results, the handler should
;; evaluate either (show-test-status 'passed) or (show-test-status 'failed).
;;
;; In the simplest case a test function might look like:
;;
;; (setq unit-test-command (lambda () (zerop (shell-command "make test"))))
;;
;;
;; To set a single command for a whole directory tree, you might use something
;; like:
;;
;; (add-hook 'find-file-hook 'apply-project-settings)
;;
;; (defun apply-project-settings ()
;; (let ((dir (expand-file-name default-directory)))
;; (cond ((string-match (expand-file-name "~/projects/some-project") dir)
;; (setq unit-test-command
;; (lambda ()
;; (let ((status (shell-command
;; "cd ~/projects/some-project; make")))
;; (cond ((equal status 0)
;; (message "All tests passed")
;; t)
;; (t (message "Some tests failed")
;; nil))))))
;; ...)))
;;
;; where running "make" is assumed to run all unit tests and return an error
;; status indicating success or failure.
;;; Code:
(defvar unit-test-command nil
"A function that runs the unit tests for this project.
This should have no required arguments and return nil if tests failed,
`handled' if the test indicator will be updated later, or non-nil otherwise.
Examples:
(setq unit-test-command 'my-defun)
(setq unit-test-command (lambda () ...))
(setq unit-test-command (lambda (&optional arg)
(interactive \"P\")
...))
")
(make-variable-buffer-local 'unit-test-command)
(defvar unit-test-file-fn nil
"A function that takes an absolute path to a file and returns an absolute
path to the corresponding file of unit tests, or nil if this file has no
unit tests.")
(make-variable-buffer-local 'unit-test-file-fn)
(defvar unit-test-colours '(("orange" . "#FF9900")
("dark-orange" . "#E86400")
("green" . "#00FF00")
("dark-green" . "#00C400")
("red" . "#FF0000")
("dark-red" . "#C40000")))
(defun unit-test-dot (colour)
"Return an XPM string representing a dot whose colour is COLOUR."
(format "/* XPM */
static char * test_pass_xpm[] = {
\"18 13 4 1\",
\" c None\",
\". c #000000\",
\"+ c %s\",
\"c c %s\",
\" \",
\" ..... \",
\" .ccccc. \",
\" .cc+++cc. \",
\" .cc+++++cc. \",
\" .c+++++++c. \",
\" .c+++++++c. \",
\" .c+++++++c. \",
\" .cc+++++cc. \",
\" .cc+++cc. \",
\" .ccccc. \",
\" ..... \",
\" \"};"
(cdr (assoc colour unit-test-colours))
(cdr (assoc (concat "dark-"colour) unit-test-colours))))
(defvar unit-test-passed-xpm (unit-test-dot "green")
"An XPM image displayed in the mode-line when all unit tests pass.")
(defvar unit-test-failed-xpm (unit-test-dot "red")
"An XPM image displayed in the mode-line when some unit tests fail.")
(defvar unit-test-running-xpm (unit-test-dot "orange")
"An XPM image displayed in the mode-line while tests are running.")
(defvar unit-test-passed-string ":o)"
"A string displayed in the mode-line when all unit tests pass.")
(defvar unit-test-failed-string ":o("
"A string displayed in the mode-line when some unit tests fail.")
(defvar unit-test-running-string ":o0"
"A string displayed in the mode-line while tests are running.")
(defvar unit-tests-passed-hook '())
(defvar unit-tests-failed-hook '())
(defun show-test-status (status)
(with-current-buffer (or last-unit-test-buffer
(current-buffer))
(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1] 'show-test-none)
(setq mode-line-buffer-identification
(if (and window-system
(member 'xpm image-types))
`(,(propertize " %b"
'help-echo (case status
(passed
"Tests passed")
(failed
"Some tests failed")
(running
"Tests running"))
'keymap map
'display
`(image :type xpm
:data ,(case status
(passed unit-test-passed-xpm)
(failed unit-test-failed-xpm)
(running
unit-test-running-xpm))
:ascent center)))
`(,(format " [%s] %%b"
(case status
(passed unit-test-passed-string)
(failed unit-test-failed-string)
(running unit-test-running-string))))))
(ignore-errors
(force-mode-line-update)
(redraw-modeline)))))
(defun show-test-none ()
(interactive)
(setq mode-line-buffer-identification '(#("%12b ")))
(when (fboundp 'redraw-modeline) (redraw-modeline)))
(defvar last-unit-test-buffer nil)
(defun run-unit-tests ()
(interactive)
(unless unit-test-command
(set-unit-test-command))
(setq last-unit-test-buffer (current-buffer))
(show-test-status 'running)
(sit-for 0)
(let ((result (if (commandp unit-test-command)
(call-interactively unit-test-command)
(funcall unit-test-command))))
(cond ((eq result 'handled) nil)
(result
(run-hooks 'unit-tests-passed-hook)
(show-test-status 'passed))
(to (run-hooks 'unit-tests-failed-hook)
(show-test-status 'failed)))))
(defun set-unit-test-command ()
(interactive)
(setq unit-test-command
(read-from-minibuffer "Function to run unit tests: "
(format "%S" unit-test-command)
read-expression-map t
'read-expression-history)))
(defun open-unit-test-file ()
"Open the file of unit tests for the current buffer"
(interactive)
(if (and (boundp 'unit-test-window-configuration))
(set-window-configuration unit-test-window-configuration)
(let ((window-configuration (current-window-configuration))
(file (buffer-file-name (current-buffer))))
(if (and file unit-test-file-fn)
(let ((unit-tests (funcall unit-test-file-fn file)))
(when unit-tests
(pop-to-buffer (or (find-buffer-visiting unit-tests)
(find-file-noselect unit-tests)))
(set (make-local-variable 'unit-test-window-configuration)
window-configuration)))
(message "No unit test file known for this buffer.")))))
(provide 'unit-test)
;;; unit-test.el ends here