; Fix a typo in the EPA docs
[emacs.git] / test / automated / ert-tests.el
Commit [+]AuthorDateLineData
19dc7206 Stefan Monnier2012-11-19 12:24:12 -05001;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
d221e780 Christian Ohler2011-01-13 03:08:24 +11002
7e09ef09 Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 2007-2008, 2010-2015 Free Software Foundation, Inc.
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +11004
5;; Author: Christian Ohler <ohler@gnu.org>
6
7;; This file is part of GNU Emacs.
8
9;; This program is free software: you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation, either version 3 of the
12;; License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17;; General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program. If not, see `http://www.gnu.org/licenses/'.
21
22;;; Commentary:
23
24;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
25;; See ert.el or the texinfo manual for more details.
26
27;;; Code:
28
a19b3c2d Glenn Morris2013-07-11 09:13:38 -070029(require 'cl-lib)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110030(require 'ert)
31
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110032;;; Self-test that doesn't rely on ERT, for bootstrapping.
33
34;; This is used to test that bodies actually run.
35(defvar ert--test-body-was-run)
36(ert-deftest ert-test-body-runs ()
37 (setq ert--test-body-was-run t))
38
39(defun ert-self-test ()
40 "Run ERT's self-tests and make sure they actually ran."
41 (let ((window-configuration (current-window-configuration)))
42 (let ((ert--test-body-was-run nil))
43 ;; The buffer name chosen here should not compete with the default
44 ;; results buffer name for completion in `switch-to-buffer'.
45 (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -050046 (cl-assert ert--test-body-was-run)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110047 (if (zerop (ert-stats-completed-unexpected stats))
48 ;; Hide results window only when everything went well.
49 (set-window-configuration window-configuration)
50 (error "ERT self-test failed"))))))
51
52(defun ert-self-test-and-exit ()
53 "Run ERT's self-tests and exit Emacs.
54
55The exit code will be zero if the tests passed, nonzero if they
56failed or if there was a problem."
57 (unwind-protect
58 (progn
59 (ert-self-test)
60 (kill-emacs 0))
61 (unwind-protect
62 (progn
63 (message "Error running tests")
64 (backtrace))
65 (kill-emacs 1))))
66
67
68;;; Further tests are defined using ERT.
69
70(ert-deftest ert-test-nested-test-body-runs ()
71 "Test that nested test bodies run."
19dc7206 Stefan Monnier2012-11-19 12:24:12 -050072 (let ((was-run nil))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110073 (let ((test (make-ert-test :body (lambda ()
74 (setq was-run t)))))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -050075 (cl-assert (not was-run))
d221e780 Christian Ohler2011-01-13 03:08:24 +110076 (ert-run-test test)
19dc7206 Stefan Monnier2012-11-19 12:24:12 -050077 (cl-assert was-run))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110078
79
80;;; Test that pass/fail works.
81(ert-deftest ert-test-pass ()
82 (let ((test (make-ert-test :body (lambda ()))))
83 (let ((result (ert-run-test test)))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -050084 (cl-assert (ert-test-passed-p result)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110085
86(ert-deftest ert-test-fail ()
87 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
88 (let ((result (let ((ert-debug-on-error nil))
89 (ert-run-test test))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -050090 (cl-assert (ert-test-failed-p result) t)
91 (cl-assert (equal (ert-test-result-with-condition-condition result)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +110092 '(ert-test-failed "failure message"))
93 t))))
94
95(ert-deftest ert-test-fail-debug-with-condition-case ()
96 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
97 (condition-case condition
98 (progn
99 (let ((ert-debug-on-error t))
100 (ert-run-test test))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500101 (cl-assert nil))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100102 ((error)
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500103 (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100104
105(ert-deftest ert-test-fail-debug-with-debugger-1 ()
106 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500107 (let ((debugger (lambda (&rest _args)
108 (cl-assert nil))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100109 (let ((ert-debug-on-error nil))
110 (ert-run-test test)))))
111
112(ert-deftest ert-test-fail-debug-with-debugger-2 ()
113 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500114 (cl-block nil
115 (let ((debugger (lambda (&rest _args)
116 (cl-return-from nil nil))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100117 (let ((ert-debug-on-error t))
118 (ert-run-test test))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500119 (cl-assert nil)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100120
121(ert-deftest ert-test-fail-debug-nested-with-debugger ()
122 (let ((test (make-ert-test :body (lambda ()
123 (let ((ert-debug-on-error t))
124 (ert-fail "failure message"))))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500125 (let ((debugger (lambda (&rest _args)
126 (cl-assert nil nil "Assertion a"))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100127 (let ((ert-debug-on-error nil))
128 (ert-run-test test))))
129 (let ((test (make-ert-test :body (lambda ()
130 (let ((ert-debug-on-error nil))
131 (ert-fail "failure message"))))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500132 (cl-block nil
133 (let ((debugger (lambda (&rest _args)
134 (cl-return-from nil nil))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100135 (let ((ert-debug-on-error t))
136 (ert-run-test test))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500137 (cl-assert nil nil "Assertion b")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100138
139(ert-deftest ert-test-error ()
140 (let ((test (make-ert-test :body (lambda () (error "Error message")))))
141 (let ((result (let ((ert-debug-on-error nil))
142 (ert-run-test test))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500143 (cl-assert (ert-test-failed-p result) t)
144 (cl-assert (equal (ert-test-result-with-condition-condition result)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100145 '(error "Error message"))
146 t))))
147
148(ert-deftest ert-test-error-debug ()
149 (let ((test (make-ert-test :body (lambda () (error "Error message")))))
150 (condition-case condition
151 (progn
152 (let ((ert-debug-on-error t))
153 (ert-run-test test))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500154 (cl-assert nil))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100155 ((error)
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500156 (cl-assert (equal condition '(error "Error message")) t)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100157
158
159;;; Test that `should' works.
160(ert-deftest ert-test-should ()
161 (let ((test (make-ert-test :body (lambda () (should nil)))))
162 (let ((result (let ((ert-debug-on-error nil))
163 (ert-run-test test))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500164 (cl-assert (ert-test-failed-p result) t)
165 (cl-assert (equal (ert-test-result-with-condition-condition result)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100166 '(ert-test-failed ((should nil) :form nil :value nil)))
167 t)))
168 (let ((test (make-ert-test :body (lambda () (should t)))))
169 (let ((result (ert-run-test test)))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500170 (cl-assert (ert-test-passed-p result) t))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100171
172(ert-deftest ert-test-should-value ()
173 (should (eql (should 'foo) 'foo))
174 (should (eql (should 'bar) 'bar)))
175
176(ert-deftest ert-test-should-not ()
177 (let ((test (make-ert-test :body (lambda () (should-not t)))))
178 (let ((result (let ((ert-debug-on-error nil))
179 (ert-run-test test))))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500180 (cl-assert (ert-test-failed-p result) t)
181 (cl-assert (equal (ert-test-result-with-condition-condition result)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100182 '(ert-test-failed ((should-not t) :form t :value t)))
183 t)))
184 (let ((test (make-ert-test :body (lambda () (should-not nil)))))
185 (let ((result (ert-run-test test)))
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500186 (cl-assert (ert-test-passed-p result)))))
187
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100188
189(ert-deftest ert-test-should-with-macrolet ()
190 (let ((test (make-ert-test :body (lambda ()
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500191 (cl-macrolet ((foo () `(progn t nil)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100192 (should (foo)))))))
193 (let ((result (let ((ert-debug-on-error nil))
194 (ert-run-test test))))
195 (should (ert-test-failed-p result))
196 (should (equal
197 (ert-test-result-with-condition-condition result)
198 '(ert-test-failed ((should (foo))
199 :form (progn t nil)
200 :value nil)))))))
201
202(ert-deftest ert-test-should-error ()
203 ;; No error.
204 (let ((test (make-ert-test :body (lambda () (should-error (progn))))))
205 (let ((result (let ((ert-debug-on-error nil))
206 (ert-run-test test))))
207 (should (ert-test-failed-p result))
208 (should (equal (ert-test-result-with-condition-condition result)
209 '(ert-test-failed
210 ((should-error (progn))
211 :form (progn)
212 :value nil
213 :fail-reason "did not signal an error"))))))
214 ;; A simple error.
215 (should (equal (should-error (error "Foo"))
216 '(error "Foo")))
217 ;; Error of unexpected type.
218 (let ((test (make-ert-test :body (lambda ()
219 (should-error (error "Foo")
220 :type 'singularity-error)))))
221 (let ((result (ert-run-test test)))
222 (should (ert-test-failed-p result))
223 (should (equal
224 (ert-test-result-with-condition-condition result)
225 '(ert-test-failed
226 ((should-error (error "Foo") :type 'singularity-error)
227 :form (error "Foo")
228 :condition (error "Foo")
229 :fail-reason
8350f087 Paul Eggert2011-11-14 12:23:26 -0800230 "the error signaled did not have the expected type"))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100231 ;; Error of the expected type.
232 (let* ((error nil)
233 (test (make-ert-test
234 :body (lambda ()
235 (setq error
236 (should-error (signal 'singularity-error nil)
237 :type 'singularity-error))))))
238 (let ((result (ert-run-test test)))
239 (should (ert-test-passed-p result))
240 (should (equal error '(singularity-error))))))
241
242(ert-deftest ert-test-should-error-subtypes ()
243 (should-error (signal 'singularity-error nil)
244 :type 'singularity-error
245 :exclude-subtypes t)
246 (let ((test (make-ert-test
247 :body (lambda ()
248 (should-error (signal 'arith-error nil)
249 :type 'singularity-error)))))
250 (let ((result (ert-run-test test)))
251 (should (ert-test-failed-p result))
252 (should (equal
253 (ert-test-result-with-condition-condition result)
254 '(ert-test-failed
255 ((should-error (signal 'arith-error nil)
256 :type 'singularity-error)
257 :form (signal arith-error nil)
258 :condition (arith-error)
259 :fail-reason
8350f087 Paul Eggert2011-11-14 12:23:26 -0800260 "the error signaled did not have the expected type"))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100261 (let ((test (make-ert-test
262 :body (lambda ()
263 (should-error (signal 'arith-error nil)
264 :type 'singularity-error
265 :exclude-subtypes t)))))
266 (let ((result (ert-run-test test)))
267 (should (ert-test-failed-p result))
268 (should (equal
269 (ert-test-result-with-condition-condition result)
270 '(ert-test-failed
271 ((should-error (signal 'arith-error nil)
272 :type 'singularity-error
273 :exclude-subtypes t)
274 :form (signal arith-error nil)
275 :condition (arith-error)
276 :fail-reason
8350f087 Paul Eggert2011-11-14 12:23:26 -0800277 "the error signaled did not have the expected type"))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100278 (let ((test (make-ert-test
279 :body (lambda ()
280 (should-error (signal 'singularity-error nil)
281 :type 'arith-error
282 :exclude-subtypes t)))))
283 (let ((result (ert-run-test test)))
284 (should (ert-test-failed-p result))
285 (should (equal
286 (ert-test-result-with-condition-condition result)
287 '(ert-test-failed
288 ((should-error (signal 'singularity-error nil)
289 :type 'arith-error
290 :exclude-subtypes t)
291 :form (signal singularity-error nil)
292 :condition (singularity-error)
293 :fail-reason
8350f087 Paul Eggert2011-11-14 12:23:26 -0800294 "the error signaled was a subtype of the expected type")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100295 ))
296
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200297(ert-deftest ert-test-skip-unless ()
298 ;; Don't skip.
299 (let ((test (make-ert-test :body (lambda () (skip-unless t)))))
300 (let ((result (ert-run-test test)))
301 (should (ert-test-passed-p result))))
302 ;; Skip.
303 (let ((test (make-ert-test :body (lambda () (skip-unless nil)))))
304 (let ((result (ert-run-test test)))
305 (should (ert-test-skipped-p result))))
306 ;; Skip in case of error.
307 (let ((test (make-ert-test :body (lambda () (skip-unless (error "Foo"))))))
308 (let ((result (ert-run-test test)))
309 (should (ert-test-skipped-p result)))))
310
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100311(defmacro ert--test-my-list (&rest args)
312 "Don't use this. Instead, call `list' with ARGS, it does the same thing.
313
314This macro is used to test if macroexpansion in `should' works."
315 `(list ,@args))
316
317(ert-deftest ert-test-should-failure-debugging ()
318 "Test that `should' errors contain the information we expect them to."
19dc7206
SM
Stefan Monnier2012-11-19 12:24:12 -0500319 (cl-loop
320 for (body expected-condition) in
321 `((,(lambda () (let ((x nil)) (should x)))
322 (ert-test-failed ((should x) :form x :value nil)))
323 (,(lambda () (let ((x t)) (should-not x)))
324 (ert-test-failed ((should-not x) :form x :value t)))
325 (,(lambda () (let ((x t)) (should (not x))))
326 (ert-test-failed ((should (not x)) :form (not t) :value nil)))
327 (,(lambda () (let ((x nil)) (should-not (not x))))
328 (ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
329 (,(lambda () (let ((x t) (y nil)) (should-not
330 (ert--test-my-list x y))))
331 (ert-test-failed
332 ((should-not (ert--test-my-list x y))
333 :form (list t nil)
334 :value (t nil))))
335 (,(lambda () (let ((_x t)) (should (error "Foo"))))
336 (error "Foo")))
337 do
338 (let ((test (make-ert-test :body body)))
339 (condition-case actual-condition
340 (progn
341 (let ((ert-debug-on-error t))
342 (ert-run-test test))
343 (cl-assert nil))
344 ((error)
345 (should (equal actual-condition expected-condition)))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100346
347(ert-deftest ert-test-deftest ()
7e8f7e08
SM
Stefan Monnier2015-08-08 19:43:14 -0400348 ;; FIXME: These tests don't look very good. What is their intent, i.e. what
349 ;; are they really testing? The precise generated code shouldn't matter, so
350 ;; we should either test the behavior of the code, or else try to express the
351 ;; kind of efficiency guarantees we're looking for.
d221e780 Christian Ohler2011-01-13 03:08:24 +1100352 (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200353 '(progn
354 (ert-set-test 'abc
355 (progn
0bfc9404 Glenn Morris2015-07-07 13:56:40 -0400356 "Constructor for objects of type `ert-test'."
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200357 (vector 'cl-struct-ert-test 'abc "foo"
358 #'(lambda nil)
359 nil ':passed
360 '(bar))))
361 (setq current-load-list
362 (cons
363 '(ert-deftest . abc)
364 current-load-list))
365 'abc)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100366 (should (equal (macroexpand '(ert-deftest def ()
367 :expected-result ':passed))
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200368 '(progn
369 (ert-set-test 'def
370 (progn
0bfc9404 Glenn Morris2015-07-07 13:56:40 -0400371 "Constructor for objects of type `ert-test'."
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200372 (vector 'cl-struct-ert-test 'def nil
373 #'(lambda nil)
374 nil ':passed 'nil)))
375 (setq current-load-list
376 (cons
377 '(ert-deftest . def)
378 current-load-list))
379 'def)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100380 ;; :documentation keyword is forbidden
381 (should-error (macroexpand '(ert-deftest ghi ()
382 :documentation "foo"))))
383
6a1f3c11
MA
Michael Albinus2014-01-13 11:53:36 +0100384(ert-deftest ert-test-record-backtrace ()
385 (let ((test (make-ert-test :body (lambda () (ert-fail "foo")))))
386 (let ((result (ert-run-test test)))
387 (should (ert-test-failed-p result))
388 (with-temp-buffer
389 (ert--print-backtrace (ert-test-failed-backtrace result))
390 (goto-char (point-min))
391 (end-of-line)
392 (let ((first-line (buffer-substring-no-properties (point-min) (point))))
393 (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()")))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100394
395(ert-deftest ert-test-messages ()
396 :tags '(:causes-redisplay)
397 (let* ((message-string "Test message")
398 (messages-buffer (get-buffer-create "*Messages*"))
399 (test (make-ert-test :body (lambda () (message "%s" message-string)))))
400 (with-current-buffer messages-buffer
401 (let ((result (ert-run-test test)))
402 (should (equal (concat message-string "\n")
403 (ert-test-result-messages result)))))))
404
405(ert-deftest ert-test-running-tests ()
406 (let ((outer-test (ert-get-test 'ert-test-running-tests)))
407 (should (equal (ert-running-test) outer-test))
408 (let (test1 test2 test3)
409 (setq test1 (make-ert-test
410 :name "1"
411 :body (lambda ()
412 (should (equal (ert-running-test) outer-test))
413 (should (equal ert--running-tests
414 (list test1 test2 test3
415 outer-test)))))
416 test2 (make-ert-test
417 :name "2"
418 :body (lambda ()
419 (should (equal (ert-running-test) outer-test))
420 (should (equal ert--running-tests
421 (list test3 test2 outer-test)))
422 (ert-run-test test1)))
423 test3 (make-ert-test
424 :name "3"
425 :body (lambda ()
426 (should (equal (ert-running-test) outer-test))
427 (should (equal ert--running-tests
428 (list test3 outer-test)))
429 (ert-run-test test2))))
430 (should (ert-test-passed-p (ert-run-test test3))))))
431
432(ert-deftest ert-test-test-result-expected-p ()
433 "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'."
434 ;; passing test
435 (let ((test (make-ert-test :body (lambda ()))))
436 (should (ert-test-result-expected-p test (ert-run-test test))))
437 ;; unexpected failure
438 (let ((test (make-ert-test :body (lambda () (ert-fail "failed")))))
439 (should-not (ert-test-result-expected-p test (ert-run-test test))))
440 ;; expected failure
441 (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))
442 :expected-result-type ':failed)))
443 (should (ert-test-result-expected-p test (ert-run-test test))))
444 ;; `not' expected type
445 (let ((test (make-ert-test :body (lambda ())
446 :expected-result-type '(not :failed))))
447 (should (ert-test-result-expected-p test (ert-run-test test))))
448 (let ((test (make-ert-test :body (lambda ())
449 :expected-result-type '(not :passed))))
450 (should-not (ert-test-result-expected-p test (ert-run-test test))))
451 ;; `and' expected type
452 (let ((test (make-ert-test :body (lambda ())
453 :expected-result-type '(and :passed :failed))))
454 (should-not (ert-test-result-expected-p test (ert-run-test test))))
455 (let ((test (make-ert-test :body (lambda ())
456 :expected-result-type '(and :passed
457 (not :failed)))))
458 (should (ert-test-result-expected-p test (ert-run-test test))))
459 ;; `or' expected type
460 (let ((test (make-ert-test :body (lambda ())
461 :expected-result-type '(or (and :passed :failed)
462 :passed))))
463 (should (ert-test-result-expected-p test (ert-run-test test))))
464 (let ((test (make-ert-test :body (lambda ())
465 :expected-result-type '(or (and :passed :failed)
466 nil (not t)))))
467 (should-not (ert-test-result-expected-p test (ert-run-test test)))))
468
469;;; Test `ert-select-tests'.
470(ert-deftest ert-test-select-regexp ()
471 (should (equal (ert-select-tests "^ert-test-select-regexp$" t)
472 (list (ert-get-test 'ert-test-select-regexp)))))
473
474(ert-deftest ert-test-test-boundp ()
475 (should (ert-test-boundp 'ert-test-test-boundp))
476 (should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
477
478(ert-deftest ert-test-select-member ()
479 (should (equal (ert-select-tests '(member ert-test-select-member) t)
480 (list (ert-get-test 'ert-test-select-member)))))
481
482(ert-deftest ert-test-select-test ()
483 (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
484 (list (ert-get-test 'ert-test-select-test)))))
485
486(ert-deftest ert-test-select-symbol ()
487 (should (equal (ert-select-tests 'ert-test-select-symbol t)
488 (list (ert-get-test 'ert-test-select-symbol)))))
489
490(ert-deftest ert-test-select-and ()
491 (let ((test (make-ert-test
492 :name nil
493 :body nil
494 :most-recent-result (make-ert-test-failed
495 :condition nil
496 :backtrace nil
497 :infos nil))))
498 (should (equal (ert-select-tests `(and (member ,test) :failed) t)
499 (list test)))))
500
501(ert-deftest ert-test-select-tag ()
502 (let ((test (make-ert-test
503 :name nil
504 :body nil
505 :tags '(a b))))
506 (should (equal (ert-select-tests `(tag a) (list test)) (list test)))
507 (should (equal (ert-select-tests `(tag b) (list test)) (list test)))
508 (should (equal (ert-select-tests `(tag c) (list test)) '()))))
509
510
511;;; Tests for utility functions.
512(ert-deftest ert-test-proper-list-p ()
513 (should (ert--proper-list-p '()))
514 (should (ert--proper-list-p '(1)))
515 (should (ert--proper-list-p '(1 2)))
516 (should (ert--proper-list-p '(1 2 3)))
517 (should (ert--proper-list-p '(1 2 3 4)))
518 (should (not (ert--proper-list-p 'a)))
519 (should (not (ert--proper-list-p '(1 . a))))
520 (should (not (ert--proper-list-p '(1 2 . a))))
521 (should (not (ert--proper-list-p '(1 2 3 . a))))
522 (should (not (ert--proper-list-p '(1 2 3 4 . a))))
523 (let ((a (list 1)))
524 (setf (cdr (last a)) a)
525 (should (not (ert--proper-list-p a))))
526 (let ((a (list 1 2)))
527 (setf (cdr (last a)) a)
528 (should (not (ert--proper-list-p a))))
529 (let ((a (list 1 2 3)))
530 (setf (cdr (last a)) a)
531 (should (not (ert--proper-list-p a))))
532 (let ((a (list 1 2 3 4)))
533 (setf (cdr (last a)) a)
534 (should (not (ert--proper-list-p a))))
535 (let ((a (list 1 2)))
536 (setf (cdr (last a)) (cdr a))
537 (should (not (ert--proper-list-p a))))
538 (let ((a (list 1 2 3)))
539 (setf (cdr (last a)) (cdr a))
540 (should (not (ert--proper-list-p a))))
541 (let ((a (list 1 2 3 4)))
542 (setf (cdr (last a)) (cdr a))
543 (should (not (ert--proper-list-p a))))
544 (let ((a (list 1 2 3)))
545 (setf (cdr (last a)) (cddr a))
546 (should (not (ert--proper-list-p a))))
547 (let ((a (list 1 2 3 4)))
548 (setf (cdr (last a)) (cddr a))
549 (should (not (ert--proper-list-p a))))
550 (let ((a (list 1 2 3 4)))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500551 (setf (cdr (last a)) (cl-cdddr a))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100552 (should (not (ert--proper-list-p a)))))
553
554(ert-deftest ert-test-parse-keys-and-body ()
555 (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo))))
556 (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
557 (should (equal (ert--parse-keys-and-body '(:bar foo a (b)))
558 '((:bar foo) (a (b)))))
559 (should (equal (ert--parse-keys-and-body '(:bar foo :a (b)))
560 '((:bar foo :a (b)) nil)))
561 (should (equal (ert--parse-keys-and-body '(bar foo :a (b)))
562 '(nil (bar foo :a (b)))))
563 (should-error (ert--parse-keys-and-body '(:bar foo :a))))
564
565
566(ert-deftest ert-test-run-tests-interactively ()
567 :tags '(:causes-redisplay)
568 (let ((passing-test (make-ert-test :name 'passing-test
569 :body (lambda () (ert-pass))))
570 (failing-test (make-ert-test :name 'failing-test
571 :body (lambda () (ert-fail
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200572 "failure message"))))
573 (skipped-test (make-ert-test :name 'skipped-test
574 :body (lambda () (ert-skip
575 "skip message")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100576 (let ((ert-debug-on-error nil))
577 (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
578 (messages nil)
579 (mock-message-fn
580 (lambda (format-string &rest args)
581 (push (apply #'format format-string args) messages))))
582 (save-window-excursion
583 (unwind-protect
584 (let ((case-fold-search nil))
585 (ert-run-tests-interactively
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200586 `(member ,passing-test ,failing-test, skipped-test) buffer-name
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100587 mock-message-fn)
588 (should (equal messages `(,(concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200589 "Ran 3 tests, 1 results were "
590 "as expected, 1 unexpected, "
591 "1 skipped"))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100592 (with-current-buffer buffer-name
593 (goto-char (point-min))
594 (should (equal
595 (buffer-substring (point-min)
596 (save-excursion
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200597 (forward-line 5)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100598 (point)))
599 (concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200600 "Selector: (member <passing-test> <failing-test> "
601 "<skipped-test>)\n"
602 "Passed: 1\n"
603 "Failed: 1 (1 unexpected)\n"
604 "Skipped: 1\n"
605 "Total: 3/3\n")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100606 (when (get-buffer buffer-name)
607 (kill-buffer buffer-name))))))))
608
609(ert-deftest ert-test-special-operator-p ()
610 (should (ert--special-operator-p 'if))
611 (should-not (ert--special-operator-p 'car))
612 (should-not (ert--special-operator-p 'ert--special-operator-p))
a19b3c2d Glenn Morris2013-07-11 09:13:38 -0700613 (let ((b (cl-gensym)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100614 (should-not (ert--special-operator-p b))
615 (fset b 'if)
616 (should (ert--special-operator-p b))))
617
618(ert-deftest ert-test-list-of-should-forms ()
619 (let ((test (make-ert-test :body (lambda ()
620 (should t)
621 (should (null '()))
622 (should nil)
623 (should t)))))
624 (let ((result (let ((ert-debug-on-error nil))
625 (ert-run-test test))))
626 (should (equal (ert-test-result-should-forms result)
627 '(((should t) :form t :value t)
628 ((should (null '())) :form (null nil) :value t)
629 ((should nil) :form nil :value nil)))))))
630
631(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack ()
632 (let ((test (make-ert-test
633 :body (lambda ()
634 (let ((test2 (make-ert-test
635 :body (lambda ()
636 (should t)))))
637 (let ((result (ert-run-test test2)))
638 (should (ert-test-passed-p result))))))))
639 (let ((result (let ((ert-debug-on-error nil))
640 (ert-run-test test))))
641 (should (ert-test-passed-p result))
642 (should (eql (length (ert-test-result-should-forms result))
643 1)))))
644
645(ert-deftest ert-test-list-of-should-forms-no-deep-copy ()
646 (let ((test (make-ert-test :body (lambda ()
647 (let ((obj (list 'a)))
648 (should (equal obj '(a)))
649 (setf (car obj) 'b)
650 (should (equal obj '(b))))))))
651 (let ((result (let ((ert-debug-on-error nil))
652 (ert-run-test test))))
653 (should (ert-test-passed-p result))
654 (should (equal (ert-test-result-should-forms result)
655 '(((should (equal obj '(a))) :form (equal (b) (a)) :value t
656 :explanation nil)
657 ((should (equal obj '(b))) :form (equal (b) (b)) :value t
658 :explanation nil)
659 ))))))
660
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100661(ert-deftest ert-test-string-first-line ()
662 (should (equal (ert--string-first-line "") ""))
663 (should (equal (ert--string-first-line "abc") "abc"))
664 (should (equal (ert--string-first-line "abc\n") "abc"))
665 (should (equal (ert--string-first-line "foo\nbar") "foo"))
666 (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo")))
667
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700668(ert-deftest ert-test-explain-equal ()
669 (should (equal (ert--explain-equal nil 'foo)
d221e780 Christian Ohler2011-01-13 03:08:24 +1100670 '(different-atoms nil foo)))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700671 (should (equal (ert--explain-equal '(a a) '(a b))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100672 '(list-elt 1 (different-atoms a b))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700673 (should (equal (ert--explain-equal '(1 48) '(1 49))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100674 '(list-elt 1 (different-atoms (48 "#x30" "?0")
675 (49 "#x31" "?1")))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700676 (should (equal (ert--explain-equal 'nil '(a))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100677 '(different-types nil (a))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700678 (should (equal (ert--explain-equal '(a b c) '(a b c d))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100679 '(proper-lists-of-different-length 3 4 (a b c) (a b c d)
680 first-mismatch-at 3)))
681 (let ((sym (make-symbol "a")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700682 (should (equal (ert--explain-equal 'a sym)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100683 `(different-symbols-with-the-same-name a ,sym)))))
684
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700685(ert-deftest ert-test-explain-equal-improper-list ()
686 (should (equal (ert--explain-equal '(a . b) '(a . c))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100687 '(cdr (different-atoms b c)))))
688
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700689(ert-deftest ert-test-explain-equal-keymaps ()
690 ;; This used to be very slow.
691 (should (equal (make-keymap) (make-keymap)))
692 (should (equal (make-sparse-keymap) (make-sparse-keymap))))
693
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100694(ert-deftest ert-test-significant-plist-keys ()
695 (should (equal (ert--significant-plist-keys '()) '()))
696 (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t))
697 '(a c e p s))))
698
699(ert-deftest ert-test-plist-difference-explanation ()
700 (should (equal (ert--plist-difference-explanation
701 '(a b c nil) '(a b))
702 nil))
703 (should (equal (ert--plist-difference-explanation
704 '(a b c t) '(a b))
705 '(different-properties-for-key c (different-atoms t nil))))
706 (should (equal (ert--plist-difference-explanation
707 '(a b c t) '(c nil a b))
708 '(different-properties-for-key c (different-atoms t nil))))
709 (should (equal (ert--plist-difference-explanation
710 '(a b c (foo . bar)) '(c (foo . baz) a b))
711 '(different-properties-for-key c
712 (cdr
713 (different-atoms bar baz))))))
714
715(ert-deftest ert-test-abbreviate-string ()
716 (should (equal (ert--abbreviate-string "foo" 4 nil) "foo"))
717 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
718 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
719 (should (equal (ert--abbreviate-string "foo" 2 nil) "fo"))
720 (should (equal (ert--abbreviate-string "foo" 1 nil) "f"))
721 (should (equal (ert--abbreviate-string "foo" 0 nil) ""))
722 (should (equal (ert--abbreviate-string "bar" 4 t) "bar"))
723 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
724 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
725 (should (equal (ert--abbreviate-string "bar" 2 t) "ar"))
726 (should (equal (ert--abbreviate-string "bar" 1 t) "r"))
727 (should (equal (ert--abbreviate-string "bar" 0 t) "")))
728
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700729(ert-deftest ert-test-explain-equal-string-properties ()
d221e780 Christian Ohler2011-01-13 03:08:24 +1100730 (should
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700731 (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
732 "foo")
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100733 '(char 0 "f"
734 (different-properties-for-key a (different-atoms b nil))
735 context-before ""
736 context-after "oo")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700737 (should (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100738 #("foo" 1 3 (a b))
739 #("goo" 0 1 (c d)))
740 '(array-elt 0 (different-atoms (?f "#x66" "?f")
741 (?g "#x67" "?g")))))
742 (should
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700743 (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100744 #("foo" 0 1 (a b c d) 1 3 (a b))
745 #("foo" 0 1 (c d a b) 1 2 (a foo)))
746 '(char 1 "o" (different-properties-for-key a (different-atoms b foo))
747 context-before "f" context-after "o"))))
748
749(ert-deftest ert-test-equal-including-properties ()
750 (should (equal-including-properties "foo" "foo"))
751 (should (ert-equal-including-properties "foo" "foo"))
752
753 (should (equal-including-properties #("foo" 0 3 (a b))
754 (propertize "foo" 'a 'b)))
755 (should (ert-equal-including-properties #("foo" 0 3 (a b))
756 (propertize "foo" 'a 'b)))
757
758 (should (equal-including-properties #("foo" 0 3 (a b c d))
759 (propertize "foo" 'a 'b 'c 'd)))
760 (should (ert-equal-including-properties #("foo" 0 3 (a b c d))
761 (propertize "foo" 'a 'b 'c 'd)))
762
763 (should-not (equal-including-properties #("foo" 0 3 (a b c e))
764 (propertize "foo" 'a 'b 'c 'd)))
765 (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e))
766 (propertize "foo" 'a 'b 'c 'd)))
767
768 ;; This is bug 6581.
769 (should-not (equal-including-properties #("foo" 0 3 (a (t)))
770 (propertize "foo" 'a (list t))))
771 (should (ert-equal-including-properties #("foo" 0 3 (a (t)))
772 (propertize "foo" 'a (list t)))))
773
774(ert-deftest ert-test-stats-set-test-and-result ()
775 (let* ((test-1 (make-ert-test :name 'test-1
776 :body (lambda () nil)))
777 (test-2 (make-ert-test :name 'test-2
778 :body (lambda () nil)))
779 (test-3 (make-ert-test :name 'test-2
780 :body (lambda () nil)))
781 (stats (ert--make-stats (list test-1 test-2) 't))
782 (failed (make-ert-test-failed :condition nil
783 :backtrace nil
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100784 :infos nil))
785 (skipped (make-ert-test-skipped :condition nil
786 :backtrace nil
787 :infos nil)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100788 (should (eql 2 (ert-stats-total stats)))
789 (should (eql 0 (ert-stats-completed stats)))
790 (should (eql 0 (ert-stats-completed-expected stats)))
791 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100792 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100793 (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
794 (should (eql 2 (ert-stats-total stats)))
795 (should (eql 1 (ert-stats-completed stats)))
796 (should (eql 1 (ert-stats-completed-expected stats)))
797 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100798 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100799 (ert--stats-set-test-and-result stats 0 test-1 failed)
800 (should (eql 2 (ert-stats-total stats)))
801 (should (eql 1 (ert-stats-completed stats)))
802 (should (eql 0 (ert-stats-completed-expected stats)))
803 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100804 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100805 (ert--stats-set-test-and-result stats 0 test-1 nil)
806 (should (eql 2 (ert-stats-total stats)))
807 (should (eql 0 (ert-stats-completed stats)))
808 (should (eql 0 (ert-stats-completed-expected stats)))
809 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100810 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100811 (ert--stats-set-test-and-result stats 0 test-3 failed)
812 (should (eql 2 (ert-stats-total stats)))
813 (should (eql 1 (ert-stats-completed stats)))
814 (should (eql 0 (ert-stats-completed-expected stats)))
815 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100816 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100817 (ert--stats-set-test-and-result stats 1 test-2 (make-ert-test-passed))
818 (should (eql 2 (ert-stats-total stats)))
819 (should (eql 2 (ert-stats-completed stats)))
820 (should (eql 1 (ert-stats-completed-expected stats)))
821 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100822 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100823 (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
824 (should (eql 2 (ert-stats-total stats)))
825 (should (eql 2 (ert-stats-completed stats)))
826 (should (eql 2 (ert-stats-completed-expected stats)))
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100827 (should (eql 0 (ert-stats-completed-unexpected stats)))
828 (should (eql 0 (ert-stats-skipped stats)))
829 (ert--stats-set-test-and-result stats 0 test-1 skipped)
830 (should (eql 2 (ert-stats-total stats)))
831 (should (eql 2 (ert-stats-completed stats)))
832 (should (eql 1 (ert-stats-completed-expected stats)))
833 (should (eql 0 (ert-stats-completed-unexpected stats)))
834 (should (eql 1 (ert-stats-skipped stats)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100835
836
837(provide 'ert-tests)
838
839;;; ert-tests.el ends here
5bca8dfb
GM
Glenn Morris2014-06-25 23:02:52 -0700840
841;; Local Variables:
842;; no-byte-compile: t
843;; End: