Redo text-quoting-style variable
[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 ()
348 (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200349 '(progn
350 (ert-set-test 'abc
351 (progn
0bfc9404 Glenn Morris2015-07-07 13:56:40 -0400352 "Constructor for objects of type `ert-test'."
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200353 (vector 'cl-struct-ert-test 'abc "foo"
354 #'(lambda nil)
355 nil ':passed
356 '(bar))))
357 (setq current-load-list
358 (cons
359 '(ert-deftest . abc)
360 current-load-list))
361 'abc)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100362 (should (equal (macroexpand '(ert-deftest def ()
363 :expected-result ':passed))
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200364 '(progn
365 (ert-set-test 'def
366 (progn
0bfc9404 Glenn Morris2015-07-07 13:56:40 -0400367 "Constructor for objects of type `ert-test'."
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200368 (vector 'cl-struct-ert-test 'def nil
369 #'(lambda nil)
370 nil ':passed 'nil)))
371 (setq current-load-list
372 (cons
373 '(ert-deftest . def)
374 current-load-list))
375 'def)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100376 ;; :documentation keyword is forbidden
377 (should-error (macroexpand '(ert-deftest ghi ()
378 :documentation "foo"))))
379
6a1f3c11
MA
Michael Albinus2014-01-13 11:53:36 +0100380(ert-deftest ert-test-record-backtrace ()
381 (let ((test (make-ert-test :body (lambda () (ert-fail "foo")))))
382 (let ((result (ert-run-test test)))
383 (should (ert-test-failed-p result))
384 (with-temp-buffer
385 (ert--print-backtrace (ert-test-failed-backtrace result))
386 (goto-char (point-min))
387 (end-of-line)
388 (let ((first-line (buffer-substring-no-properties (point-min) (point))))
389 (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()")))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100390
391(ert-deftest ert-test-messages ()
392 :tags '(:causes-redisplay)
393 (let* ((message-string "Test message")
394 (messages-buffer (get-buffer-create "*Messages*"))
395 (test (make-ert-test :body (lambda () (message "%s" message-string)))))
396 (with-current-buffer messages-buffer
397 (let ((result (ert-run-test test)))
398 (should (equal (concat message-string "\n")
399 (ert-test-result-messages result)))))))
400
401(ert-deftest ert-test-running-tests ()
402 (let ((outer-test (ert-get-test 'ert-test-running-tests)))
403 (should (equal (ert-running-test) outer-test))
404 (let (test1 test2 test3)
405 (setq test1 (make-ert-test
406 :name "1"
407 :body (lambda ()
408 (should (equal (ert-running-test) outer-test))
409 (should (equal ert--running-tests
410 (list test1 test2 test3
411 outer-test)))))
412 test2 (make-ert-test
413 :name "2"
414 :body (lambda ()
415 (should (equal (ert-running-test) outer-test))
416 (should (equal ert--running-tests
417 (list test3 test2 outer-test)))
418 (ert-run-test test1)))
419 test3 (make-ert-test
420 :name "3"
421 :body (lambda ()
422 (should (equal (ert-running-test) outer-test))
423 (should (equal ert--running-tests
424 (list test3 outer-test)))
425 (ert-run-test test2))))
426 (should (ert-test-passed-p (ert-run-test test3))))))
427
428(ert-deftest ert-test-test-result-expected-p ()
429 "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'."
430 ;; passing test
431 (let ((test (make-ert-test :body (lambda ()))))
432 (should (ert-test-result-expected-p test (ert-run-test test))))
433 ;; unexpected failure
434 (let ((test (make-ert-test :body (lambda () (ert-fail "failed")))))
435 (should-not (ert-test-result-expected-p test (ert-run-test test))))
436 ;; expected failure
437 (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))
438 :expected-result-type ':failed)))
439 (should (ert-test-result-expected-p test (ert-run-test test))))
440 ;; `not' expected type
441 (let ((test (make-ert-test :body (lambda ())
442 :expected-result-type '(not :failed))))
443 (should (ert-test-result-expected-p test (ert-run-test test))))
444 (let ((test (make-ert-test :body (lambda ())
445 :expected-result-type '(not :passed))))
446 (should-not (ert-test-result-expected-p test (ert-run-test test))))
447 ;; `and' expected type
448 (let ((test (make-ert-test :body (lambda ())
449 :expected-result-type '(and :passed :failed))))
450 (should-not (ert-test-result-expected-p test (ert-run-test test))))
451 (let ((test (make-ert-test :body (lambda ())
452 :expected-result-type '(and :passed
453 (not :failed)))))
454 (should (ert-test-result-expected-p test (ert-run-test test))))
455 ;; `or' expected type
456 (let ((test (make-ert-test :body (lambda ())
457 :expected-result-type '(or (and :passed :failed)
458 :passed))))
459 (should (ert-test-result-expected-p test (ert-run-test test))))
460 (let ((test (make-ert-test :body (lambda ())
461 :expected-result-type '(or (and :passed :failed)
462 nil (not t)))))
463 (should-not (ert-test-result-expected-p test (ert-run-test test)))))
464
465;;; Test `ert-select-tests'.
466(ert-deftest ert-test-select-regexp ()
467 (should (equal (ert-select-tests "^ert-test-select-regexp$" t)
468 (list (ert-get-test 'ert-test-select-regexp)))))
469
470(ert-deftest ert-test-test-boundp ()
471 (should (ert-test-boundp 'ert-test-test-boundp))
472 (should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
473
474(ert-deftest ert-test-select-member ()
475 (should (equal (ert-select-tests '(member ert-test-select-member) t)
476 (list (ert-get-test 'ert-test-select-member)))))
477
478(ert-deftest ert-test-select-test ()
479 (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
480 (list (ert-get-test 'ert-test-select-test)))))
481
482(ert-deftest ert-test-select-symbol ()
483 (should (equal (ert-select-tests 'ert-test-select-symbol t)
484 (list (ert-get-test 'ert-test-select-symbol)))))
485
486(ert-deftest ert-test-select-and ()
487 (let ((test (make-ert-test
488 :name nil
489 :body nil
490 :most-recent-result (make-ert-test-failed
491 :condition nil
492 :backtrace nil
493 :infos nil))))
494 (should (equal (ert-select-tests `(and (member ,test) :failed) t)
495 (list test)))))
496
497(ert-deftest ert-test-select-tag ()
498 (let ((test (make-ert-test
499 :name nil
500 :body nil
501 :tags '(a b))))
502 (should (equal (ert-select-tests `(tag a) (list test)) (list test)))
503 (should (equal (ert-select-tests `(tag b) (list test)) (list test)))
504 (should (equal (ert-select-tests `(tag c) (list test)) '()))))
505
506
507;;; Tests for utility functions.
508(ert-deftest ert-test-proper-list-p ()
509 (should (ert--proper-list-p '()))
510 (should (ert--proper-list-p '(1)))
511 (should (ert--proper-list-p '(1 2)))
512 (should (ert--proper-list-p '(1 2 3)))
513 (should (ert--proper-list-p '(1 2 3 4)))
514 (should (not (ert--proper-list-p 'a)))
515 (should (not (ert--proper-list-p '(1 . a))))
516 (should (not (ert--proper-list-p '(1 2 . a))))
517 (should (not (ert--proper-list-p '(1 2 3 . a))))
518 (should (not (ert--proper-list-p '(1 2 3 4 . a))))
519 (let ((a (list 1)))
520 (setf (cdr (last a)) a)
521 (should (not (ert--proper-list-p a))))
522 (let ((a (list 1 2)))
523 (setf (cdr (last a)) a)
524 (should (not (ert--proper-list-p a))))
525 (let ((a (list 1 2 3)))
526 (setf (cdr (last a)) a)
527 (should (not (ert--proper-list-p a))))
528 (let ((a (list 1 2 3 4)))
529 (setf (cdr (last a)) a)
530 (should (not (ert--proper-list-p a))))
531 (let ((a (list 1 2)))
532 (setf (cdr (last a)) (cdr a))
533 (should (not (ert--proper-list-p a))))
534 (let ((a (list 1 2 3)))
535 (setf (cdr (last a)) (cdr a))
536 (should (not (ert--proper-list-p a))))
537 (let ((a (list 1 2 3 4)))
538 (setf (cdr (last a)) (cdr a))
539 (should (not (ert--proper-list-p a))))
540 (let ((a (list 1 2 3)))
541 (setf (cdr (last a)) (cddr a))
542 (should (not (ert--proper-list-p a))))
543 (let ((a (list 1 2 3 4)))
544 (setf (cdr (last a)) (cddr a))
545 (should (not (ert--proper-list-p a))))
546 (let ((a (list 1 2 3 4)))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500547 (setf (cdr (last a)) (cl-cdddr a))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100548 (should (not (ert--proper-list-p a)))))
549
550(ert-deftest ert-test-parse-keys-and-body ()
551 (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo))))
552 (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
553 (should (equal (ert--parse-keys-and-body '(:bar foo a (b)))
554 '((:bar foo) (a (b)))))
555 (should (equal (ert--parse-keys-and-body '(:bar foo :a (b)))
556 '((:bar foo :a (b)) nil)))
557 (should (equal (ert--parse-keys-and-body '(bar foo :a (b)))
558 '(nil (bar foo :a (b)))))
559 (should-error (ert--parse-keys-and-body '(:bar foo :a))))
560
561
562(ert-deftest ert-test-run-tests-interactively ()
563 :tags '(:causes-redisplay)
564 (let ((passing-test (make-ert-test :name 'passing-test
565 :body (lambda () (ert-pass))))
566 (failing-test (make-ert-test :name 'failing-test
567 :body (lambda () (ert-fail
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200568 "failure message"))))
569 (skipped-test (make-ert-test :name 'skipped-test
570 :body (lambda () (ert-skip
571 "skip message")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100572 (let ((ert-debug-on-error nil))
573 (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
574 (messages nil)
575 (mock-message-fn
576 (lambda (format-string &rest args)
577 (push (apply #'format format-string args) messages))))
578 (save-window-excursion
579 (unwind-protect
580 (let ((case-fold-search nil))
581 (ert-run-tests-interactively
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200582 `(member ,passing-test ,failing-test, skipped-test) buffer-name
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100583 mock-message-fn)
584 (should (equal messages `(,(concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200585 "Ran 3 tests, 1 results were "
586 "as expected, 1 unexpected, "
587 "1 skipped"))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100588 (with-current-buffer buffer-name
589 (goto-char (point-min))
590 (should (equal
591 (buffer-substring (point-min)
592 (save-excursion
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200593 (forward-line 5)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100594 (point)))
595 (concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200596 "Selector: (member <passing-test> <failing-test> "
597 "<skipped-test>)\n"
598 "Passed: 1\n"
599 "Failed: 1 (1 unexpected)\n"
600 "Skipped: 1\n"
601 "Total: 3/3\n")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100602 (when (get-buffer buffer-name)
603 (kill-buffer buffer-name))))))))
604
605(ert-deftest ert-test-special-operator-p ()
606 (should (ert--special-operator-p 'if))
607 (should-not (ert--special-operator-p 'car))
608 (should-not (ert--special-operator-p 'ert--special-operator-p))
a19b3c2d Glenn Morris2013-07-11 09:13:38 -0700609 (let ((b (cl-gensym)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100610 (should-not (ert--special-operator-p b))
611 (fset b 'if)
612 (should (ert--special-operator-p b))))
613
614(ert-deftest ert-test-list-of-should-forms ()
615 (let ((test (make-ert-test :body (lambda ()
616 (should t)
617 (should (null '()))
618 (should nil)
619 (should t)))))
620 (let ((result (let ((ert-debug-on-error nil))
621 (ert-run-test test))))
622 (should (equal (ert-test-result-should-forms result)
623 '(((should t) :form t :value t)
624 ((should (null '())) :form (null nil) :value t)
625 ((should nil) :form nil :value nil)))))))
626
627(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack ()
628 (let ((test (make-ert-test
629 :body (lambda ()
630 (let ((test2 (make-ert-test
631 :body (lambda ()
632 (should t)))))
633 (let ((result (ert-run-test test2)))
634 (should (ert-test-passed-p result))))))))
635 (let ((result (let ((ert-debug-on-error nil))
636 (ert-run-test test))))
637 (should (ert-test-passed-p result))
638 (should (eql (length (ert-test-result-should-forms result))
639 1)))))
640
641(ert-deftest ert-test-list-of-should-forms-no-deep-copy ()
642 (let ((test (make-ert-test :body (lambda ()
643 (let ((obj (list 'a)))
644 (should (equal obj '(a)))
645 (setf (car obj) 'b)
646 (should (equal obj '(b))))))))
647 (let ((result (let ((ert-debug-on-error nil))
648 (ert-run-test test))))
649 (should (ert-test-passed-p result))
650 (should (equal (ert-test-result-should-forms result)
651 '(((should (equal obj '(a))) :form (equal (b) (a)) :value t
652 :explanation nil)
653 ((should (equal obj '(b))) :form (equal (b) (b)) :value t
654 :explanation nil)
655 ))))))
656
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100657(ert-deftest ert-test-string-first-line ()
658 (should (equal (ert--string-first-line "") ""))
659 (should (equal (ert--string-first-line "abc") "abc"))
660 (should (equal (ert--string-first-line "abc\n") "abc"))
661 (should (equal (ert--string-first-line "foo\nbar") "foo"))
662 (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo")))
663
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700664(ert-deftest ert-test-explain-equal ()
665 (should (equal (ert--explain-equal nil 'foo)
d221e780 Christian Ohler2011-01-13 03:08:24 +1100666 '(different-atoms nil foo)))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700667 (should (equal (ert--explain-equal '(a a) '(a b))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100668 '(list-elt 1 (different-atoms a b))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700669 (should (equal (ert--explain-equal '(1 48) '(1 49))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100670 '(list-elt 1 (different-atoms (48 "#x30" "?0")
671 (49 "#x31" "?1")))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700672 (should (equal (ert--explain-equal 'nil '(a))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100673 '(different-types nil (a))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700674 (should (equal (ert--explain-equal '(a b c) '(a b c d))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100675 '(proper-lists-of-different-length 3 4 (a b c) (a b c d)
676 first-mismatch-at 3)))
677 (let ((sym (make-symbol "a")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700678 (should (equal (ert--explain-equal 'a sym)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100679 `(different-symbols-with-the-same-name a ,sym)))))
680
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700681(ert-deftest ert-test-explain-equal-improper-list ()
682 (should (equal (ert--explain-equal '(a . b) '(a . c))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100683 '(cdr (different-atoms b c)))))
684
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700685(ert-deftest ert-test-explain-equal-keymaps ()
686 ;; This used to be very slow.
687 (should (equal (make-keymap) (make-keymap)))
688 (should (equal (make-sparse-keymap) (make-sparse-keymap))))
689
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100690(ert-deftest ert-test-significant-plist-keys ()
691 (should (equal (ert--significant-plist-keys '()) '()))
692 (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t))
693 '(a c e p s))))
694
695(ert-deftest ert-test-plist-difference-explanation ()
696 (should (equal (ert--plist-difference-explanation
697 '(a b c nil) '(a b))
698 nil))
699 (should (equal (ert--plist-difference-explanation
700 '(a b c t) '(a b))
701 '(different-properties-for-key c (different-atoms t nil))))
702 (should (equal (ert--plist-difference-explanation
703 '(a b c t) '(c nil a b))
704 '(different-properties-for-key c (different-atoms t nil))))
705 (should (equal (ert--plist-difference-explanation
706 '(a b c (foo . bar)) '(c (foo . baz) a b))
707 '(different-properties-for-key c
708 (cdr
709 (different-atoms bar baz))))))
710
711(ert-deftest ert-test-abbreviate-string ()
712 (should (equal (ert--abbreviate-string "foo" 4 nil) "foo"))
713 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
714 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
715 (should (equal (ert--abbreviate-string "foo" 2 nil) "fo"))
716 (should (equal (ert--abbreviate-string "foo" 1 nil) "f"))
717 (should (equal (ert--abbreviate-string "foo" 0 nil) ""))
718 (should (equal (ert--abbreviate-string "bar" 4 t) "bar"))
719 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
720 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
721 (should (equal (ert--abbreviate-string "bar" 2 t) "ar"))
722 (should (equal (ert--abbreviate-string "bar" 1 t) "r"))
723 (should (equal (ert--abbreviate-string "bar" 0 t) "")))
724
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700725(ert-deftest ert-test-explain-equal-string-properties ()
d221e780 Christian Ohler2011-01-13 03:08:24 +1100726 (should
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700727 (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
728 "foo")
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100729 '(char 0 "f"
730 (different-properties-for-key a (different-atoms b nil))
731 context-before ""
732 context-after "oo")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700733 (should (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100734 #("foo" 1 3 (a b))
735 #("goo" 0 1 (c d)))
736 '(array-elt 0 (different-atoms (?f "#x66" "?f")
737 (?g "#x67" "?g")))))
738 (should
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700739 (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100740 #("foo" 0 1 (a b c d) 1 3 (a b))
741 #("foo" 0 1 (c d a b) 1 2 (a foo)))
742 '(char 1 "o" (different-properties-for-key a (different-atoms b foo))
743 context-before "f" context-after "o"))))
744
745(ert-deftest ert-test-equal-including-properties ()
746 (should (equal-including-properties "foo" "foo"))
747 (should (ert-equal-including-properties "foo" "foo"))
748
749 (should (equal-including-properties #("foo" 0 3 (a b))
750 (propertize "foo" 'a 'b)))
751 (should (ert-equal-including-properties #("foo" 0 3 (a b))
752 (propertize "foo" 'a 'b)))
753
754 (should (equal-including-properties #("foo" 0 3 (a b c d))
755 (propertize "foo" 'a 'b 'c 'd)))
756 (should (ert-equal-including-properties #("foo" 0 3 (a b c d))
757 (propertize "foo" 'a 'b 'c 'd)))
758
759 (should-not (equal-including-properties #("foo" 0 3 (a b c e))
760 (propertize "foo" 'a 'b 'c 'd)))
761 (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e))
762 (propertize "foo" 'a 'b 'c 'd)))
763
764 ;; This is bug 6581.
765 (should-not (equal-including-properties #("foo" 0 3 (a (t)))
766 (propertize "foo" 'a (list t))))
767 (should (ert-equal-including-properties #("foo" 0 3 (a (t)))
768 (propertize "foo" 'a (list t)))))
769
770(ert-deftest ert-test-stats-set-test-and-result ()
771 (let* ((test-1 (make-ert-test :name 'test-1
772 :body (lambda () nil)))
773 (test-2 (make-ert-test :name 'test-2
774 :body (lambda () nil)))
775 (test-3 (make-ert-test :name 'test-2
776 :body (lambda () nil)))
777 (stats (ert--make-stats (list test-1 test-2) 't))
778 (failed (make-ert-test-failed :condition nil
779 :backtrace nil
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100780 :infos nil))
781 (skipped (make-ert-test-skipped :condition nil
782 :backtrace nil
783 :infos nil)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100784 (should (eql 2 (ert-stats-total stats)))
785 (should (eql 0 (ert-stats-completed stats)))
786 (should (eql 0 (ert-stats-completed-expected stats)))
787 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100788 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100789 (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
790 (should (eql 2 (ert-stats-total stats)))
791 (should (eql 1 (ert-stats-completed stats)))
792 (should (eql 1 (ert-stats-completed-expected stats)))
793 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100794 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100795 (ert--stats-set-test-and-result stats 0 test-1 failed)
796 (should (eql 2 (ert-stats-total stats)))
797 (should (eql 1 (ert-stats-completed stats)))
798 (should (eql 0 (ert-stats-completed-expected stats)))
799 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100800 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100801 (ert--stats-set-test-and-result stats 0 test-1 nil)
802 (should (eql 2 (ert-stats-total stats)))
803 (should (eql 0 (ert-stats-completed stats)))
804 (should (eql 0 (ert-stats-completed-expected stats)))
805 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100806 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100807 (ert--stats-set-test-and-result stats 0 test-3 failed)
808 (should (eql 2 (ert-stats-total stats)))
809 (should (eql 1 (ert-stats-completed stats)))
810 (should (eql 0 (ert-stats-completed-expected stats)))
811 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100812 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100813 (ert--stats-set-test-and-result stats 1 test-2 (make-ert-test-passed))
814 (should (eql 2 (ert-stats-total stats)))
815 (should (eql 2 (ert-stats-completed stats)))
816 (should (eql 1 (ert-stats-completed-expected stats)))
817 (should (eql 1 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100818 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100819 (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
820 (should (eql 2 (ert-stats-total stats)))
821 (should (eql 2 (ert-stats-completed stats)))
822 (should (eql 2 (ert-stats-completed-expected stats)))
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100823 (should (eql 0 (ert-stats-completed-unexpected stats)))
824 (should (eql 0 (ert-stats-skipped stats)))
825 (ert--stats-set-test-and-result stats 0 test-1 skipped)
826 (should (eql 2 (ert-stats-total stats)))
827 (should (eql 2 (ert-stats-completed stats)))
828 (should (eql 1 (ert-stats-completed-expected stats)))
829 (should (eql 0 (ert-stats-completed-unexpected stats)))
830 (should (eql 1 (ert-stats-skipped stats)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100831
832
833(provide 'ert-tests)
834
835;;; ert-tests.el ends here
5bca8dfb
GM
Glenn Morris2014-06-25 23:02:52 -0700836
837;; Local Variables:
838;; no-byte-compile: t
839;; End: