Add `save-mark-and-excursion', which has the old `save-excursion' behavior
[emacs.git] / test / automated / ert-tests.el
blob181df8956f3240b00f4a6074b7423de5d193fe46
1 ;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
3 ;; Copyright (C) 2007-2008, 2010-2015 Free Software Foundation, Inc.
5 ;; Author: Christian Ohler <ohler@gnu.org>
7 ;; This file is part of GNU Emacs.
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/'.
22 ;;; Commentary:
24 ;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
25 ;; See ert.el or the texinfo manual for more details.
27 ;;; Code:
29 (require 'cl-lib)
30 (require 'ert)
32 ;;; Self-test that doesn't rely on ERT, for bootstrapping.
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))
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*")))
46 (cl-assert ert--test-body-was-run)
47 (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"))))))
52 (defun ert-self-test-and-exit ()
53 "Run ERT's self-tests and exit Emacs.
55 The exit code will be zero if the tests passed, nonzero if they
56 failed 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))))
68 ;;; Further tests are defined using ERT.
70 (ert-deftest ert-test-nested-test-body-runs ()
71 "Test that nested test bodies run."
72 (let ((was-run nil))
73 (let ((test (make-ert-test :body (lambda ()
74 (setq was-run t)))))
75 (cl-assert (not was-run))
76 (ert-run-test test)
77 (cl-assert was-run))))
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)))
84 (cl-assert (ert-test-passed-p result)))))
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))))
90 (cl-assert (ert-test-failed-p result) t)
91 (cl-assert (equal (ert-test-result-with-condition-condition result)
92 '(ert-test-failed "failure message"))
93 t))))
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))
101 (cl-assert nil))
102 ((error)
103 (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
105 (ert-deftest ert-test-fail-debug-with-debugger-1 ()
106 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
107 (let ((debugger (lambda (&rest _args)
108 (cl-assert nil))))
109 (let ((ert-debug-on-error nil))
110 (ert-run-test test)))))
112 (ert-deftest ert-test-fail-debug-with-debugger-2 ()
113 (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
114 (cl-block nil
115 (let ((debugger (lambda (&rest _args)
116 (cl-return-from nil nil))))
117 (let ((ert-debug-on-error t))
118 (ert-run-test test))
119 (cl-assert nil)))))
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"))))))
125 (let ((debugger (lambda (&rest _args)
126 (cl-assert nil nil "Assertion a"))))
127 (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"))))))
132 (cl-block nil
133 (let ((debugger (lambda (&rest _args)
134 (cl-return-from nil nil))))
135 (let ((ert-debug-on-error t))
136 (ert-run-test test))
137 (cl-assert nil nil "Assertion b")))))
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))))
143 (cl-assert (ert-test-failed-p result) t)
144 (cl-assert (equal (ert-test-result-with-condition-condition result)
145 '(error "Error message"))
146 t))))
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))
154 (cl-assert nil))
155 ((error)
156 (cl-assert (equal condition '(error "Error message")) t)))))
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))))
164 (cl-assert (ert-test-failed-p result) t)
165 (cl-assert (equal (ert-test-result-with-condition-condition result)
166 '(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)))
170 (cl-assert (ert-test-passed-p result) t))))
172 (ert-deftest ert-test-should-value ()
173 (should (eql (should 'foo) 'foo))
174 (should (eql (should 'bar) 'bar)))
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))))
180 (cl-assert (ert-test-failed-p result) t)
181 (cl-assert (equal (ert-test-result-with-condition-condition result)
182 '(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)))
186 (cl-assert (ert-test-passed-p result)))))
189 (ert-deftest ert-test-should-with-macrolet ()
190 (let ((test (make-ert-test :body (lambda ()
191 (cl-macrolet ((foo () `(progn t nil)))
192 (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)))))))
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
230 "the error signaled did not have the expected type"))))))
231 ;; 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))))))
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
260 "the error signaled did not have the expected type"))))))
261 (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
277 "the error signaled did not have the expected type"))))))
278 (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
294 "the error signaled was a subtype of the expected type")))))
295 ))
297 (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)))))
311 (defmacro ert--test-my-list (&rest args)
312 "Don't use this. Instead, call `list' with ARGS, it does the same thing.
314 This macro is used to test if macroexpansion in `should' works."
315 `(list ,@args))
317 (ert-deftest ert-test-should-failure-debugging ()
318 "Test that `should' errors contain the information we expect them to."
319 (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)))))))
347 (ert-deftest ert-test-deftest ()
348 (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
349 '(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)))
361 (should (equal (macroexpand '(ert-deftest def ()
362 :expected-result ':passed))
363 '(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)))
374 ;; :documentation keyword is forbidden
375 (should-error (macroexpand '(ert-deftest ghi ()
376 :documentation "foo"))))
378 (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\"))()")))))))
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)))))))
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))))))
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)))))
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)))))
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"))))
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)))))
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)))))
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)))))
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)))))
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)) '()))))
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)))
545 (setf (cdr (last a)) (cl-cdddr a))
546 (should (not (ert--proper-list-p a)))))
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))))
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
566 "failure message"))))
567 (skipped-test (make-ert-test :name 'skipped-test
568 :body (lambda () (ert-skip
569 "skip message")))))
570 (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
580 `(member ,passing-test ,failing-test, skipped-test) buffer-name
581 mock-message-fn)
582 (should (equal messages `(,(concat
583 "Ran 3 tests, 1 results were "
584 "as expected, 1 unexpected, "
585 "1 skipped"))))
586 (with-current-buffer buffer-name
587 (goto-char (point-min))
588 (should (equal
589 (buffer-substring (point-min)
590 (save-excursion
591 (forward-line 5)
592 (point)))
593 (concat
594 "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")))))
600 (when (get-buffer buffer-name)
601 (kill-buffer buffer-name))))))))
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))
607 (let ((b (cl-gensym)))
608 (should-not (ert--special-operator-p b))
609 (fset b 'if)
610 (should (ert--special-operator-p b))))
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)))))))
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)))))
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 ))))))
655 (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")))
662 (ert-deftest ert-test-explain-equal ()
663 (should (equal (ert--explain-equal nil 'foo)
664 '(different-atoms nil foo)))
665 (should (equal (ert--explain-equal '(a a) '(a b))
666 '(list-elt 1 (different-atoms a b))))
667 (should (equal (ert--explain-equal '(1 48) '(1 49))
668 '(list-elt 1 (different-atoms (48 "#x30" "?0")
669 (49 "#x31" "?1")))))
670 (should (equal (ert--explain-equal 'nil '(a))
671 '(different-types nil (a))))
672 (should (equal (ert--explain-equal '(a b c) '(a b c d))
673 '(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")))
676 (should (equal (ert--explain-equal 'a sym)
677 `(different-symbols-with-the-same-name a ,sym)))))
679 (ert-deftest ert-test-explain-equal-improper-list ()
680 (should (equal (ert--explain-equal '(a . b) '(a . c))
681 '(cdr (different-atoms b c)))))
683 (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))))
688 (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))))
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))))))
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) "")))
723 (ert-deftest ert-test-explain-equal-string-properties ()
724 (should
725 (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
726 "foo")
727 '(char 0 "f"
728 (different-properties-for-key a (different-atoms b nil))
729 context-before ""
730 context-after "oo")))
731 (should (equal (ert--explain-equal-including-properties
732 #("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
737 (equal (ert--explain-equal-including-properties
738 #("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"))))
743 (ert-deftest ert-test-equal-including-properties ()
744 (should (equal-including-properties "foo" "foo"))
745 (should (ert-equal-including-properties "foo" "foo"))
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)))
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)))
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)))
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)))))
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
778 :infos nil))
779 (skipped (make-ert-test-skipped :condition nil
780 :backtrace nil
781 :infos nil)))
782 (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)))
786 (should (eql 0 (ert-stats-skipped stats)))
787 (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)))
792 (should (eql 0 (ert-stats-skipped stats)))
793 (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)))
798 (should (eql 0 (ert-stats-skipped stats)))
799 (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)))
804 (should (eql 0 (ert-stats-skipped stats)))
805 (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)))
810 (should (eql 0 (ert-stats-skipped stats)))
811 (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)))
816 (should (eql 0 (ert-stats-skipped stats)))
817 (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)))
821 (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)))))
831 (provide 'ert-tests)
833 ;;; ert-tests.el ends here
835 ;; Local Variables:
836 ;; no-byte-compile: t
837 ;; End: