1 ;;; ert2.el --- Additions to ert.el
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2008-09-02T11:46:03+0200 Tue
6 ;; Last-Updated: 2009-01-06 Tue
11 ;; Features that might be required by this library:
13 ;; Cannot open load file: ert2.
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; This program is free software; you can redistribute it and/or
29 ;; modify it under the terms of the GNU General Public License as
30 ;; published by the Free Software Foundation; either version 2, or
31 ;; (at your option) any later version.
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
36 ;; General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with this program; see the file COPYING. If not, write to
40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
41 ;; Floor, Boston, MA 02110-1301, USA.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 (eval-when-compile (require 'cl))
49 (let* ((this-file (or load-file-name
50 (when (boundp 'bytecomp-filename) bytecomp-filename)
52 (this-dir (file-name-directory this-file))
53 (load-path (cons this-dir load-path)))
57 (file-name-directory (if load-file-name load-file-name buffer-file-name)))
58 ;;(load-path (copy-list load-path)))
59 (load-path (copy-sequence load-path)))
60 (add-to-list 'load-path this-dir)
64 (defvar ert-temp-test-buffer-test nil)
65 (make-variable-buffer-local 'ert-temp-test-buffer-test)
66 (put 'ert-temp-test-buffer-test 'permanent-local t)
68 (defvar ert-temp-test-buffer-file nil)
69 (make-variable-buffer-local 'ert-temp-test-buffer-file)
70 (put 'ert-temp-test-buffer-file 'permanent-local t)
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 (defvar ert-failed-tests-temp-buffers nil)
77 (defvar ert-list-failed-buffers-name "*Ert Failed Test Buffers*")
79 (defun ert-kill-temp-test-buffers ()
80 "Delete test buffers from unsuccessful tests."
82 (let ((failed (get-buffer ert-list-failed-buffers-name)))
83 (when failed (kill-buffer failed)))
84 (dolist (buf ert-failed-tests-temp-buffers)
85 (when (buffer-live-p buf)
87 (setq ert-failed-tests-temp-buffers nil))
89 (defun ert-list-temp-test-buffers ()
90 "List test buffers from unsuccessful tests."
92 (setq ert-failed-tests-temp-buffers
95 (when (buffer-live-p buf)
97 ert-failed-tests-temp-buffers)))
98 (let ((ert-buffer (get-buffer "*ert*"))
99 (buffers ert-failed-tests-temp-buffers))
100 (when ert-buffer (setq buffers (cons ert-buffer buffers)))
102 (let ((Buffer-menu-buffer+size-width 40))
103 (list-buffers-noselect nil buffers)))
104 (rename-buffer ert-list-failed-buffers-name t))
105 (unless ert-failed-tests-temp-buffers
106 (message "No test buffers from unsuccessful tests")))
108 (defvar ert-temp-test-buffer-minor-mode-map
109 (let ((map (make-sparse-keymap)))
110 ;; Add menu bar entries for test buffer and test function
111 (define-key map [(control ?c) ?? ?t] 'ert-temp-test-buffer-go-test)
112 (define-key map [(control ?c) ?? ?f] 'ert-temp-test-buffer-go-file)
114 (defun ert-temp-test-buffer-go-test ()
116 (ert-find-test-other-window ert-temp-test-buffer-test))
117 (defun ert-temp-test-buffer-go-file ()
119 (find-file-other-window ert-temp-test-buffer-file))
121 (define-minor-mode ert-temp-test-buffer-minor-mode
122 "Helpers for those buffers ..."
124 (put 'ert-temp-test-buffer-minor-mode 'permanent-local t)
127 (defvar ert-test-files-root nil)
128 (defun ert-get-test-file-name (file-name)
129 (unless ert-test-files-root
130 (error "Please set ert-test-files-root for your tests"))
131 (unless (file-directory-p ert-test-files-root)
132 (error "Can't find directory %s" ert-test-files-root))
133 (expand-file-name file-name ert-test-files-root))
135 (defmacro* ert-with-temp-buffer-include-file (file-name-form &body body)
136 "Insert FILE-NAME-FORM in a temporary buffer and eval BODY.
137 If success then delete the temporary buffer, otherwise keep it.
139 To access these temporary test buffers use
140 - `ert-list-temp-test-buffers': list them
141 - `ert-kill-temp-test-buffers': delete them"
142 (declare (indent 1) (debug t))
143 (let ((file-name (make-symbol "file-name-")))
144 `(let* ((,file-name (ert-get-test-file-name ,file-name-form))
145 (mode-line-buffer-identification (list (propertize "%b" 'face 'highlight)))
146 ;; Give the buffer a name that allows us to switch to it
147 ;; quickly when debugging a failure.
150 (format "%s" (ert-this-test)))))
151 (unless (file-readable-p ,file-name)
152 (if (file-exists-p ,file-name)
153 (error "Can't read %s" ,file-name)
154 (error "Can't find %s" ,file-name)))
155 (message "Testing with file %s" ,file-name)
156 (setq ert-failed-tests-temp-buffers (cons temp-buf ert-failed-tests-temp-buffers))
157 (with-current-buffer temp-buf
158 (ert-temp-test-buffer-minor-mode 1)
159 (setq ert-temp-test-buffer-file ,file-name)
160 (setq ert-temp-test-buffer-test (ert-this-test))
161 ;; Avoid global font lock
162 (let ((font-lock-global-modes nil))
163 ;; Turn off font lock in buffer
165 (when (> emacs-major-version 22)
166 (assert (not font-lock-mode) t "%s %s" "in ert-with-temp-buffer-include-file"))
167 (insert-file-contents ,file-name)
168 (save-window-excursion
169 ;; Switch to buffer so it will show immediately when
170 ;; debugging a failure.
171 (switch-to-buffer-other-window (current-buffer))
173 ;; Fix-me: move to success list?
174 (kill-buffer temp-buf))))))
177 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
178 ;;; Simulate commands
180 (defvar ert-simulate-command-delay nil)
182 (defvar ert-simulate-command-post-hook nil
183 "Normal hook to be run at end of `ert-simulate-command'.")
185 ;; Fix-me: use this in all tests where applicable.
186 (defun ert-simulate-command (command run-idle-timers)
187 ;; Fix-me: run-idle-timers - use seconds
188 ;; Fix-me: add unread-events
189 "Simulate calling command COMMAND as in Emacs command loop.
190 If RUN-IDLE-TIMERS is non-nil then run the idle timers after
191 calling everything involved with the command.
193 COMMAND should be a list where the car is the command symbol and
194 the rest are arguments to the command.
196 NOTE: Since the command is not called by `call-interactively'
197 test for `called-interactively' in the command will fail.
199 Return the value of calling the command, ie
201 (apply (car COMMAND) (cdr COMMAND)).
203 Run the hook `ert-simulate-command-post-hook' at the very end."
205 (message "command=%s" command)
206 (ert-should (listp command))
207 (ert-should (commandp (car command)))
208 (ert-should (not unread-command-events))
211 ;; For the order of things here see command_loop_1 in keyboard.c
213 ;; The command loop will reset the command related variables so
214 ;; there is no reason to let bind them. They are set here however
215 ;; to be able to test several commands in a row and how they
216 ;; affect each other.
217 (setq deactivate-mark nil)
218 (setq this-original-command (car command))
219 ;; remap through active keymaps
220 (setq this-command (or (command-remapping this-original-command)
221 this-original-command))
222 (run-hooks 'pre-command-hook)
223 (setq return-value (apply (car command) (cdr command))) ;; <-----
224 (message "post-command-hook=%s" post-command-hook)
225 (run-hooks 'post-command-hook)
226 (when deferred-action-list
227 (run-hooks 'deferred_action_function))
228 (setq real-last-command (car command))
229 (setq last-repeatable-command real-last-command)
230 (setq last-command this-command)
231 (when (and deactivate-mark transient-mark-mode) (deactivate-mark))
232 ;;(message "ert-simulate-command.before idle-timers, point=%s" (point))
233 (when run-idle-timers
234 ;;(dolist (timer (copy-list timer-idle-list))
235 (dolist (timer (copy-sequence timer-idle-list))
236 (timer-event-handler timer)
237 ;;(message " after timer=%s, point=%s" timer (point))
240 ;;(message "ert-simulate-command.after idle-timers, point=%s" (point))
241 (when ert-simulate-command-delay
243 ;;(message "After M-x %s" command)
244 (let ((old-buffer-name (buffer-name)))
245 (rename-buffer (propertize (format "After M-x %s" (car command))
248 (sit-for ert-simulate-command-delay)
249 (rename-buffer old-buffer-name)))
250 (ert-should (not unread-command-events))
251 (run-hooks 'ert-simulate-command-post-hook)
255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
258 (defun ert-this-test ()
259 "Return current `ert-deftest' function."
263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
267 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
268 ;;; ert2.el ends here