(define-modify-macro): Make sure cl--arglist-args is defined
[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
352 (vector 'cl-struct-ert-test 'abc "foo"
353 #'(lambda nil)
354 nil ':passed
355 '(bar))))
356 (setq current-load-list
357 (cons
358 '(ert-deftest . abc)
359 current-load-list))
360 'abc)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100361 (should (equal (macroexpand '(ert-deftest def ()
362 :expected-result ':passed))
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200363 '(progn
364 (ert-set-test 'def
365 (progn
366 (vector 'cl-struct-ert-test 'def nil
367 #'(lambda nil)
368 nil ':passed 'nil)))
369 (setq current-load-list
370 (cons
371 '(ert-deftest . def)
372 current-load-list))
373 'def)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100374 ;; :documentation keyword is forbidden
375 (should-error (macroexpand '(ert-deftest ghi ()
376 :documentation "foo"))))
377
6a1f3c11
MA
Michael Albinus2014-01-13 11:53:36 +0100378(ert-deftest ert-test-record-backtrace ()
379 (let ((test (make-ert-test :body (lambda () (ert-fail "foo")))))
380 (let ((result (ert-run-test test)))
381 (should (ert-test-failed-p result))
382 (with-temp-buffer
383 (ert--print-backtrace (ert-test-failed-backtrace result))
384 (goto-char (point-min))
385 (end-of-line)
386 (let ((first-line (buffer-substring-no-properties (point-min) (point))))
387 (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()")))))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100388
389(ert-deftest ert-test-messages ()
390 :tags '(:causes-redisplay)
391 (let* ((message-string "Test message")
392 (messages-buffer (get-buffer-create "*Messages*"))
393 (test (make-ert-test :body (lambda () (message "%s" message-string)))))
394 (with-current-buffer messages-buffer
395 (let ((result (ert-run-test test)))
396 (should (equal (concat message-string "\n")
397 (ert-test-result-messages result)))))))
398
399(ert-deftest ert-test-running-tests ()
400 (let ((outer-test (ert-get-test 'ert-test-running-tests)))
401 (should (equal (ert-running-test) outer-test))
402 (let (test1 test2 test3)
403 (setq test1 (make-ert-test
404 :name "1"
405 :body (lambda ()
406 (should (equal (ert-running-test) outer-test))
407 (should (equal ert--running-tests
408 (list test1 test2 test3
409 outer-test)))))
410 test2 (make-ert-test
411 :name "2"
412 :body (lambda ()
413 (should (equal (ert-running-test) outer-test))
414 (should (equal ert--running-tests
415 (list test3 test2 outer-test)))
416 (ert-run-test test1)))
417 test3 (make-ert-test
418 :name "3"
419 :body (lambda ()
420 (should (equal (ert-running-test) outer-test))
421 (should (equal ert--running-tests
422 (list test3 outer-test)))
423 (ert-run-test test2))))
424 (should (ert-test-passed-p (ert-run-test test3))))))
425
426(ert-deftest ert-test-test-result-expected-p ()
427 "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'."
428 ;; passing test
429 (let ((test (make-ert-test :body (lambda ()))))
430 (should (ert-test-result-expected-p test (ert-run-test test))))
431 ;; unexpected failure
432 (let ((test (make-ert-test :body (lambda () (ert-fail "failed")))))
433 (should-not (ert-test-result-expected-p test (ert-run-test test))))
434 ;; expected failure
435 (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))
436 :expected-result-type ':failed)))
437 (should (ert-test-result-expected-p test (ert-run-test test))))
438 ;; `not' expected type
439 (let ((test (make-ert-test :body (lambda ())
440 :expected-result-type '(not :failed))))
441 (should (ert-test-result-expected-p test (ert-run-test test))))
442 (let ((test (make-ert-test :body (lambda ())
443 :expected-result-type '(not :passed))))
444 (should-not (ert-test-result-expected-p test (ert-run-test test))))
445 ;; `and' expected type
446 (let ((test (make-ert-test :body (lambda ())
447 :expected-result-type '(and :passed :failed))))
448 (should-not (ert-test-result-expected-p test (ert-run-test test))))
449 (let ((test (make-ert-test :body (lambda ())
450 :expected-result-type '(and :passed
451 (not :failed)))))
452 (should (ert-test-result-expected-p test (ert-run-test test))))
453 ;; `or' expected type
454 (let ((test (make-ert-test :body (lambda ())
455 :expected-result-type '(or (and :passed :failed)
456 :passed))))
457 (should (ert-test-result-expected-p test (ert-run-test test))))
458 (let ((test (make-ert-test :body (lambda ())
459 :expected-result-type '(or (and :passed :failed)
460 nil (not t)))))
461 (should-not (ert-test-result-expected-p test (ert-run-test test)))))
462
463;;; Test `ert-select-tests'.
464(ert-deftest ert-test-select-regexp ()
465 (should (equal (ert-select-tests "^ert-test-select-regexp$" t)
466 (list (ert-get-test 'ert-test-select-regexp)))))
467
468(ert-deftest ert-test-test-boundp ()
469 (should (ert-test-boundp 'ert-test-test-boundp))
470 (should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
471
472(ert-deftest ert-test-select-member ()
473 (should (equal (ert-select-tests '(member ert-test-select-member) t)
474 (list (ert-get-test 'ert-test-select-member)))))
475
476(ert-deftest ert-test-select-test ()
477 (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
478 (list (ert-get-test 'ert-test-select-test)))))
479
480(ert-deftest ert-test-select-symbol ()
481 (should (equal (ert-select-tests 'ert-test-select-symbol t)
482 (list (ert-get-test 'ert-test-select-symbol)))))
483
484(ert-deftest ert-test-select-and ()
485 (let ((test (make-ert-test
486 :name nil
487 :body nil
488 :most-recent-result (make-ert-test-failed
489 :condition nil
490 :backtrace nil
491 :infos nil))))
492 (should (equal (ert-select-tests `(and (member ,test) :failed) t)
493 (list test)))))
494
495(ert-deftest ert-test-select-tag ()
496 (let ((test (make-ert-test
497 :name nil
498 :body nil
499 :tags '(a b))))
500 (should (equal (ert-select-tests `(tag a) (list test)) (list test)))
501 (should (equal (ert-select-tests `(tag b) (list test)) (list test)))
502 (should (equal (ert-select-tests `(tag c) (list test)) '()))))
503
504
505;;; Tests for utility functions.
506(ert-deftest ert-test-proper-list-p ()
507 (should (ert--proper-list-p '()))
508 (should (ert--proper-list-p '(1)))
509 (should (ert--proper-list-p '(1 2)))
510 (should (ert--proper-list-p '(1 2 3)))
511 (should (ert--proper-list-p '(1 2 3 4)))
512 (should (not (ert--proper-list-p 'a)))
513 (should (not (ert--proper-list-p '(1 . a))))
514 (should (not (ert--proper-list-p '(1 2 . a))))
515 (should (not (ert--proper-list-p '(1 2 3 . a))))
516 (should (not (ert--proper-list-p '(1 2 3 4 . a))))
517 (let ((a (list 1)))
518 (setf (cdr (last a)) a)
519 (should (not (ert--proper-list-p a))))
520 (let ((a (list 1 2)))
521 (setf (cdr (last a)) a)
522 (should (not (ert--proper-list-p a))))
523 (let ((a (list 1 2 3)))
524 (setf (cdr (last a)) a)
525 (should (not (ert--proper-list-p a))))
526 (let ((a (list 1 2 3 4)))
527 (setf (cdr (last a)) a)
528 (should (not (ert--proper-list-p a))))
529 (let ((a (list 1 2)))
530 (setf (cdr (last a)) (cdr a))
531 (should (not (ert--proper-list-p a))))
532 (let ((a (list 1 2 3)))
533 (setf (cdr (last a)) (cdr a))
534 (should (not (ert--proper-list-p a))))
535 (let ((a (list 1 2 3 4)))
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)) (cddr a))
540 (should (not (ert--proper-list-p a))))
541 (let ((a (list 1 2 3 4)))
542 (setf (cdr (last a)) (cddr a))
543 (should (not (ert--proper-list-p a))))
544 (let ((a (list 1 2 3 4)))
19dc7206 Stefan Monnier2012-11-19 12:24:12 -0500545 (setf (cdr (last a)) (cl-cdddr a))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100546 (should (not (ert--proper-list-p a)))))
547
548(ert-deftest ert-test-parse-keys-and-body ()
549 (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo))))
550 (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
551 (should (equal (ert--parse-keys-and-body '(:bar foo a (b)))
552 '((:bar foo) (a (b)))))
553 (should (equal (ert--parse-keys-and-body '(:bar foo :a (b)))
554 '((:bar foo :a (b)) nil)))
555 (should (equal (ert--parse-keys-and-body '(bar foo :a (b)))
556 '(nil (bar foo :a (b)))))
557 (should-error (ert--parse-keys-and-body '(:bar foo :a))))
558
559
560(ert-deftest ert-test-run-tests-interactively ()
561 :tags '(:causes-redisplay)
562 (let ((passing-test (make-ert-test :name 'passing-test
563 :body (lambda () (ert-pass))))
564 (failing-test (make-ert-test :name 'failing-test
565 :body (lambda () (ert-fail
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200566 "failure message"))))
567 (skipped-test (make-ert-test :name 'skipped-test
568 :body (lambda () (ert-skip
569 "skip message")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100570 (let ((ert-debug-on-error nil))
571 (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
572 (messages nil)
573 (mock-message-fn
574 (lambda (format-string &rest args)
575 (push (apply #'format format-string args) messages))))
576 (save-window-excursion
577 (unwind-protect
578 (let ((case-fold-search nil))
579 (ert-run-tests-interactively
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200580 `(member ,passing-test ,failing-test, skipped-test) buffer-name
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100581 mock-message-fn)
582 (should (equal messages `(,(concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200583 "Ran 3 tests, 1 results were "
584 "as expected, 1 unexpected, "
585 "1 skipped"))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100586 (with-current-buffer buffer-name
587 (goto-char (point-min))
588 (should (equal
589 (buffer-substring (point-min)
590 (save-excursion
4ddbf128 Michael Albinus2013-10-24 09:38:45 +0200591 (forward-line 5)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100592 (point)))
593 (concat
4ddbf128
MA
Michael Albinus2013-10-24 09:38:45 +0200594 "Selector: (member <passing-test> <failing-test> "
595 "<skipped-test>)\n"
596 "Passed: 1\n"
597 "Failed: 1 (1 unexpected)\n"
598 "Skipped: 1\n"
599 "Total: 3/3\n")))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100600 (when (get-buffer buffer-name)
601 (kill-buffer buffer-name))))))))
602
603(ert-deftest ert-test-special-operator-p ()
604 (should (ert--special-operator-p 'if))
605 (should-not (ert--special-operator-p 'car))
606 (should-not (ert--special-operator-p 'ert--special-operator-p))
a19b3c2d Glenn Morris2013-07-11 09:13:38 -0700607 (let ((b (cl-gensym)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100608 (should-not (ert--special-operator-p b))
609 (fset b 'if)
610 (should (ert--special-operator-p b))))
611
612(ert-deftest ert-test-list-of-should-forms ()
613 (let ((test (make-ert-test :body (lambda ()
614 (should t)
615 (should (null '()))
616 (should nil)
617 (should t)))))
618 (let ((result (let ((ert-debug-on-error nil))
619 (ert-run-test test))))
620 (should (equal (ert-test-result-should-forms result)
621 '(((should t) :form t :value t)
622 ((should (null '())) :form (null nil) :value t)
623 ((should nil) :form nil :value nil)))))))
624
625(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack ()
626 (let ((test (make-ert-test
627 :body (lambda ()
628 (let ((test2 (make-ert-test
629 :body (lambda ()
630 (should t)))))
631 (let ((result (ert-run-test test2)))
632 (should (ert-test-passed-p result))))))))
633 (let ((result (let ((ert-debug-on-error nil))
634 (ert-run-test test))))
635 (should (ert-test-passed-p result))
636 (should (eql (length (ert-test-result-should-forms result))
637 1)))))
638
639(ert-deftest ert-test-list-of-should-forms-no-deep-copy ()
640 (let ((test (make-ert-test :body (lambda ()
641 (let ((obj (list 'a)))
642 (should (equal obj '(a)))
643 (setf (car obj) 'b)
644 (should (equal obj '(b))))))))
645 (let ((result (let ((ert-debug-on-error nil))
646 (ert-run-test test))))
647 (should (ert-test-passed-p result))
648 (should (equal (ert-test-result-should-forms result)
649 '(((should (equal obj '(a))) :form (equal (b) (a)) :value t
650 :explanation nil)
651 ((should (equal obj '(b))) :form (equal (b) (b)) :value t
652 :explanation nil)
653 ))))))
654
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100655(ert-deftest ert-test-string-first-line ()
656 (should (equal (ert--string-first-line "") ""))
657 (should (equal (ert--string-first-line "abc") "abc"))
658 (should (equal (ert--string-first-line "abc\n") "abc"))
659 (should (equal (ert--string-first-line "foo\nbar") "foo"))
660 (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo")))
661
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700662(ert-deftest ert-test-explain-equal ()
663 (should (equal (ert--explain-equal nil 'foo)
d221e780 Christian Ohler2011-01-13 03:08:24 +1100664 '(different-atoms nil foo)))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700665 (should (equal (ert--explain-equal '(a a) '(a b))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100666 '(list-elt 1 (different-atoms a b))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700667 (should (equal (ert--explain-equal '(1 48) '(1 49))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100668 '(list-elt 1 (different-atoms (48 "#x30" "?0")
669 (49 "#x31" "?1")))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700670 (should (equal (ert--explain-equal 'nil '(a))
d221e780 Christian Ohler2011-01-13 03:08:24 +1100671 '(different-types nil (a))))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700672 (should (equal (ert--explain-equal '(a b c) '(a b c d))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100673 '(proper-lists-of-different-length 3 4 (a b c) (a b c d)
674 first-mismatch-at 3)))
675 (let ((sym (make-symbol "a")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700676 (should (equal (ert--explain-equal 'a sym)
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100677 `(different-symbols-with-the-same-name a ,sym)))))
678
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700679(ert-deftest ert-test-explain-equal-improper-list ()
680 (should (equal (ert--explain-equal '(a . b) '(a . c))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100681 '(cdr (different-atoms b c)))))
682
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700683(ert-deftest ert-test-explain-equal-keymaps ()
684 ;; This used to be very slow.
685 (should (equal (make-keymap) (make-keymap)))
686 (should (equal (make-sparse-keymap) (make-sparse-keymap))))
687
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100688(ert-deftest ert-test-significant-plist-keys ()
689 (should (equal (ert--significant-plist-keys '()) '()))
690 (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t))
691 '(a c e p s))))
692
693(ert-deftest ert-test-plist-difference-explanation ()
694 (should (equal (ert--plist-difference-explanation
695 '(a b c nil) '(a b))
696 nil))
697 (should (equal (ert--plist-difference-explanation
698 '(a b c t) '(a b))
699 '(different-properties-for-key c (different-atoms t nil))))
700 (should (equal (ert--plist-difference-explanation
701 '(a b c t) '(c nil a b))
702 '(different-properties-for-key c (different-atoms t nil))))
703 (should (equal (ert--plist-difference-explanation
704 '(a b c (foo . bar)) '(c (foo . baz) a b))
705 '(different-properties-for-key c
706 (cdr
707 (different-atoms bar baz))))))
708
709(ert-deftest ert-test-abbreviate-string ()
710 (should (equal (ert--abbreviate-string "foo" 4 nil) "foo"))
711 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
712 (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
713 (should (equal (ert--abbreviate-string "foo" 2 nil) "fo"))
714 (should (equal (ert--abbreviate-string "foo" 1 nil) "f"))
715 (should (equal (ert--abbreviate-string "foo" 0 nil) ""))
716 (should (equal (ert--abbreviate-string "bar" 4 t) "bar"))
717 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
718 (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
719 (should (equal (ert--abbreviate-string "bar" 2 t) "ar"))
720 (should (equal (ert--abbreviate-string "bar" 1 t) "r"))
721 (should (equal (ert--abbreviate-string "bar" 0 t) "")))
722
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700723(ert-deftest ert-test-explain-equal-string-properties ()
d221e780 Christian Ohler2011-01-13 03:08:24 +1100724 (should
de69c0a8
CO
Christian Ohler2011-03-03 02:01:51 -0700725 (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
726 "foo")
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100727 '(char 0 "f"
728 (different-properties-for-key a (different-atoms b nil))
729 context-before ""
730 context-after "oo")))
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700731 (should (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100732 #("foo" 1 3 (a b))
733 #("goo" 0 1 (c d)))
734 '(array-elt 0 (different-atoms (?f "#x66" "?f")
735 (?g "#x67" "?g")))))
736 (should
de69c0a8 Christian Ohler2011-03-03 02:01:51 -0700737 (equal (ert--explain-equal-including-properties
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100738 #("foo" 0 1 (a b c d) 1 3 (a b))
739 #("foo" 0 1 (c d a b) 1 2 (a foo)))
740 '(char 1 "o" (different-properties-for-key a (different-atoms b foo))
741 context-before "f" context-after "o"))))
742
743(ert-deftest ert-test-equal-including-properties ()
744 (should (equal-including-properties "foo" "foo"))
745 (should (ert-equal-including-properties "foo" "foo"))
746
747 (should (equal-including-properties #("foo" 0 3 (a b))
748 (propertize "foo" 'a 'b)))
749 (should (ert-equal-including-properties #("foo" 0 3 (a b))
750 (propertize "foo" 'a 'b)))
751
752 (should (equal-including-properties #("foo" 0 3 (a b c d))
753 (propertize "foo" 'a 'b 'c 'd)))
754 (should (ert-equal-including-properties #("foo" 0 3 (a b c d))
755 (propertize "foo" 'a 'b 'c 'd)))
756
757 (should-not (equal-including-properties #("foo" 0 3 (a b c e))
758 (propertize "foo" 'a 'b 'c 'd)))
759 (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e))
760 (propertize "foo" 'a 'b 'c 'd)))
761
762 ;; This is bug 6581.
763 (should-not (equal-including-properties #("foo" 0 3 (a (t)))
764 (propertize "foo" 'a (list t))))
765 (should (ert-equal-including-properties #("foo" 0 3 (a (t)))
766 (propertize "foo" 'a (list t)))))
767
768(ert-deftest ert-test-stats-set-test-and-result ()
769 (let* ((test-1 (make-ert-test :name 'test-1
770 :body (lambda () nil)))
771 (test-2 (make-ert-test :name 'test-2
772 :body (lambda () nil)))
773 (test-3 (make-ert-test :name 'test-2
774 :body (lambda () nil)))
775 (stats (ert--make-stats (list test-1 test-2) 't))
776 (failed (make-ert-test-failed :condition nil
777 :backtrace nil
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100778 :infos nil))
779 (skipped (make-ert-test-skipped :condition nil
780 :backtrace nil
781 :infos nil)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100782 (should (eql 2 (ert-stats-total stats)))
783 (should (eql 0 (ert-stats-completed stats)))
784 (should (eql 0 (ert-stats-completed-expected stats)))
785 (should (eql 0 (ert-stats-completed-unexpected stats)))
1affc48a Michael Albinus2013-10-31 14:31:22 +0100786 (should (eql 0 (ert-stats-skipped stats)))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100787 (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
788 (should (eql 2 (ert-stats-total stats)))
789 (should (eql 1 (ert-stats-completed stats)))
790 (should (eql 1 (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 failed)
794 (should (eql 2 (ert-stats-total stats)))
795 (should (eql 1 (ert-stats-completed stats)))
796 (should (eql 0 (ert-stats-completed-expected stats)))
797 (should (eql 1 (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 nil)
800 (should (eql 2 (ert-stats-total stats)))
801 (should (eql 0 (ert-stats-completed stats)))
802 (should (eql 0 (ert-stats-completed-expected stats)))
803 (should (eql 0 (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-3 failed)
806 (should (eql 2 (ert-stats-total stats)))
807 (should (eql 1 (ert-stats-completed stats)))
808 (should (eql 0 (ert-stats-completed-expected stats)))
809 (should (eql 1 (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 1 test-2 (make-ert-test-passed))
812 (should (eql 2 (ert-stats-total stats)))
813 (should (eql 2 (ert-stats-completed stats)))
814 (should (eql 1 (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 0 test-1 (make-ert-test-passed))
818 (should (eql 2 (ert-stats-total stats)))
819 (should (eql 2 (ert-stats-completed stats)))
820 (should (eql 2 (ert-stats-completed-expected stats)))
1affc48a
MA
Michael Albinus2013-10-31 14:31:22 +0100821 (should (eql 0 (ert-stats-completed-unexpected stats)))
822 (should (eql 0 (ert-stats-skipped stats)))
823 (ert--stats-set-test-and-result stats 0 test-1 skipped)
824 (should (eql 2 (ert-stats-total stats)))
825 (should (eql 2 (ert-stats-completed stats)))
826 (should (eql 1 (ert-stats-completed-expected stats)))
827 (should (eql 0 (ert-stats-completed-unexpected stats)))
828 (should (eql 1 (ert-stats-skipped stats)))))
d221e780
CO
Christian Ohler2011-01-13 03:08:24 +1100829
830
831(provide 'ert-tests)
832
833;;; ert-tests.el ends here
5bca8dfb
GM
Glenn Morris2014-06-25 23:02:52 -0700834
835;; Local Variables:
836;; no-byte-compile: t
837;; End: