diff options
author | Phillip Lord <phillip.lord@russet.org.uk> | 2015-11-23 22:02:42 +0000 |
---|---|---|
committer | Phillip Lord <phillip.lord@russet.org.uk> | 2015-11-24 17:04:22 +0000 |
commit | 22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e (patch) | |
tree | 779ff7e07667194416e01c6a6e8bd7b970244c70 /test/lisp/emacs-lisp/ert-tests.el | |
parent | c378d6c33f751d1a0b97958f3cacfe0b07c72f58 (diff) | |
download | emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.tar.gz |
Rename all test files to reflect source layout.
* CONTRIBUTE,Makefile.in,configure.ac: Update to reflect
test directory moves.
* test/file-organisation.org: New file.
* test/automated/Makefile.in
test/automated/data/decompress/foo.gz
test/automated/data/epg/pubkey.asc
test/automated/data/epg/seckey.asc
test/automated/data/files-bug18141.el.gz
test/automated/data/flymake/test.c
test/automated/data/flymake/test.pl
test/automated/data/package/archive-contents
test/automated/data/package/key.pub
test/automated/data/package/key.sec
test/automated/data/package/multi-file-0.2.3.tar
test/automated/data/package/multi-file-readme.txt
test/automated/data/package/newer-versions/archive-contents
test/automated/data/package/newer-versions/new-pkg-1.0.el
test/automated/data/package/newer-versions/simple-single-1.4.el
test/automated/data/package/package-test-server.py
test/automated/data/package/signed/archive-contents
test/automated/data/package/signed/archive-contents.sig
test/automated/data/package/signed/signed-bad-1.0.el
test/automated/data/package/signed/signed-bad-1.0.el.sig
test/automated/data/package/signed/signed-good-1.0.el
test/automated/data/package/signed/signed-good-1.0.el.sig
test/automated/data/package/simple-depend-1.0.el
test/automated/data/package/simple-single-1.3.el
test/automated/data/package/simple-single-readme.txt
test/automated/data/package/simple-two-depend-1.1.el
test/automated/abbrev-tests.el
test/automated/auto-revert-tests.el
test/automated/calc-tests.el
test/automated/icalendar-tests.el
test/automated/character-fold-tests.el
test/automated/comint-testsuite.el
test/automated/descr-text-test.el
test/automated/electric-tests.el
test/automated/cl-generic-tests.el
test/automated/cl-lib-tests.el
test/automated/eieio-test-methodinvoke.el
test/automated/eieio-test-persist.el
test/automated/eieio-tests.el
test/automated/ert-tests.el
test/automated/ert-x-tests.el
test/automated/generator-tests.el
test/automated/let-alist.el
test/automated/map-tests.el
test/automated/advice-tests.el
test/automated/package-test.el
test/automated/pcase-tests.el
test/automated/regexp-tests.el
test/automated/seq-tests.el
test/automated/subr-x-tests.el
test/automated/tabulated-list-test.el
test/automated/thunk-tests.el
test/automated/timer-tests.el
test/automated/epg-tests.el
test/automated/eshell.el
test/automated/faces-tests.el
test/automated/file-notify-tests.el
test/automated/auth-source-tests.el
test/automated/gnus-tests.el
test/automated/message-mode-tests.el
test/automated/help-fns.el
test/automated/imenu-test.el
test/automated/info-xref.el
test/automated/mule-util.el
test/automated/isearch-tests.el
test/automated/json-tests.el
test/automated/bytecomp-tests.el
test/automated/coding-tests.el
test/automated/core-elisp-tests.el
test/automated/decoder-tests.el
test/automated/files.el
test/automated/font-parse-tests.el
test/automated/lexbind-tests.el
test/automated/occur-tests.el
test/automated/process-tests.el
test/automated/syntax-tests.el
test/automated/textprop-tests.el
test/automated/undo-tests.el
test/automated/man-tests.el
test/automated/completion-tests.el
test/automated/dbus-tests.el
test/automated/newsticker-tests.el
test/automated/sasl-scram-rfc-tests.el
test/automated/tramp-tests.el
test/automated/obarray-tests.el
test/automated/compile-tests.el
test/automated/elisp-mode-tests.el
test/automated/f90.el
test/automated/flymake-tests.el
test/automated/python-tests.el
test/automated/ruby-mode-tests.el
test/automated/subword-tests.el
test/automated/replace-tests.el
test/automated/simple-test.el
test/automated/sort-tests.el
test/automated/subr-tests.el
test/automated/reftex-tests.el
test/automated/sgml-mode-tests.el
test/automated/tildify-tests.el
test/automated/thingatpt.el
test/automated/url-future-tests.el
test/automated/url-util-tests.el
test/automated/add-log-tests.el
test/automated/vc-bzr.el
test/automated/vc-tests.el
test/automated/xml-parse-tests.el
test/BidiCharacterTest.txt
test/biditest.el
test/cedet/cedet-utests.el
test/cedet/ede-tests.el
test/cedet/semantic-ia-utest.el
test/cedet/semantic-tests.el
test/cedet/semantic-utest-c.el
test/cedet/semantic-utest.el
test/cedet/srecode-tests.el
test/cedet/tests/test.c
test/cedet/tests/test.el
test/cedet/tests/test.make
test/cedet/tests/testdoublens.cpp
test/cedet/tests/testdoublens.hpp
test/cedet/tests/testfriends.cpp
test/cedet/tests/testjavacomp.java
test/cedet/tests/testnsp.cpp
test/cedet/tests/testpolymorph.cpp
test/cedet/tests/testspp.c
test/cedet/tests/testsppcomplete.c
test/cedet/tests/testsppreplace.c
test/cedet/tests/testsppreplaced.c
test/cedet/tests/testsubclass.cpp
test/cedet/tests/testsubclass.hh
test/cedet/tests/testtypedefs.cpp
test/cedet/tests/testvarnames.c
test/etags/CTAGS.good
test/etags/ETAGS.good_1
test/etags/ETAGS.good_2
test/etags/ETAGS.good_3
test/etags/ETAGS.good_4
test/etags/ETAGS.good_5
test/etags/ETAGS.good_6
test/etags/a-src/empty.zz
test/etags/a-src/empty.zz.gz
test/etags/ada-src/2ataspri.adb
test/etags/ada-src/2ataspri.ads
test/etags/ada-src/etags-test-for.ada
test/etags/ada-src/waroquiers.ada
test/etags/c-src/a/b/b.c
test/etags/c-src/abbrev.c
test/etags/c-src/c.c
test/etags/c-src/dostorture.c
test/etags/c-src/emacs/src/gmalloc.c
test/etags/c-src/emacs/src/keyboard.c
test/etags/c-src/emacs/src/lisp.h
test/etags/c-src/emacs/src/regex.h
test/etags/c-src/etags.c
test/etags/c-src/exit.c
test/etags/c-src/exit.strange_suffix
test/etags/c-src/fail.c
test/etags/c-src/getopt.h
test/etags/c-src/h.h
test/etags/c-src/machsyscalls.c
test/etags/c-src/machsyscalls.h
test/etags/c-src/sysdep.h
test/etags/c-src/tab.c
test/etags/c-src/torture.c
test/etags/cp-src/MDiagArray2.h
test/etags/cp-src/Range.h
test/etags/cp-src/burton.cpp
test/etags/cp-src/c.C
test/etags/cp-src/clheir.cpp.gz
test/etags/cp-src/clheir.hpp
test/etags/cp-src/conway.cpp
test/etags/cp-src/conway.hpp
test/etags/cp-src/fail.C
test/etags/cp-src/functions.cpp
test/etags/cp-src/screen.cpp
test/etags/cp-src/screen.hpp
test/etags/cp-src/x.cc
test/etags/el-src/TAGTEST.EL
test/etags/el-src/emacs/lisp/progmodes/etags.el
test/etags/erl-src/gs_dialog.erl
test/etags/f-src/entry.for
test/etags/f-src/entry.strange.gz
test/etags/f-src/entry.strange_suffix
test/etags/forth-src/test-forth.fth
test/etags/html-src/algrthms.html
test/etags/html-src/index.shtml
test/etags/html-src/software.html
test/etags/html-src/softwarelibero.html
test/etags/lua-src/allegro.lua
test/etags/objc-src/PackInsp.h
test/etags/objc-src/PackInsp.m
test/etags/objc-src/Subprocess.h
test/etags/objc-src/Subprocess.m
test/etags/objcpp-src/SimpleCalc.H
test/etags/objcpp-src/SimpleCalc.M
test/etags/pas-src/common.pas
test/etags/perl-src/htlmify-cystic
test/etags/perl-src/kai-test.pl
test/etags/perl-src/yagrip.pl
test/etags/php-src/lce_functions.php
test/etags/php-src/ptest.php
test/etags/php-src/sendmail.php
test/etags/prol-src/natded.prolog
test/etags/prol-src/ordsets.prolog
test/etags/ps-src/rfc1245.ps
test/etags/pyt-src/server.py
test/etags/tex-src/gzip.texi
test/etags/tex-src/nonewline.tex
test/etags/tex-src/testenv.tex
test/etags/tex-src/texinfo.tex
test/etags/y-src/atest.y
test/etags/y-src/cccp.c
test/etags/y-src/cccp.y
test/etags/y-src/parse.c
test/etags/y-src/parse.y
test/indent/css-mode.css
test/indent/js-indent-init-dynamic.js
test/indent/js-indent-init-t.js
test/indent/js-jsx.js
test/indent/js.js
test/indent/latex-mode.tex
test/indent/modula2.mod
test/indent/nxml.xml
test/indent/octave.m
test/indent/pascal.pas
test/indent/perl.perl
test/indent/prolog.prolog
test/indent/ps-mode.ps
test/indent/ruby.rb
test/indent/scheme.scm
test/indent/scss-mode.scss
test/indent/sgml-mode-attribute.html
test/indent/shell.rc
test/indent/shell.sh
test/redisplay-testsuite.el
test/rmailmm.el
test/automated/buffer-tests.el
test/automated/cmds-tests.el
test/automated/data-tests.el
test/automated/finalizer-tests.el
test/automated/fns-tests.el
test/automated/inotify-test.el
test/automated/keymap-tests.el
test/automated/print-tests.el
test/automated/libxml-tests.el
test/automated/zlib-tests.el: Files Moved.
Diffstat (limited to 'test/lisp/emacs-lisp/ert-tests.el')
-rw-r--r-- | test/lisp/emacs-lisp/ert-tests.el | 843 |
1 files changed, 843 insertions, 0 deletions
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el new file mode 100644 index 00000000000..5382c400962 --- /dev/null +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -0,0 +1,843 @@ +;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- + +;; Copyright (C) 2007-2008, 2010-2015 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: |