Commit | Line | Data |
---|---|---|
d221e780 CO |
1 | ;;; ert-x-tests.el --- Tests for ert-x.el |
2 | ||
3 | ;; Copyright (C) 2008, 2010, 2011 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Phil Hagelberg | |
6 | ;; Author: Christian Ohler <ohler@gnu.org> | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; This program is free software: you can redistribute it and/or | |
11 | ;; modify it under the terms of the GNU General Public License as | |
12 | ;; published by the Free Software Foundation, either version 3 of the | |
13 | ;; License, or (at your option) any later version. | |
14 | ;; | |
15 | ;; This program is distributed in the hope that it will be useful, but | |
16 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
18 | ;; General Public License for more details. | |
19 | ;; | |
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with this program. If not, see `http://www.gnu.org/licenses/'. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; This file is part of ERT, the Emacs Lisp Regression Testing tool. | |
26 | ;; See ert.el or the texinfo manual for more details. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (eval-when-compile | |
31 | (require 'cl)) | |
32 | (require 'ert) | |
33 | (require 'ert-x) | |
34 | ||
35 | ;;; Utilities | |
36 | ||
37 | (ert-deftest ert-test-buffer-string-reindented () | |
38 | (ert-with-test-buffer (:name "well-indented") | |
39 | (insert (concat "(hello (world\n" | |
40 | " 'elisp)\n")) | |
41 | (emacs-lisp-mode) | |
42 | (should (equal (ert-buffer-string-reindented) (buffer-string)))) | |
43 | (ert-with-test-buffer (:name "badly-indented") | |
44 | (insert (concat "(hello\n" | |
45 | " world)")) | |
46 | (emacs-lisp-mode) | |
47 | (should-not (equal (ert-buffer-string-reindented) (buffer-string))))) | |
48 | ||
49 | (defun ert--hash-table-to-alist (table) | |
50 | (let ((accu nil)) | |
51 | (maphash (lambda (key value) | |
52 | (push (cons key value) accu)) | |
53 | table) | |
54 | (nreverse accu))) | |
55 | ||
56 | (ert-deftest ert-test-test-buffers () | |
57 | (let (buffer-1 | |
58 | buffer-2) | |
59 | (let ((test-1 | |
60 | (make-ert-test | |
61 | :name 'test-1 | |
62 | :body (lambda () | |
63 | (ert-with-test-buffer (:name "foo") | |
64 | (should (string-match | |
65 | "[*]Test buffer (ert-test-test-buffers): foo[*]" | |
66 | (buffer-name))) | |
67 | (setq buffer-1 (current-buffer)))))) | |
68 | (test-2 | |
69 | (make-ert-test | |
70 | :name 'test-2 | |
71 | :body (lambda () | |
72 | (ert-with-test-buffer (:name "bar") | |
73 | (should (string-match | |
74 | "[*]Test buffer (ert-test-test-buffers): bar[*]" | |
75 | (buffer-name))) | |
76 | (setq buffer-2 (current-buffer)) | |
77 | (ert-fail "fail for test")))))) | |
78 | (let ((ert--test-buffers (make-hash-table :weakness t))) | |
79 | (ert-run-tests `(member ,test-1 ,test-2) #'ignore) | |
80 | (should (equal (ert--hash-table-to-alist ert--test-buffers) | |
81 | `((,buffer-2 . t)))) | |
82 | (should-not (buffer-live-p buffer-1)) | |
83 | (should (buffer-live-p buffer-2)))))) | |
84 | ||
85 | ||
86 | (ert-deftest ert-filter-string () | |
87 | (should (equal (ert-filter-string "foo bar baz" "quux") | |
88 | "foo bar baz")) | |
89 | (should (equal (ert-filter-string "foo bar baz" "bar") | |
90 | "foo baz"))) | |
91 | ||
92 | (ert-deftest ert-propertized-string () | |
93 | (should (ert-equal-including-properties | |
94 | (ert-propertized-string "a" '(a b) "b" '(c t) "cd") | |
95 | #("abcd" 1 2 (a b) 2 4 (c t)))) | |
96 | (should (ert-equal-including-properties | |
97 | (ert-propertized-string "foo " '(face italic) "bar" " baz" nil | |
98 | " quux") | |
99 | #("foo bar baz quux" 4 11 (face italic))))) | |
100 | ||
101 | ||
102 | ;;; Tests for ERT itself that require test features from ert-x.el. | |
103 | ||
104 | (ert-deftest ert-test-run-tests-interactively-2 () | |
105 | :tags '(:causes-redisplay) | |
106 | (let ((passing-test (make-ert-test :name 'passing-test | |
107 | :body (lambda () (ert-pass)))) | |
108 | (failing-test (make-ert-test :name 'failing-test | |
109 | :body (lambda () | |
110 | (ert-info ((propertize "foo\nbar" | |
111 | 'a 'b)) | |
112 | (ert-fail | |
113 | "failure message")))))) | |
114 | (let ((ert-debug-on-error nil)) | |
115 | (let* ((buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) | |
116 | (messages nil) | |
117 | (mock-message-fn | |
118 | (lambda (format-string &rest args) | |
119 | (push (apply #'format format-string args) messages)))) | |
120 | (flet ((expected-string (with-font-lock-p) | |
121 | (ert-propertized-string | |
122 | "Selector: (member <passing-test> <failing-test>)\n" | |
123 | "Passed: 1\n" | |
124 | "Failed: 1 (1 unexpected)\n" | |
125 | "Total: 2/2\n\n" | |
126 | "Started at:\n" | |
127 | "Finished.\n" | |
128 | "Finished at:\n\n" | |
129 | `(category ,(button-category-symbol | |
130 | 'ert--results-progress-bar-button) | |
131 | button (t) | |
132 | face ,(if with-font-lock-p | |
133 | 'ert-test-result-unexpected | |
134 | 'button)) | |
135 | ".F" nil "\n\n" | |
136 | `(category ,(button-category-symbol | |
137 | 'ert--results-expand-collapse-button) | |
138 | button (t) | |
139 | face ,(if with-font-lock-p | |
140 | 'ert-test-result-unexpected | |
141 | 'button)) | |
142 | "F" nil " " | |
143 | `(category ,(button-category-symbol | |
144 | 'ert--test-name-button) | |
145 | button (t) | |
146 | ert-test-name failing-test) | |
147 | "failing-test" | |
148 | nil "\n Info: " '(a b) "foo\n" | |
149 | nil " " '(a b) "bar" | |
150 | nil "\n (ert-test-failed \"failure message\")\n\n\n" | |
151 | ))) | |
152 | (save-window-excursion | |
153 | (unwind-protect | |
154 | (let ((case-fold-search nil)) | |
155 | (ert-run-tests-interactively | |
156 | `(member ,passing-test ,failing-test) buffer-name | |
157 | mock-message-fn) | |
158 | (should (equal messages `(,(concat | |
159 | "Ran 2 tests, 1 results were " | |
160 | "as expected, 1 unexpected")))) | |
161 | (with-current-buffer buffer-name | |
162 | (font-lock-mode 0) | |
163 | (should (ert-equal-including-properties | |
164 | (ert-filter-string (buffer-string) | |
165 | '("Started at:\\(.*\\)$" 1) | |
166 | '("Finished at:\\(.*\\)$" 1)) | |
167 | (expected-string nil))) | |
168 | ;; `font-lock-mode' only works if interactive, so | |
169 | ;; pretend we are. | |
170 | (let ((noninteractive nil)) | |
171 | (font-lock-mode 1)) | |
172 | (should (ert-equal-including-properties | |
173 | (ert-filter-string (buffer-string) | |
174 | '("Started at:\\(.*\\)$" 1) | |
175 | '("Finished at:\\(.*\\)$" 1)) | |
176 | (expected-string t))))) | |
177 | (when (get-buffer buffer-name) | |
178 | (kill-buffer buffer-name))))))))) | |
179 | ||
180 | (ert-deftest ert-test-describe-test () | |
181 | "Tests `ert-describe-test'." | |
182 | (save-window-excursion | |
183 | (ert-with-buffer-renamed ("*Help*") | |
184 | (if (< emacs-major-version 24) | |
185 | (should (equal (should-error (ert-describe-test 'ert-describe-test)) | |
186 | '(error "Requires Emacs 24"))) | |
187 | (ert-describe-test 'ert-test-describe-test) | |
188 | (with-current-buffer "*Help*" | |
189 | (let ((case-fold-search nil)) | |
190 | (should (string-match (concat | |
191 | "\\`ert-test-describe-test is a test" | |
192 | " defined in `ert-x-tests.elc?'\\.\n\n" | |
193 | "Tests `ert-describe-test'\\.\n\\'") | |
194 | (buffer-string))))))))) | |
195 | ||
196 | (ert-deftest ert-test-message-log-truncation () | |
197 | :tags '(:causes-redisplay) | |
198 | (let ((test (make-ert-test | |
199 | :body (lambda () | |
200 | ;; Emacs would combine messages if we | |
201 | ;; generate the same message multiple | |
202 | ;; times. | |
203 | (message "a") | |
204 | (message "b") | |
205 | (message "c") | |
206 | (message "d"))))) | |
207 | (let (result) | |
208 | (ert-with-buffer-renamed ("*Messages*") | |
209 | (let ((message-log-max 2)) | |
210 | (setq result (ert-run-test test))) | |
211 | (should (equal (with-current-buffer "*Messages*" | |
212 | (buffer-string)) | |
213 | "c\nd\n"))) | |
214 | (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) | |
215 | ||
216 | (ert-deftest ert-test-builtin-message-log-flushing () | |
217 | "This test attempts to demonstrate that there is no way to | |
218 | force immediate truncation of the *Messages* buffer from Lisp | |
219 | \(and hence justifies the existence of | |
220 | `ert--force-message-log-buffer-truncation'\): The only way that | |
221 | came to my mind was \(message \"\"\), which doesn't have the | |
222 | desired effect." | |
223 | :tags '(:causes-redisplay) | |
224 | (ert-with-buffer-renamed ("*Messages*") | |
225 | (with-current-buffer "*Messages*" | |
226 | (should (equal (buffer-string) "")) | |
227 | ;; We used to get sporadic failures in this test that involved | |
228 | ;; a spurious newline at the beginning of the buffer, before | |
229 | ;; the first message. Below, we print a message and erase the | |
230 | ;; buffer since this seems to eliminate the sporadic failures. | |
231 | (message "foo") | |
232 | (erase-buffer) | |
233 | (should (equal (buffer-string) "")) | |
234 | (let ((message-log-max 2)) | |
235 | (let ((message-log-max t)) | |
236 | (loop for i below 4 do | |
237 | (message "%s" i)) | |
238 | (should (equal (buffer-string) "0\n1\n2\n3\n"))) | |
239 | (should (equal (buffer-string) "0\n1\n2\n3\n")) | |
240 | (message "") | |
241 | (should (equal (buffer-string) "0\n1\n2\n3\n")) | |
242 | (message "Test message") | |
243 | (should (equal (buffer-string) "3\nTest message\n")))))) | |
244 | ||
245 | (ert-deftest ert-test-force-message-log-buffer-truncation () | |
246 | :tags '(:causes-redisplay) | |
247 | (labels ((body () | |
248 | (loop for i below 3 do | |
249 | (message "%s" i))) | |
250 | ;; Uses the implicit messages buffer truncation implemented | |
251 | ;; in Emacs' C core. | |
252 | (c (x) | |
253 | (ert-with-buffer-renamed ("*Messages*") | |
254 | (let ((message-log-max x)) | |
255 | (body)) | |
256 | (with-current-buffer "*Messages*" | |
257 | (buffer-string)))) | |
258 | ;; Uses our lisp reimplementation. | |
259 | (lisp (x) | |
260 | (ert-with-buffer-renamed ("*Messages*") | |
261 | (let ((message-log-max t)) | |
262 | (body)) | |
263 | (let ((message-log-max x)) | |
264 | (ert--force-message-log-buffer-truncation)) | |
265 | (with-current-buffer "*Messages*" | |
266 | (buffer-string))))) | |
267 | (loop for x in '(0 1 2 3 4 t) do | |
268 | (should (equal (c x) (lisp x)))))) | |
269 | ||
270 | ||
271 | (provide 'ert-x-tests) | |
272 | ||
273 | ;;; ert-x-tests.el ends here |