1 ;;; ert-x-tests.el --- Tests for ert-x.el
3 ;; Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
5 ;; Author: Phil Hagelberg
6 ;; Christian Ohler <ohler@gnu.org>
8 ;; This file is part of GNU Emacs.
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.
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.
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/'.
25 ;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
26 ;; See ert.el or the texinfo manual for more details.
37 (ert-deftest ert-test-buffer-string-reindented ()
38 (ert-with-test-buffer (:name "well-indented")
39 (insert (concat "(hello (world\n"
42 (should (equal (ert-buffer-string-reindented) (buffer-string))))
43 (ert-with-test-buffer (:name "badly-indented")
44 (insert (concat "(hello\n"
47 (should-not (equal (ert-buffer-string-reindented) (buffer-string)))))
49 (defun ert--hash-table-to-alist (table)
51 (maphash (lambda (key value)
52 (push (cons key value) accu))
56 (ert-deftest ert-test-test-buffers ()
63 (ert-with-test-buffer (:name "foo")
65 "[*]Test buffer (ert-test-test-buffers): foo[*]"
67 (setq buffer-1 (current-buffer))))))
72 (ert-with-test-buffer (:name "bar")
74 "[*]Test buffer (ert-test-test-buffers): bar[*]"
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)
82 (should-not (buffer-live-p buffer-1))
83 (should (buffer-live-p buffer-2))))))
86 (ert-deftest ert-filter-string ()
87 (should (equal (ert-filter-string "foo bar baz" "quux")
89 (should (equal (ert-filter-string "foo bar baz" "bar")
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
99 #("foo bar baz quux" 4 11 (face italic)))))
102 ;;; Tests for ERT itself that require test features from ert-x.el.
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
110 (ert-info ((propertize "foo\nbar"
113 "failure message")))))
114 (skipped-test (make-ert-test :name 'skipped-test
115 :body (lambda () (ert-skip
117 (ert-debug-on-error nil)
118 (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
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
125 "Selector: (member <passing-test> <failing-test> "
128 "Failed: 1 (1 unexpected)\n"
134 `(category ,(button-category-symbol
135 'ert--results-progress-bar-button)
137 face ,(if with-font-lock-p
138 'ert-test-result-unexpected
141 `(category ,(button-category-symbol
142 'ert--results-expand-collapse-button)
144 face ,(if with-font-lock-p
145 'ert-test-result-unexpected
148 `(category ,(button-category-symbol
149 'ert--test-name-button)
151 ert-test-name failing-test)
153 nil "\n Info: " '(a b) "foo\n"
155 nil "\n (ert-test-failed \"failure message\")\n\n\n"
157 (save-window-excursion
159 (let ((case-fold-search nil))
160 (ert-run-tests-interactively
161 `(member ,passing-test ,failing-test ,skipped-test) buffer-name
163 (should (equal messages `(,(concat
164 "Ran 3 tests, 1 results were "
165 "as expected, 1 unexpected, "
167 (with-current-buffer buffer-name
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
176 (let ((noninteractive nil))
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)))))))
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)))))))))
202 (ert-deftest ert-test-message-log-truncation ()
203 :tags '(:causes-redisplay)
204 (let ((test (make-ert-test
206 ;; Emacs would combine messages if we
207 ;; generate the same message multiple
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*"
220 (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
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
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.
239 (should (equal (buffer-string) ""))
240 (let ((message-log-max 2))
241 (let ((message-log-max t))
242 (cl-loop for i below 4 do
244 (should (equal (buffer-string) "0\n1\n2\n3\n")))
245 (should (equal (buffer-string) "0\n1\n2\n3\n"))
247 (should (equal (buffer-string) "0\n1\n2\n3\n"))
248 (message "Test message")
249 (should (equal (buffer-string) "3\nTest message\n"))))))
251 (ert-deftest ert-test-force-message-log-buffer-truncation ()
252 :tags '(:causes-redisplay)
254 (cl-loop for i below 3 do
256 ;; Uses the implicit messages buffer truncation implemented
259 (ert-with-buffer-renamed ("*Messages*")
260 (let ((message-log-max x))
262 (with-current-buffer "*Messages*"
264 ;; Uses our lisp reimplementation.
266 (ert-with-buffer-renamed ("*Messages*")
267 (let ((message-log-max t))
269 (let ((message-log-max x))
270 (ert--force-message-log-buffer-truncation))
271 (with-current-buffer "*Messages*"
273 (cl-loop for x in '(0 1 2 3 4 t) do
274 (should (equal (c x) (lisp x))))))
277 (provide 'ert-x-tests)
279 ;;; ert-x-tests.el ends here