diff options
Diffstat (limited to 'test/automated/ert-tests.el')
| -rw-r--r-- | test/automated/ert-tests.el | 843 |
1 files changed, 0 insertions, 843 deletions
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el deleted file mode 100644 index 5d3675553d7..00000000000 --- a/test/automated/ert-tests.el +++ /dev/null @@ -1,843 +0,0 @@ -;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- - -;; Copyright (C) 2007-2008, 2010-2016 Free Software Foundation, Inc. - -;; Author: Christian Ohler <ohler@gnu.org> - -;; This file is part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. - -;;; Commentary: - -;; This file is part of ERT, the Emacs Lisp Regression Testing tool. -;; See ert.el or the texinfo manual for more details. - -;;; Code: - -(require 'cl-lib) -(require 'ert) - -;;; Self-test that doesn't rely on ERT, for bootstrapping. - -;; This is used to test that bodies actually run. -(defvar ert--test-body-was-run) -(ert-deftest ert-test-body-runs () - (setq ert--test-body-was-run t)) - -(defun ert-self-test () - "Run ERT's self-tests and make sure they actually ran." - (let ((window-configuration (current-window-configuration))) - (let ((ert--test-body-was-run nil)) - ;; The buffer name chosen here should not compete with the default - ;; results buffer name for completion in `switch-to-buffer'. - (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) - (cl-assert ert--test-body-was-run) - (if (zerop (ert-stats-completed-unexpected stats)) - ;; Hide results window only when everything went well. - (set-window-configuration window-configuration) - (error "ERT self-test failed")))))) - -(defun ert-self-test-and-exit () - "Run ERT's self-tests and exit Emacs. - -The exit code will be zero if the tests passed, nonzero if they -failed or if there was a problem." - (unwind-protect - (progn - (ert-self-test) - (kill-emacs 0)) - (unwind-protect - (progn - (message "Error running tests") - (backtrace)) - (kill-emacs 1)))) - - -;;; Further tests are defined using ERT. - -(ert-deftest ert-test-nested-test-body-runs () - "Test that nested test bodies run." - (let ((was-run nil)) - (let ((test (make-ert-test :body (lambda () - (setq was-run t))))) - (cl-assert (not was-run)) - (ert-run-test test) - (cl-assert was-run)))) - - -;;; Test that pass/fail works. -(ert-deftest ert-test-pass () - (let ((test (make-ert-test :body (lambda ())))) - (let ((result (ert-run-test test))) - (cl-assert (ert-test-passed-p result))))) - -(ert-deftest ert-test-fail () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (cl-assert (ert-test-failed-p result) t) - (cl-assert (equal (ert-test-result-with-condition-condition result) - '(ert-test-failed "failure message")) - t)))) - -(ert-deftest ert-test-fail-debug-with-condition-case () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) - -(ert-deftest ert-test-fail-debug-with-debugger-1 () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((debugger (lambda (&rest _args) - (cl-assert nil)))) - (let ((ert-debug-on-error nil)) - (ert-run-test test))))) - -(ert-deftest ert-test-fail-debug-with-debugger-2 () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (cl-block nil - (let ((debugger (lambda (&rest _args) - (cl-return-from nil nil)))) - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil))))) - -(ert-deftest ert-test-fail-debug-nested-with-debugger () - (let ((test (make-ert-test :body (lambda () - (let ((ert-debug-on-error t)) - (ert-fail "failure message")))))) - (let ((debugger (lambda (&rest _args) - (cl-assert nil nil "Assertion a")))) - (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (let ((test (make-ert-test :body (lambda () - (let ((ert-debug-on-error nil)) - (ert-fail "failure message")))))) - (cl-block nil - (let ((debugger (lambda (&rest _args) - (cl-return-from nil nil)))) - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil nil "Assertion b"))))) - -(ert-deftest ert-test-error () - (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (cl-assert (ert-test-failed-p result) t) - (cl-assert (equal (ert-test-result-with-condition-condition result) - '(error "Error message")) - t)))) - -(ert-deftest ert-test-error-debug () - (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(error "Error message")) t))))) - - -;;; Test that `should' works. -(ert-deftest ert-test-should () - (let ((test (make-ert-test :body (lambda () (should nil))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (cl-assert (ert-test-failed-p result) t) - (cl-assert (equal (ert-test-result-with-condition-condition result) - '(ert-test-failed ((should nil) :form nil :value nil))) - t))) - (let ((test (make-ert-test :body (lambda () (should t))))) - (let ((result (ert-run-test test))) - (cl-assert (ert-test-passed-p result) t)))) - -(ert-deftest ert-test-should-value () - (should (eql (should 'foo) 'foo)) - (should (eql (should 'bar) 'bar))) - -(ert-deftest ert-test-should-not () - (let ((test (make-ert-test :body (lambda () (should-not t))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (cl-assert (ert-test-failed-p result) t) - (cl-assert (equal (ert-test-result-with-condition-condition result) - '(ert-test-failed ((should-not t) :form t :value t))) - t))) - (let ((test (make-ert-test :body (lambda () (should-not nil))))) - (let ((result (ert-run-test test))) - (cl-assert (ert-test-passed-p result))))) - - -(ert-deftest ert-test-should-with-macrolet () - (let ((test (make-ert-test :body (lambda () - (cl-macrolet ((foo () `(progn t nil))) - (should (foo))))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (should (ert-test-failed-p result)) - (should (equal - (ert-test-result-with-condition-condition result) - '(ert-test-failed ((should (foo)) - :form (progn t nil) - :value nil))))))) - -(ert-deftest ert-test-should-error () - ;; No error. - (let ((test (make-ert-test :body (lambda () (should-error (progn)))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (should (ert-test-failed-p result)) - (should (equal (ert-test-result-with-condition-condition result) - '(ert-test-failed - ((should-error (progn)) - :form (progn) - :value nil - :fail-reason "did not signal an error")))))) - ;; A simple error. - (should (equal (should-error (error "Foo")) - '(error "Foo"))) - ;; Error of unexpected type. - (let ((test (make-ert-test :body (lambda () - (should-error (error "Foo") - :type 'singularity-error))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (should (equal - (ert-test-result-with-condition-condition result) - '(ert-test-failed - ((should-error (error "Foo") :type 'singularity-error) - :form (error "Foo") - :condition (error "Foo") - :fail-reason - "the error signaled did not have the expected type")))))) - ;; Error of the expected type. - (let* ((error nil) - (test (make-ert-test - :body (lambda () - (setq error - (should-error (signal 'singularity-error nil) - :type 'singularity-error)))))) - (let ((result (ert-run-test test))) - (should (ert-test-passed-p result)) - (should (equal error '(singularity-error)))))) - -(ert-deftest ert-test-should-error-subtypes () - (should-error (signal 'singularity-error nil) - :type 'singularity-error - :exclude-subtypes t) - (let ((test (make-ert-test - :body (lambda () - (should-error (signal 'arith-error nil) - :type 'singularity-error))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (should (equal - (ert-test-result-with-condition-condition result) - '(ert-test-failed - ((should-error (signal 'arith-error nil) - :type 'singularity-error) - :form (signal arith-error nil) - :condition (arith-error) - :fail-reason - "the error signaled did not have the expected type")))))) - (let ((test (make-ert-test - :body (lambda () - (should-error (signal 'arith-error nil) - :type 'singularity-error - :exclude-subtypes t))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (should (equal - (ert-test-result-with-condition-condition result) - '(ert-test-failed - ((should-error (signal 'arith-error nil) - :type 'singularity-error - :exclude-subtypes t) - :form (signal arith-error nil) - :condition (arith-error) - :fail-reason - "the error signaled did not have the expected type")))))) - (let ((test (make-ert-test - :body (lambda () - (should-error (signal 'singularity-error nil) - :type 'arith-error - :exclude-subtypes t))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (should (equal - (ert-test-result-with-condition-condition result) - '(ert-test-failed - ((should-error (signal 'singularity-error nil) - :type 'arith-error - :exclude-subtypes t) - :form (signal singularity-error nil) - :condition (singularity-error) - :fail-reason - "the error signaled was a subtype of the expected type"))))) - )) - -(ert-deftest ert-test-skip-unless () - ;; Don't skip. - (let ((test (make-ert-test :body (lambda () (skip-unless t))))) - (let ((result (ert-run-test test))) - (should (ert-test-passed-p result)))) - ;; Skip. - (let ((test (make-ert-test :body (lambda () (skip-unless nil))))) - (let ((result (ert-run-test test))) - (should (ert-test-skipped-p result)))) - ;; Skip in case of error. - (let ((test (make-ert-test :body (lambda () (skip-unless (error "Foo")))))) - (let ((result (ert-run-test test))) - (should (ert-test-skipped-p result))))) - -(defmacro ert--test-my-list (&rest args) - "Don't use this. Instead, call `list' with ARGS, it does the same thing. - -This macro is used to test if macroexpansion in `should' works." - `(list ,@args)) - -(ert-deftest ert-test-should-failure-debugging () - "Test that `should' errors contain the information we expect them to." - (cl-loop - for (body expected-condition) in - `((,(lambda () (let ((x nil)) (should x))) - (ert-test-failed ((should x) :form x :value nil))) - (,(lambda () (let ((x t)) (should-not x))) - (ert-test-failed ((should-not x) :form x :value t))) - (,(lambda () (let ((x t)) (should (not x)))) - (ert-test-failed ((should (not x)) :form (not t) :value nil))) - (,(lambda () (let ((x nil)) (should-not (not x)))) - (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) - (,(lambda () (let ((x t) (y nil)) (should-not - (ert--test-my-list x y)))) - (ert-test-failed - ((should-not (ert--test-my-list x y)) - :form (list t nil) - :value (t nil)))) - (,(lambda () (let ((_x t)) (should (error "Foo")))) - (error "Foo"))) - do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) - -(ert-deftest ert-test-deftest () - ;; FIXME: These tests don't look very good. What is their intent, i.e. what - ;; are they really testing? The precise generated code shouldn't matter, so - ;; we should either test the behavior of the code, or else try to express the - ;; kind of efficiency guarantees we're looking for. - (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) - '(progn - (ert-set-test 'abc - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'abc "foo" - #'(lambda nil) - nil ':passed - '(bar)))) - (setq current-load-list - (cons - '(ert-deftest . abc) - current-load-list)) - 'abc))) - (should (equal (macroexpand '(ert-deftest def () - :expected-result ':passed)) - '(progn - (ert-set-test 'def - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'def nil - #'(lambda nil) - nil ':passed 'nil))) - (setq current-load-list - (cons - '(ert-deftest . def) - current-load-list)) - 'def))) - ;; :documentation keyword is forbidden - (should-error (macroexpand '(ert-deftest ghi () - :documentation "foo")))) - -(ert-deftest ert-test-record-backtrace () - (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (with-temp-buffer - (ert--print-backtrace (ert-test-failed-backtrace result)) - (goto-char (point-min)) - (end-of-line) - (let ((first-line (buffer-substring-no-properties (point-min) (point)))) - (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()"))))))) - -(ert-deftest ert-test-messages () - :tags '(:causes-redisplay) - (let* ((message-string "Test message") - (messages-buffer (get-buffer-create "*Messages*")) - (test (make-ert-test :body (lambda () (message "%s" message-string))))) - (with-current-buffer messages-buffer - (let ((result (ert-run-test test))) - (should (equal (concat message-string "\n") - (ert-test-result-messages result))))))) - -(ert-deftest ert-test-running-tests () - (let ((outer-test (ert-get-test 'ert-test-running-tests))) - (should (equal (ert-running-test) outer-test)) - (let (test1 test2 test3) - (setq test1 (make-ert-test - :name "1" - :body (lambda () - (should (equal (ert-running-test) outer-test)) - (should (equal ert--running-tests - (list test1 test2 test3 - outer-test))))) - test2 (make-ert-test - :name "2" - :body (lambda () - (should (equal (ert-running-test) outer-test)) - (should (equal ert--running-tests - (list test3 test2 outer-test))) - (ert-run-test test1))) - test3 (make-ert-test - :name "3" - :body (lambda () - (should (equal (ert-running-test) outer-test)) - (should (equal ert--running-tests - (list test3 outer-test))) - (ert-run-test test2)))) - (should (ert-test-passed-p (ert-run-test test3)))))) - -(ert-deftest ert-test-test-result-expected-p () - "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'." - ;; passing test - (let ((test (make-ert-test :body (lambda ())))) - (should (ert-test-result-expected-p test (ert-run-test test)))) - ;; unexpected failure - (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))))) - (should-not (ert-test-result-expected-p test (ert-run-test test)))) - ;; expected failure - (let ((test (make-ert-test :body (lambda () (ert-fail "failed")) - :expected-result-type ':failed))) - (should (ert-test-result-expected-p test (ert-run-test test)))) - ;; `not' expected type - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(not :failed)))) - (should (ert-test-result-expected-p test (ert-run-test test)))) - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(not :passed)))) - (should-not (ert-test-result-expected-p test (ert-run-test test)))) - ;; `and' expected type - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(and :passed :failed)))) - (should-not (ert-test-result-expected-p test (ert-run-test test)))) - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(and :passed - (not :failed))))) - (should (ert-test-result-expected-p test (ert-run-test test)))) - ;; `or' expected type - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(or (and :passed :failed) - :passed)))) - (should (ert-test-result-expected-p test (ert-run-test test)))) - (let ((test (make-ert-test :body (lambda ()) - :expected-result-type '(or (and :passed :failed) - nil (not t))))) - (should-not (ert-test-result-expected-p test (ert-run-test test))))) - -;;; Test `ert-select-tests'. -(ert-deftest ert-test-select-regexp () - (should (equal (ert-select-tests "^ert-test-select-regexp$" t) - (list (ert-get-test 'ert-test-select-regexp))))) - -(ert-deftest ert-test-test-boundp () - (should (ert-test-boundp 'ert-test-test-boundp)) - (should-not (ert-test-boundp (make-symbol "ert-not-a-test")))) - -(ert-deftest ert-test-select-member () - (should (equal (ert-select-tests '(member ert-test-select-member) t) - (list (ert-get-test 'ert-test-select-member))))) - -(ert-deftest ert-test-select-test () - (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t) - (list (ert-get-test 'ert-test-select-test))))) - -(ert-deftest ert-test-select-symbol () - (should (equal (ert-select-tests 'ert-test-select-symbol t) - (list (ert-get-test 'ert-test-select-symbol))))) - -(ert-deftest ert-test-select-and () - (let ((test (make-ert-test - :name nil - :body nil - :most-recent-result (make-ert-test-failed - :condition nil - :backtrace nil - :infos nil)))) - (should (equal (ert-select-tests `(and (member ,test) :failed) t) - (list test))))) - -(ert-deftest ert-test-select-tag () - (let ((test (make-ert-test - :name nil - :body nil - :tags '(a b)))) - (should (equal (ert-select-tests `(tag a) (list test)) (list test))) - (should (equal (ert-select-tests `(tag b) (list test)) (list test))) - (should (equal (ert-select-tests `(tag c) (list test)) '())))) - - -;;; Tests for utility functions. -(ert-deftest ert-test-proper-list-p () - (should (ert--proper-list-p '())) - (should (ert--proper-list-p '(1))) - (should (ert--proper-list-p '(1 2))) - (should (ert--proper-list-p '(1 2 3))) - (should (ert--proper-list-p '(1 2 3 4))) - (should (not (ert--proper-list-p 'a))) - (should (not (ert--proper-list-p '(1 . a)))) - (should (not (ert--proper-list-p '(1 2 . a)))) - (should (not (ert--proper-list-p '(1 2 3 . a)))) - (should (not (ert--proper-list-p '(1 2 3 4 . a)))) - (let ((a (list 1))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) a) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cdr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cddr a)) - (should (not (ert--proper-list-p a)))) - (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cl-cdddr a)) - (should (not (ert--proper-list-p a))))) - -(ert-deftest ert-test-parse-keys-and-body () - (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo)))) - (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil))) - (should (equal (ert--parse-keys-and-body '(:bar foo a (b))) - '((:bar foo) (a (b))))) - (should (equal (ert--parse-keys-and-body '(:bar foo :a (b))) - '((:bar foo :a (b)) nil))) - (should (equal (ert--parse-keys-and-body '(bar foo :a (b))) - '(nil (bar foo :a (b))))) - (should-error (ert--parse-keys-and-body '(:bar foo :a)))) - - -(ert-deftest ert-test-run-tests-interactively () - :tags '(:causes-redisplay) - (let ((passing-test (make-ert-test :name 'passing-test - :body (lambda () (ert-pass)))) - (failing-test (make-ert-test :name 'failing-test - :body (lambda () (ert-fail - "failure message")))) - (skipped-test (make-ert-test :name 'skipped-test - :body (lambda () (ert-skip - "skip message"))))) - (let ((ert-debug-on-error nil)) - (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*")) - (messages nil) - (mock-message-fn - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) - (save-window-excursion - (unwind-protect - (let ((case-fold-search nil)) - (ert-run-tests-interactively - `(member ,passing-test ,failing-test, skipped-test) buffer-name - mock-message-fn) - (should (equal messages `(,(concat - "Ran 3 tests, 1 results were " - "as expected, 1 unexpected, " - "1 skipped")))) - (with-current-buffer buffer-name - (goto-char (point-min)) - (should (equal - (buffer-substring (point-min) - (save-excursion - (forward-line 5) - (point))) - (concat - "Selector: (member <passing-test> <failing-test> " - "<skipped-test>)\n" - "Passed: 1\n" - "Failed: 1 (1 unexpected)\n" - "Skipped: 1\n" - "Total: 3/3\n"))))) - (when (get-buffer buffer-name) - (kill-buffer buffer-name)))))))) - -(ert-deftest ert-test-special-operator-p () - (should (ert--special-operator-p 'if)) - (should-not (ert--special-operator-p 'car)) - (should-not (ert--special-operator-p 'ert--special-operator-p)) - (let ((b (cl-gensym))) - (should-not (ert--special-operator-p b)) - (fset b 'if) - (should (ert--special-operator-p b)))) - -(ert-deftest ert-test-list-of-should-forms () - (let ((test (make-ert-test :body (lambda () - (should t) - (should (null '())) - (should nil) - (should t))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (should (equal (ert-test-result-should-forms result) - '(((should t) :form t :value t) - ((should (null '())) :form (null nil) :value t) - ((should nil) :form nil :value nil))))))) - -(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack () - (let ((test (make-ert-test - :body (lambda () - (let ((test2 (make-ert-test - :body (lambda () - (should t))))) - (let ((result (ert-run-test test2))) - (should (ert-test-passed-p result)))))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (should (ert-test-passed-p result)) - (should (eql (length (ert-test-result-should-forms result)) - 1))))) - -(ert-deftest ert-test-list-of-should-forms-no-deep-copy () - (let ((test (make-ert-test :body (lambda () - (let ((obj (list 'a))) - (should (equal obj '(a))) - (setf (car obj) 'b) - (should (equal obj '(b)))))))) - (let ((result (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (should (ert-test-passed-p result)) - (should (equal (ert-test-result-should-forms result) - '(((should (equal obj '(a))) :form (equal (b) (a)) :value t - :explanation nil) - ((should (equal obj '(b))) :form (equal (b) (b)) :value t - :explanation nil) - )))))) - -(ert-deftest ert-test-string-first-line () - (should (equal (ert--string-first-line "") "")) - (should (equal (ert--string-first-line "abc") "abc")) - (should (equal (ert--string-first-line "abc\n") "abc")) - (should (equal (ert--string-first-line "foo\nbar") "foo")) - (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo"))) - -(ert-deftest ert-test-explain-equal () - (should (equal (ert--explain-equal nil 'foo) - '(different-atoms nil foo))) - (should (equal (ert--explain-equal '(a a) '(a b)) - '(list-elt 1 (different-atoms a b)))) - (should (equal (ert--explain-equal '(1 48) '(1 49)) - '(list-elt 1 (different-atoms (48 "#x30" "?0") - (49 "#x31" "?1"))))) - (should (equal (ert--explain-equal 'nil '(a)) - '(different-types nil (a)))) - (should (equal (ert--explain-equal '(a b c) '(a b c d)) - '(proper-lists-of-different-length 3 4 (a b c) (a b c d) - first-mismatch-at 3))) - (let ((sym (make-symbol "a"))) - (should (equal (ert--explain-equal 'a sym) - `(different-symbols-with-the-same-name a ,sym))))) - -(ert-deftest ert-test-explain-equal-improper-list () - (should (equal (ert--explain-equal '(a . b) '(a . c)) - '(cdr (different-atoms b c))))) - -(ert-deftest ert-test-explain-equal-keymaps () - ;; This used to be very slow. - (should (equal (make-keymap) (make-keymap))) - (should (equal (make-sparse-keymap) (make-sparse-keymap)))) - -(ert-deftest ert-test-significant-plist-keys () - (should (equal (ert--significant-plist-keys '()) '())) - (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t)) - '(a c e p s)))) - -(ert-deftest ert-test-plist-difference-explanation () - (should (equal (ert--plist-difference-explanation - '(a b c nil) '(a b)) - nil)) - (should (equal (ert--plist-difference-explanation - '(a b c t) '(a b)) - '(different-properties-for-key c (different-atoms t nil)))) - (should (equal (ert--plist-difference-explanation - '(a b c t) '(c nil a b)) - '(different-properties-for-key c (different-atoms t nil)))) - (should (equal (ert--plist-difference-explanation - '(a b c (foo . bar)) '(c (foo . baz) a b)) - '(different-properties-for-key c - (cdr - (different-atoms bar baz)))))) - -(ert-deftest ert-test-abbreviate-string () - (should (equal (ert--abbreviate-string "foo" 4 nil) "foo")) - (should (equal (ert--abbreviate-string "foo" 3 nil) "foo")) - (should (equal (ert--abbreviate-string "foo" 3 nil) "foo")) - (should (equal (ert--abbreviate-string "foo" 2 nil) "fo")) - (should (equal (ert--abbreviate-string "foo" 1 nil) "f")) - (should (equal (ert--abbreviate-string "foo" 0 nil) "")) - (should (equal (ert--abbreviate-string "bar" 4 t) "bar")) - (should (equal (ert--abbreviate-string "bar" 3 t) "bar")) - (should (equal (ert--abbreviate-string "bar" 3 t) "bar")) - (should (equal (ert--abbreviate-string "bar" 2 t) "ar")) - (should (equal (ert--abbreviate-string "bar" 1 t) "r")) - (should (equal (ert--abbreviate-string "bar" 0 t) ""))) - -(ert-deftest ert-test-explain-equal-string-properties () - (should - (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b)) - "foo") - '(char 0 "f" - (different-properties-for-key a (different-atoms b nil)) - context-before "" - context-after "oo"))) - (should (equal (ert--explain-equal-including-properties - #("foo" 1 3 (a b)) - #("goo" 0 1 (c d))) - '(array-elt 0 (different-atoms (?f "#x66" "?f") - (?g "#x67" "?g"))))) - (should - (equal (ert--explain-equal-including-properties - #("foo" 0 1 (a b c d) 1 3 (a b)) - #("foo" 0 1 (c d a b) 1 2 (a foo))) - '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) - context-before "f" context-after "o")))) - -(ert-deftest ert-test-equal-including-properties () - (should (equal-including-properties "foo" "foo")) - (should (ert-equal-including-properties "foo" "foo")) - - (should (equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - (should (ert-equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - - (should (equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - - (should-not (equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - - ;; This is bug 6581. - (should-not (equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t)))) - (should (ert-equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t))))) - -(ert-deftest ert-test-stats-set-test-and-result () - (let* ((test-1 (make-ert-test :name 'test-1 - :body (lambda () nil))) - (test-2 (make-ert-test :name 'test-2 - :body (lambda () nil))) - (test-3 (make-ert-test :name 'test-2 - :body (lambda () nil))) - (stats (ert--make-stats (list test-1 test-2) 't)) - (failed (make-ert-test-failed :condition nil - :backtrace nil - :infos nil)) - (skipped (make-ert-test-skipped :condition nil - :backtrace nil - :infos nil))) - (should (eql 2 (ert-stats-total stats))) - (should (eql 0 (ert-stats-completed stats))) - (should (eql 0 (ert-stats-completed-expected stats))) - (should (eql 0 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed)) - (should (eql 2 (ert-stats-total stats))) - (should (eql 1 (ert-stats-completed stats))) - (should (eql 1 (ert-stats-completed-expected stats))) - (should (eql 0 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-1 failed) - (should (eql 2 (ert-stats-total stats))) - (should (eql 1 (ert-stats-completed stats))) - (should (eql 0 (ert-stats-completed-expected stats))) - (should (eql 1 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-1 nil) - (should (eql 2 (ert-stats-total stats))) - (should (eql 0 (ert-stats-completed stats))) - (should (eql 0 (ert-stats-completed-expected stats))) - (should (eql 0 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-3 failed) - (should (eql 2 (ert-stats-total stats))) - (should (eql 1 (ert-stats-completed stats))) - (should (eql 0 (ert-stats-completed-expected stats))) - (should (eql 1 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 1 test-2 (make-ert-test-passed)) - (should (eql 2 (ert-stats-total stats))) - (should (eql 2 (ert-stats-completed stats))) - (should (eql 1 (ert-stats-completed-expected stats))) - (should (eql 1 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed)) - (should (eql 2 (ert-stats-total stats))) - (should (eql 2 (ert-stats-completed stats))) - (should (eql 2 (ert-stats-completed-expected stats))) - (should (eql 0 (ert-stats-completed-unexpected stats))) - (should (eql 0 (ert-stats-skipped stats))) - (ert--stats-set-test-and-result stats 0 test-1 skipped) - (should (eql 2 (ert-stats-total stats))) - (should (eql 2 (ert-stats-completed stats))) - (should (eql 1 (ert-stats-completed-expected stats))) - (should (eql 0 (ert-stats-completed-unexpected stats))) - (should (eql 1 (ert-stats-skipped stats))))) - - -(provide 'ert-tests) - -;;; ert-tests.el ends here - -;; Local Variables: -;; no-byte-compile: t -;; End: |