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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
|
;;; ert2.el --- Additions to ert.el
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2008-09-02T11:46:03+0200 Tue
;; Version:
;; Last-Updated: 2009-01-06 Tue
;; URL:
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;; Cannot open load file: ert2.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program 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 program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile
(let* ((this-file (or load-file-name
(when (boundp 'bytecomp-filename) bytecomp-filename)
buffer-file-name))
(this-dir (file-name-directory this-file))
(load-path (cons this-dir load-path)))
(require 'ert)))
(let* ((this-dir
(file-name-directory (if load-file-name load-file-name buffer-file-name)))
;;(load-path (copy-list load-path)))
(load-path (copy-sequence load-path)))
(add-to-list 'load-path this-dir)
(require 'ert))
(defvar ert-temp-test-buffer-test nil)
(make-variable-buffer-local 'ert-temp-test-buffer-test)
(put 'ert-temp-test-buffer-test 'permanent-local t)
(defvar ert-temp-test-buffer-file nil)
(make-variable-buffer-local 'ert-temp-test-buffer-file)
(put 'ert-temp-test-buffer-file 'permanent-local t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Test buffers
(defvar ert-failed-tests-temp-buffers nil)
(defvar ert-list-failed-buffers-name "*Ert Failed Test Buffers*")
(defun ert-kill-temp-test-buffers ()
"Delete test buffers from unsuccessful tests."
(interactive)
(let ((failed (get-buffer ert-list-failed-buffers-name)))
(when failed (kill-buffer failed)))
(dolist (buf ert-failed-tests-temp-buffers)
(when (buffer-live-p buf)
(kill-buffer buf)))
(setq ert-failed-tests-temp-buffers nil))
(defun ert-list-temp-test-buffers ()
"List test buffers from unsuccessful tests."
(interactive)
(setq ert-failed-tests-temp-buffers
(delq nil
(mapcar (lambda (buf)
(when (buffer-live-p buf)
buf))
ert-failed-tests-temp-buffers)))
(let ((ert-buffer (get-buffer "*ert*"))
(buffers ert-failed-tests-temp-buffers))
(when ert-buffer (setq buffers (cons ert-buffer buffers)))
(switch-to-buffer
(let ((Buffer-menu-buffer+size-width 40))
(list-buffers-noselect nil buffers)))
(rename-buffer ert-list-failed-buffers-name t))
(unless ert-failed-tests-temp-buffers
(message "No test buffers from unsuccessful tests")))
(defvar ert-temp-test-buffer-minor-mode-map
(let ((map (make-sparse-keymap)))
;; Add menu bar entries for test buffer and test function
(define-key map [(control ?c) ?? ?t] 'ert-temp-test-buffer-go-test)
(define-key map [(control ?c) ?? ?f] 'ert-temp-test-buffer-go-file)
map))
(defun ert-temp-test-buffer-go-test ()
(interactive)
(ert-find-test-other-window ert-temp-test-buffer-test))
(defun ert-temp-test-buffer-go-file ()
(interactive)
(find-file-other-window ert-temp-test-buffer-file))
(define-minor-mode ert-temp-test-buffer-minor-mode
"Helpers for those buffers ..."
)
(put 'ert-temp-test-buffer-minor-mode 'permanent-local t)
;; Fix-me: doc
(defvar ert-test-files-root nil)
(defun ert-get-test-file-name (file-name)
(unless ert-test-files-root
(error "Please set ert-test-files-root for your tests"))
(unless (file-directory-p ert-test-files-root)
(error "Can't find directory %s" ert-test-files-root))
(expand-file-name file-name ert-test-files-root))
(defmacro* ert-with-temp-buffer-include-file (file-name-form &body body)
"Insert FILE-NAME-FORM in a temporary buffer and eval BODY.
If success then delete the temporary buffer, otherwise keep it.
To access these temporary test buffers use
- `ert-list-temp-test-buffers': list them
- `ert-kill-temp-test-buffers': delete them"
(declare (indent 1) (debug t))
(let ((file-name (make-symbol "file-name-")))
`(let* ((,file-name (ert-get-test-file-name ,file-name-form))
(mode-line-buffer-identification (list (propertize "%b" 'face 'highlight)))
;; Give the buffer a name that allows us to switch to it
;; quickly when debugging a failure.
(temp-buf
(generate-new-buffer
(format "%s" (ert-this-test)))))
(unless (file-readable-p ,file-name)
(if (file-exists-p ,file-name)
(error "Can't read %s" ,file-name)
(error "Can't find %s" ,file-name)))
(message "Testing with file %s" ,file-name)
(setq ert-failed-tests-temp-buffers (cons temp-buf ert-failed-tests-temp-buffers))
(with-current-buffer temp-buf
(ert-temp-test-buffer-minor-mode 1)
(setq ert-temp-test-buffer-file ,file-name)
(setq ert-temp-test-buffer-test (ert-this-test))
;; Avoid global font lock
(let ((font-lock-global-modes nil))
;; Turn off font lock in buffer
(font-lock-mode -1)
(when (> emacs-major-version 22)
(assert (not font-lock-mode) t "%s %s" "in ert-with-temp-buffer-include-file"))
(insert-file-contents ,file-name)
(save-window-excursion
;; Switch to buffer so it will show immediately when
;; debugging a failure.
(switch-to-buffer-other-window (current-buffer))
,@body)
;; Fix-me: move to success list?
(kill-buffer temp-buf))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Simulate commands
(defvar ert-simulate-command-delay nil)
(defvar ert-simulate-command-post-hook nil
"Normal hook to be run at end of `ert-simulate-command'.")
;; Fix-me: use this in all tests where applicable.
(defun ert-simulate-command (command run-idle-timers)
;; Fix-me: run-idle-timers - use seconds
;; Fix-me: add unread-events
"Simulate calling command COMMAND as in Emacs command loop.
If RUN-IDLE-TIMERS is non-nil then run the idle timers after
calling everything involved with the command.
COMMAND should be a list where the car is the command symbol and
the rest are arguments to the command.
NOTE: Since the command is not called by `call-interactively'
test for `called-interactively' in the command will fail.
Return the value of calling the command, ie
(apply (car COMMAND) (cdr COMMAND)).
Run the hook `ert-simulate-command-post-hook' at the very end."
(message "command=%s" command)
(ert-should (listp command))
(ert-should (commandp (car command)))
(ert-should (not unread-command-events))
(let (return-value
(font-lock-mode t))
;; For the order of things here see command_loop_1 in keyboard.c
;;
;; The command loop will reset the command related variables so
;; there is no reason to let bind them. They are set here however
;; to be able to test several commands in a row and how they
;; affect each other.
(setq deactivate-mark nil)
(setq this-original-command (car command))
;; remap through active keymaps
(setq this-command (or (command-remapping this-original-command)
this-original-command))
(run-hooks 'pre-command-hook)
(setq return-value (apply (car command) (cdr command))) ;; <-----
(message "post-command-hook=%s" post-command-hook)
(run-hooks 'post-command-hook)
(when deferred-action-list
(run-hooks 'deferred_action_function))
(setq real-last-command (car command))
(setq last-repeatable-command real-last-command)
(setq last-command this-command)
(when (and deactivate-mark transient-mark-mode) (deactivate-mark))
;;(message "ert-simulate-command.before idle-timers, point=%s" (point))
(when run-idle-timers
;;(dolist (timer (copy-list timer-idle-list))
(dolist (timer (copy-sequence timer-idle-list))
(timer-event-handler timer)
;;(message " after timer=%s, point=%s" timer (point))
)
(redisplay t))
;;(message "ert-simulate-command.after idle-timers, point=%s" (point))
(when ert-simulate-command-delay
;; Show user
;;(message "After M-x %s" command)
(let ((old-buffer-name (buffer-name)))
(rename-buffer (propertize (format "After M-x %s" (car command))
'face 'highlight)
t)
(sit-for ert-simulate-command-delay)
(rename-buffer old-buffer-name)))
(ert-should (not unread-command-events))
(run-hooks 'ert-simulate-command-post-hook)
return-value))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Misc
(defun ert-this-test ()
"Return current `ert-deftest' function."
(elt test 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Self tests
(provide 'ert2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ert2.el ends here
|
