Commit | Line | Data |
---|---|---|
d221e780 CO |
1 | ;;; ert-x-tests.el --- Tests for ert-x.el |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc. |
d221e780 CO |
4 | |
5 | ;; Author: Phil Hagelberg | |
2af3e0b1 | 6 | ;; Christian Ohler <ohler@gnu.org> |
d221e780 CO |
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 | |
19dc7206 | 31 | (require 'cl-lib)) |
d221e780 CO |
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) | |
d5c6faf9 SM |
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"))))) | |
4ddbf128 MA |
114 | (skipped-test (make-ert-test :name 'skipped-test |
115 | :body (lambda () (ert-skip | |
116 | "skip message")))) | |
d5c6faf9 SM |
117 | (ert-debug-on-error nil) |
118 | (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) | |
119 | (messages nil) | |
120 | (mock-message-fn | |
121 | (lambda (format-string &rest args) | |
122 | (push (apply #'format format-string args) messages)))) | |
123 | (cl-flet ((expected-string (with-font-lock-p) | |
124 | (ert-propertized-string | |
4ddbf128 MA |
125 | "Selector: (member <passing-test> <failing-test> " |
126 | "<skipped-test>)\n" | |
127 | "Passed: 1\n" | |
128 | "Failed: 1 (1 unexpected)\n" | |
129 | "Skipped: 1\n" | |
130 | "Total: 3/3\n\n" | |
d5c6faf9 SM |
131 | "Started at:\n" |
132 | "Finished.\n" | |
133 | "Finished at:\n\n" | |
134 | `(category ,(button-category-symbol | |
135 | 'ert--results-progress-bar-button) | |
136 | button (t) | |
137 | face ,(if with-font-lock-p | |
138 | 'ert-test-result-unexpected | |
139 | 'button)) | |
4ddbf128 | 140 | ".Fs" nil "\n\n" |
d5c6faf9 SM |
141 | `(category ,(button-category-symbol |
142 | 'ert--results-expand-collapse-button) | |
143 | button (t) | |
144 | face ,(if with-font-lock-p | |
145 | 'ert-test-result-unexpected | |
146 | 'button)) | |
147 | "F" nil " " | |
148 | `(category ,(button-category-symbol | |
149 | 'ert--test-name-button) | |
150 | button (t) | |
151 | ert-test-name failing-test) | |
152 | "failing-test" | |
153 | nil "\n Info: " '(a b) "foo\n" | |
154 | nil " " '(a b) "bar" | |
155 | nil "\n (ert-test-failed \"failure message\")\n\n\n" | |
156 | ))) | |
157 | (save-window-excursion | |
158 | (unwind-protect | |
159 | (let ((case-fold-search nil)) | |
160 | (ert-run-tests-interactively | |
4ddbf128 | 161 | `(member ,passing-test ,failing-test ,skipped-test) buffer-name |
d5c6faf9 SM |
162 | mock-message-fn) |
163 | (should (equal messages `(,(concat | |
4ddbf128 MA |
164 | "Ran 3 tests, 1 results were " |
165 | "as expected, 1 unexpected, " | |
166 | "1 skipped")))) | |
d5c6faf9 SM |
167 | (with-current-buffer buffer-name |
168 | (font-lock-mode 0) | |
169 | (should (ert-equal-including-properties | |
170 | (ert-filter-string (buffer-string) | |
171 | '("Started at:\\(.*\\)$" 1) | |
172 | '("Finished at:\\(.*\\)$" 1)) | |
173 | (expected-string nil))) | |
174 | ;; `font-lock-mode' only works if interactive, so | |
175 | ;; pretend we are. | |
176 | (let ((noninteractive nil)) | |
177 | (font-lock-mode 1)) | |
178 | (should (ert-equal-including-properties | |
179 | (ert-filter-string (buffer-string) | |
180 | '("Started at:\\(.*\\)$" 1) | |
181 | '("Finished at:\\(.*\\)$" 1)) | |
182 | (expected-string t))))) | |
183 | (when (get-buffer buffer-name) | |
184 | (kill-buffer buffer-name))))))) | |
d221e780 CO |
185 | |
186 | (ert-deftest ert-test-describe-test () | |
187 | "Tests `ert-describe-test'." | |
188 | (save-window-excursion | |
189 | (ert-with-buffer-renamed ("*Help*") | |
190 | (if (< emacs-major-version 24) | |
191 | (should (equal (should-error (ert-describe-test 'ert-describe-test)) | |
192 | '(error "Requires Emacs 24"))) | |
193 | (ert-describe-test 'ert-test-describe-test) | |
194 | (with-current-buffer "*Help*" | |
195 | (let ((case-fold-search nil)) | |
196 | (should (string-match (concat | |
197 | "\\`ert-test-describe-test is a test" | |
198 | " defined in `ert-x-tests.elc?'\\.\n\n" | |
199 | "Tests `ert-describe-test'\\.\n\\'") | |
200 | (buffer-string))))))))) | |
201 | ||
202 | (ert-deftest ert-test-message-log-truncation () | |
203 | :tags '(:causes-redisplay) | |
204 | (let ((test (make-ert-test | |
205 | :body (lambda () | |
206 | ;; Emacs would combine messages if we | |
207 | ;; generate the same message multiple | |
208 | ;; times. | |
209 | (message "a") | |
210 | (message "b") | |
211 | (message "c") | |
212 | (message "d"))))) | |
213 | (let (result) | |
214 | (ert-with-buffer-renamed ("*Messages*") | |
215 | (let ((message-log-max 2)) | |
216 | (setq result (ert-run-test test))) | |
217 | (should (equal (with-current-buffer "*Messages*" | |
218 | (buffer-string)) | |
219 | "c\nd\n"))) | |
220 | (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n"))))) | |
221 | ||
222 | (ert-deftest ert-test-builtin-message-log-flushing () | |
223 | "This test attempts to demonstrate that there is no way to | |
224 | force immediate truncation of the *Messages* buffer from Lisp | |
225 | \(and hence justifies the existence of | |
226 | `ert--force-message-log-buffer-truncation'\): The only way that | |
227 | came to my mind was \(message \"\"\), which doesn't have the | |
228 | desired effect." | |
229 | :tags '(:causes-redisplay) | |
230 | (ert-with-buffer-renamed ("*Messages*") | |
231 | (with-current-buffer "*Messages*" | |
232 | (should (equal (buffer-string) "")) | |
233 | ;; We used to get sporadic failures in this test that involved | |
234 | ;; a spurious newline at the beginning of the buffer, before | |
235 | ;; the first message. Below, we print a message and erase the | |
236 | ;; buffer since this seems to eliminate the sporadic failures. | |
237 | (message "foo") | |
238 | (erase-buffer) | |
239 | (should (equal (buffer-string) "")) | |
240 | (let ((message-log-max 2)) | |
241 | (let ((message-log-max t)) | |
19dc7206 SM |
242 | (cl-loop for i below 4 do |
243 | (message "%s" i)) | |
d221e780 CO |
244 | (should (equal (buffer-string) "0\n1\n2\n3\n"))) |
245 | (should (equal (buffer-string) "0\n1\n2\n3\n")) | |
246 | (message "") | |
247 | (should (equal (buffer-string) "0\n1\n2\n3\n")) | |
248 | (message "Test message") | |
249 | (should (equal (buffer-string) "3\nTest message\n")))))) | |
250 | ||
251 | (ert-deftest ert-test-force-message-log-buffer-truncation () | |
252 | :tags '(:causes-redisplay) | |
19dc7206 SM |
253 | (cl-labels ((body () |
254 | (cl-loop for i below 3 do | |
255 | (message "%s" i))) | |
256 | ;; Uses the implicit messages buffer truncation implemented | |
257 | ;; in Emacs' C core. | |
258 | (c (x) | |
259 | (ert-with-buffer-renamed ("*Messages*") | |
260 | (let ((message-log-max x)) | |
261 | (body)) | |
262 | (with-current-buffer "*Messages*" | |
263 | (buffer-string)))) | |
264 | ;; Uses our lisp reimplementation. | |
265 | (lisp (x) | |
266 | (ert-with-buffer-renamed ("*Messages*") | |
267 | (let ((message-log-max t)) | |
268 | (body)) | |
269 | (let ((message-log-max x)) | |
270 | (ert--force-message-log-buffer-truncation)) | |
271 | (with-current-buffer "*Messages*" | |
272 | (buffer-string))))) | |
273 | (cl-loop for x in '(0 1 2 3 4 t) do | |
274 | (should (equal (c x) (lisp x)))))) | |
d221e780 CO |
275 | |
276 | ||
277 | (provide 'ert-x-tests) | |
278 | ||
279 | ;;; ert-x-tests.el ends here |