* term.c (tty_send_additional_strings): No need to fflush here,
[emacs.git] / test / automated / ert-tests.el
1 ;;; ert-tests.el --- ERT's self-tests  -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2007-2008, 2010-2014 Free Software Foundation, Inc.
4
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
29 (require 'cl-lib)
30 (require 'ert)
31
32 ;;; 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*")))
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"))))))
51
52 (defun ert-self-test-and-exit ()
53   "Run ERT's self-tests and exit Emacs.
54
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))))
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."
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))))
78
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)))
84       (cl-assert (ert-test-passed-p result)))))
85
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))))
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))
101           (cl-assert nil))
102       ((error)
103        (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
104
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)))))
111
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)))))
120
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")))))
138
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))))
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))
154           (cl-assert nil))
155       ((error)
156        (cl-assert (equal condition '(error "Error message")) t)))))
157
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))))
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))))
171
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))))
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)))))
187
188
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)))))))
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
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))))))
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
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     ))
296
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)))))
310
311 (defmacro ert--test-my-list (&rest args)
312   "Don't use this.  Instead, call `list' with ARGS, it does the same thing.
313
314 This 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."
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)))))))
346
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"))))
377
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\"))()")))))))
388
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)))
545     (setf (cdr (last a)) (cl-cdddr a))
546     (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
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))))))))
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))
607   (let ((b (cl-gensym)))
608     (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
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")))
661
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)))))
678
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)))))
682
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))))
687
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))))
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
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"))))
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
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)))))
829
830
831 (provide 'ert-tests)
832
833 ;;; ert-tests.el ends here