1 ;;; ert-x-tests.el --- Tests for ert-x.el
3 ;; Copyright (C) 2008, 2010-2012 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 (ert-debug-on-error nil
)
115 (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
118 (lambda (format-string &rest args
)
119 (push (apply #'format format-string args
) messages
))))
120 (cl-flet ((expected-string (with-font-lock-p)
121 (ert-propertized-string
122 "Selector: (member <passing-test> <failing-test>)\n"
124 "Failed: 1 (1 unexpected)\n"
129 `(category ,(button-category-symbol
130 'ert--results-progress-bar-button
)
132 face
,(if with-font-lock-p
133 'ert-test-result-unexpected
136 `(category ,(button-category-symbol
137 'ert--results-expand-collapse-button
)
139 face
,(if with-font-lock-p
140 'ert-test-result-unexpected
143 `(category ,(button-category-symbol
144 'ert--test-name-button
)
146 ert-test-name failing-test
)
148 nil
"\n Info: " '(a b
) "foo\n"
150 nil
"\n (ert-test-failed \"failure message\")\n\n\n"
152 (save-window-excursion
154 (let ((case-fold-search nil
))
155 (ert-run-tests-interactively
156 `(member ,passing-test
,failing-test
) buffer-name
158 (should (equal messages
`(,(concat
159 "Ran 2 tests, 1 results were "
160 "as expected, 1 unexpected"))))
161 (with-current-buffer buffer-name
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
170 (let ((noninteractive nil
))
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
)))))))
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)))))))))
196 (ert-deftest ert-test-message-log-truncation
()
197 :tags
'(:causes-redisplay
)
198 (let ((test (make-ert-test
200 ;; Emacs would combine messages if we
201 ;; generate the same message multiple
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*"
214 (should (equal (ert-test-result-messages result
) "a\nb\nc\nd\n")))))
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
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.
233 (should (equal (buffer-string) ""))
234 (let ((message-log-max 2))
235 (let ((message-log-max t
))
236 (cl-loop for i below
4 do
238 (should (equal (buffer-string) "0\n1\n2\n3\n")))
239 (should (equal (buffer-string) "0\n1\n2\n3\n"))
241 (should (equal (buffer-string) "0\n1\n2\n3\n"))
242 (message "Test message")
243 (should (equal (buffer-string) "3\nTest message\n"))))))
245 (ert-deftest ert-test-force-message-log-buffer-truncation
()
246 :tags
'(:causes-redisplay
)
248 (cl-loop for i below
3 do
250 ;; Uses the implicit messages buffer truncation implemented
253 (ert-with-buffer-renamed ("*Messages*")
254 (let ((message-log-max x
))
256 (with-current-buffer "*Messages*"
258 ;; Uses our lisp reimplementation.
260 (ert-with-buffer-renamed ("*Messages*")
261 (let ((message-log-max t
))
263 (let ((message-log-max x
))
264 (ert--force-message-log-buffer-truncation))
265 (with-current-buffer "*Messages*"
267 (cl-loop for x in
'(0 1 2 3 4 t
) do
268 (should (equal (c x
) (lisp x
))))))
271 (provide 'ert-x-tests
)
273 ;;; ert-x-tests.el ends here