Merge from mainline.

34 files changed, 5375 insertions, 221 deletions

diff --git a/ChangeLog b/ChangeLog
index 54b6958607e..789d54cfa60 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,4 @@
-2011-01-11  Paul Eggert  <eggert@cs.ucla.edu>
+2011-01-13  Paul Eggert  <eggert@cs.ucla.edu>
 
         * Makefile.in (GNULIB_MODULES): Change ftoastr to dtoastr.
         This avoids building ftoastr and ldtoastr, which aren't needed.  See
@@ -106,6 +106,15 @@
         * make-dist: Also put into the distribution aclocal.m4,
         compile, depcomp, missing, and the files under lib/.
 
+2011-01-13  Christian Ohler  <ohler@gnu.org>
+
+        * Makefile.in (INFO_FILES): Add ERT.
+
+        * Makefile.in (check): Run tests in test/automated.
+
+        * Makefile.in:
+        * configure.in: Add test/automated/Makefile.
+
 2011-01-07  Paul Eggert  <eggert@cs.ucla.edu>
 
         * install-sh, mkinstalldirs, move-if-change: Update from master
diff --git a/Makefile.in b/Makefile.in
index 72e642c79c0..b9237edac88 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -134,7 +134,7 @@ MAN_PAGES=ctags.1 ebrowse.1 emacs.1 emacsclient.1 etags.1 \
 infodir=@infodir@
 INFO_FILES=ada-mode auth autotype calc ccmode cl dbus dired-x ebrowse   \
            ede ediff edt eieio efaq eintr elisp emacs emacs-mime epa erc \
-           eshell eudc flymake forms gnus idlwave info mairix-el        \
+           ert eshell eudc flymake forms gnus idlwave info mairix-el    \
            message mh-e newsticker nxml-mode org pcl-cvs pgg rcirc      \
            reftex remember sasl sc semantic ses sieve smtpmail speedbar \
            tramp url vip viper widget woman
@@ -267,7 +267,7 @@ EMACSFULL = `echo emacs-${version}${EXEEXT} | sed '$(TRANSFORM)'`
 SUBDIR = lib lib-src src lisp
 
 # The subdir makefiles created by config.status.
-SUBDIR_MAKEFILES = lib/Makefile lib-src/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispref/Makefile doc/lispintro/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile leim/Makefile lisp/Makefile
+SUBDIR_MAKEFILES = lib/Makefile lib-src/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispref/Makefile doc/lispintro/Makefile src/Makefile oldXMenu/Makefile lwlib/Makefile leim/Makefile lisp/Makefile test/automated/Makefile
 
 # Subdirectories to install, and where they'll go.
 # lib-src's makefile knows how to install it, so we don't do that here.
@@ -395,7 +395,8 @@ Makefile: config.status $(srcdir)/src/config.in \
           $(srcdir)/oldXMenu/Makefile.in \
           $(srcdir)/lwlib/Makefile.in \
           $(srcdir)/leim/Makefile.in \
-          $(srcdir)/lisp/Makefile.in
+          $(srcdir)/lisp/Makefile.in \
+          $(srcdir)/test/automated/Makefile.in
         ./config.status
 
 config.status: ${srcdir}/configure ${srcdir}/lisp/version.el
@@ -855,7 +856,7 @@ TAGS tags: lib lib-src src
         cd src; $(MAKE) tags
 
 check:
-        @echo "We don't have any tests for GNU Emacs yet."
+        cd test/automated; $(MAKE) check
 
 dist:
         cd ${srcdir}; ./make-dist
diff --git a/configure b/configure
index 49dc050e7bc..9fa20d66244 100755
--- a/configure
+++ b/configure
@@ -17389,7 +17389,7 @@ test "${prefix}" != NONE &&
 test "${exec_prefix}" != NONE &&
   exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'`
 
-ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile"
+ac_config_files="$ac_config_files Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile test/automated/Makefile"
 
 ac_config_commands="$ac_config_commands default"
 
@@ -18174,6 +18174,7 @@ do
     "lwlib/Makefile") CONFIG_FILES="$CONFIG_FILES lwlib/Makefile" ;;
     "lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;;
     "leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;;
+    "test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;;
     "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;;
 
   *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
diff --git a/configure.in b/configure.in
index 20e90faabbf..9fd9719c14e 100644
--- a/configure.in
+++ b/configure.in
@@ -3718,7 +3718,7 @@ dnl the use of force in the `epaths-force' rule in Makefile.in.
 AC_OUTPUT(Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \
         doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \
         doc/lispref/Makefile src/Makefile \
-        lwlib/Makefile lisp/Makefile leim/Makefile, [
+        lwlib/Makefile lisp/Makefile leim/Makefile test/automated/Makefile, [
 
 ### Make the necessary directories, if they don't exist.
 for dir in etc lisp ; do
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index ca43b7e06df..7fc944e523c 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,10 @@
+2011-01-13  Christian Ohler  <ohler@gnu.org>
+
+        * ert.texi: New file.
+
+        * Makefile.in:
+        * makefile.w32-in: Add ert.texi.
+
 2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
 
         * dbus.texi (Receiving Method Calls): New function
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index deeafa2c1b2..7953d0cf596 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -62,6 +62,7 @@ INFO_TARGETS = \
         $(infodir)/emacs-mime \
         $(infodir)/epa \
         $(infodir)/erc \
+        $(infodir)/ert \
         $(infodir)/eshell \
         $(infodir)/eudc \
         $(infodir)/efaq \
@@ -112,6 +113,7 @@ DVI_TARGETS = \
         emacs-mime.dvi \
         epa.dvi \
         erc.dvi \
+        ert.dvi \
         eshell.dvi \
         eudc.dvi \
         faq.dvi \
@@ -162,6 +164,7 @@ PDF_TARGETS = \
         emacs-mime.pdf \
         epa.pdf \
         erc.pdf \
+        ert.pdf \
         eshell.pdf \
         eudc.pdf \
         faq.pdf \
@@ -360,6 +363,14 @@ erc.dvi: ${srcdir}/erc.texi
 erc.pdf: ${srcdir}/erc.texi
         $(ENVADD) $(TEXI2PDF) $<
 
+ert : $(infodir)/ert
+$(infodir)/ert: ert.texi $(infodir)
+        cd $(srcdir); $(MAKEINFO) ert.texi
+ert.dvi: ert.texi
+        $(ENVADD) $(TEXI2DVI) ${srcdir}/ert.texi
+ert.pdf: ert.texi
+        $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi
+
 eshell : $(infodir)/eshell
 $(infodir)/eshell: eshell.texi
         $(mkinfodir)
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
new file mode 100644
index 00000000000..e1a8cdc319c
--- /dev/null
+++ b/doc/misc/ert.texi
@@ -0,0 +1,830 @@
+\input texinfo
+@c %**start of header
+@setfilename ../../info/ert
+@settitle Emacs Lisp Regression Testing
+@c %**end of header
+
+@dircategory Emacs
+@direntry
+* ERT: (ert).        Emacs Lisp Regression Testing.
+@end direntry
+
+@copying
+Copyright @copyright{} 2008, 2010, 2011 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.2 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
+Texts.
+@end quotation
+@end copying
+
+@node Top, Introduction, (dir), (dir)
+@top ERT: Emacs Lisp Regression Testing
+
+ERT is a tool for automated testing in Emacs Lisp.  Its main features
+are facilities for defining tests, running them and reporting the
+results, and for debugging test failures interactively.
+
+ERT is similar to tools for other environments such as JUnit, but has
+unique features that take advantage of the dynamic and interactive
+nature of Emacs.  Despite its name, it works well both for test-driven
+development (see
+@url{http://en.wikipedia.org/wiki/Test-driven_development}) and for
+traditional software development methods.
+
+@menu
+* Introduction::                A simple example of an ERT test.
+* How to Run Tests::            Run tests in your Emacs or from the command line.
+* How to Write Tests::          How to add tests to your Emacs Lisp code.
+* How to Debug Tests::          What to do if a test fails.
+* Extending ERT::               ERT is extensible in several ways.
+* Other Testing Concepts::      Features not in ERT.
+
+@detailmenu
+ --- The Detailed Node Listing ---
+
+How to Run Tests
+
+* Running Tests Interactively::  Run tests in your current Emacs.
+* Running Tests in Batch Mode::  Run tests in emacs -Q.
+* Test Selectors::              Choose which tests to run.
+
+How to Write Tests
+
+* The @code{should} Macro::     A powerful way to express assertions.
+* Expected Failures::           Tests for known bugs.
+* Tests and Their Environment::  Don't depend on customizations; no side effects.
+* Useful Techniques::           Some examples.
+
+How to Debug Tests
+
+* Understanding Explanations::  How ERT gives details on why an assertion failed.
+* Interactive Debugging::       Tools available in the ERT results buffer.
+
+Extending ERT
+
+* Defining Explanation Functions::  Teach ERT about more predicates.
+* Low-Level Functions for Working with Tests::  Use ERT's data for your purposes.
+
+Other Testing Concepts
+
+* Mocks and Stubs::             Stubbing out code that is irrelevant to the test.
+* Fixtures and Test Suites::    How ERT differs from tools for other languages.
+
+@end detailmenu
+@end menu
+
+@node Introduction, How to Run Tests, Top, Top
+@chapter Introduction
+
+ERT allows you to define @emph{tests} in addition to functions,
+macros, variables, and the other usual Lisp constructs.  Tests are
+simply Lisp code --- code that invokes other code and checks whether
+it behaves as expected.
+
+ERT keeps track of the tests that are defined and provides convenient
+commands to run them to verify whether the definitions that are
+currently loaded in Emacs pass the tests.
+
+Some Lisp files have comments like the following (adapted from the
+package @code{pp.el}):
+
+@lisp
+;; (pp-to-string '(quote quote))          ; expected: "'quote"
+;; (pp-to-string '((quote a) (quote b)))  ; expected: "('a 'b)\n"
+;; (pp-to-string '('a 'b))                ; same as above
+@end lisp
+
+The code contained in these comments can be evaluated from time to
+time to compare the output with the expected output.  ERT formalizes
+this and introduces a common convention, which simplifies Emacs
+development, since programmers no longer have to manually find and
+evaluate such comments.
+
+An ERT test definition equivalent to the above comments is this:
+
+@lisp
+(ert-deftest pp-test-quote ()
+  "Tests the rendering of `quote' symbols in `pp-to-string'."
+  (should (equal (pp-to-string '(quote quote)) "'quote"))
+  (should (equal (pp-to-string '((quote a) (quote b))) "('a 'b)\n"))
+  (should (equal (pp-to-string '('a 'b)) "('a 'b)\n")))
+@end lisp
+
+If you know @code{defun}, the syntax of @code{ert-deftest} should look
+familiar: This example defines a test named @code{pp-test-quote} that
+will pass if the three calls to @code{equal} all return true
+(non-nil).
+
+@code{should} is a macro with the same meaning as @code{assert} but
+better error reporting.  @xref{The @code{should} Macro}.
+
+Each test should have a name that describes what functionality the
+test tests.  Test names can be chosen arbitrarily --- they are in a
+namespace separate from functions and variables --- but should follow
+the usual Emacs Lisp convention of having a prefix that indicates
+which package they belong to.  Test names are displayed by ERT when
+reporting failures and can be used when selecting which tests to run.
+
+The empty parentheses @code{()} in the first line don't currently have
+any meaning and are reserved for future extension.  They also make
+@code{ert-deftest}'s syntax more similar to @code{defun}.
+
+The docstring describes what feature this test tests.  When running
+tests interactively, the first line of the docstring is displayed for
+tests that fail, so it is good if the first line makes sense on its
+own.
+
+The body of a test can be arbitrary Lisp code.  It should have as few
+side effects as possible; each test should be written to clean up
+after itself, leaving Emacs in the same state as it was before the
+test.  Tests should clean up even if they fail.  @xref{Tests and Their
+Environment}.
+
+
+@node  How to Run Tests, How to Write Tests, Introduction, Top
+@chapter How to Run Tests
+
+You can run tests either in the Emacs you are working in, or on the
+command line in a separate Emacs process in batch mode (i.e., with no
+user interface).  The former mode is convenient during interactive
+development, the latter is useful to make sure that tests pass
+independently of your customizations, allows tests to be invoked from
+makefiles and scripts to be written that run tests in several
+different Emacs versions.
+
+@menu
+* Running Tests Interactively::  Run tests in your current Emacs.
+* Running Tests in Batch Mode::  Run tests in emacs -Q.
+* Test Selectors::              Choose which tests to run.
+@end menu
+
+
+@node Running Tests Interactively, Running Tests in Batch Mode, How to Run Tests, How to Run Tests
+@section Running Tests Interactively
+
+You can run the tests that are currently defined in your Emacs with
+the command @kbd{@kbd{M-x} ert @kbd{RET} t @kbd{RET}}.  ERT will pop
+up a new buffer, the ERT results buffer, showing the results of the
+tests run.  It looks like this:
+
+@example
+Selector: t
+Passed: 31
+Failed: 2 (2 unexpected)
+Total:  33/33
+
+Started at:   2008-09-11 08:39:25-0700
+Finished.
+Finished at:  2008-09-11 08:39:27-0700
+
+FF...............................
+
+F addition-test
+    (ert-test-failed
+     ((should
+       (=
+        (+ 1 2)
+        4))
+      :form
+      (= 3 4)
+      :value nil))
+
+F list-test
+    (ert-test-failed
+     ((should
+       (equal
+        (list 'a 'b 'c)
+        '(a b d)))
+      :form
+      (equal
+       (a b c)
+       (a b d))
+      :value nil :explanation
+      (list-elt 2
+                (different-atoms c d))))
+@end example
+
+At the top, there is a summary of the results: We ran all tests in the
+current Emacs (@code{Selector: t}), 31 of them passed, and 2 failed
+unexpectedly.  @xref{Expected Failures}, for an explanation of the
+term @emph{unexpected} in this context.
+
+The line of dots and @code{F}s is a progress bar where each character
+represents one test; it fills while the tests are running.  A dot
+means that the test passed, an @code{F} means that it failed.  Below
+the progress bar, ERT shows details about each test that had an
+unexpected result.  In the example above, there are two failures, both
+due to failed @code{should} forms.  @xref{Understanding Explanations},
+for more details.
+
+In the ERT results buffer, @kbd{TAB} and @kbd{S-TAB} cycle between
+buttons.  Each name of a function or macro in this buffer is a button;
+moving point to it and typing @kbd{RET} jumps to its definition.
+
+Pressing @kbd{r} re-runs the test near point on its own.  Pressing
+@kbd{d} re-runs it with the debugger enabled.  @kbd{.} jumps to the
+definition of the test near point (@kbd{RET} has the same effect if
+point is on the name of the test).  On a failed test, @kbd{b} shows
+the backtrace of the failure.
+
+@kbd{l} shows the list of @code{should} forms executed in the test.
+If any messages were generated (with the Lisp function @code{message})
+in a test or any of the code that it invoked, @kbd{m} will show them.
+
+By default, long expressions in the failure details are abbreviated
+using @code{print-length} and @code{print-level}.  Pressing @kbd{L}
+while point is on a test failure will increase the limits to show more
+of the expression.
+
+
+@node Running Tests in Batch Mode, Test Selectors, Running Tests Interactively, How to Run Tests
+@section Running Tests in Batch Mode
+
+ERT supports automated invocations from the command line or from
+scripts or makefiles.  There are two functions for this purpose,
+@code{ert-run-tests-batch} and @code{ert-run-tests-batch-and-exit}.
+They can be used like this:
+
+@example
+emacs -batch -L /path/to/ert -l ert.el -l my-tests.el -f ert-run-tests-batch-and-exit
+@end example
+
+This command will start up Emacs in batch mode, load ERT, load
+@code{my-tests.el}, and run all tests defined in it.  It will exit
+with a zero exit status if all tests passed, or nonzero if any tests
+failed or if anything else went wrong.  It will also print progress
+messages and error diagnostics to standard output.
+
+You may need additional @code{-L} flags to ensure that
+@code{my-tests.el} and all the files that it requires are on your
+@code{load-path}.
+
+
+@node Test Selectors,  , Running Tests in Batch Mode, How to Run Tests
+@section Test Selectors
+
+Functions like @code{ert} accept a @emph{test selector}, a Lisp
+expression specifying a set of tests.  Test selector syntax is similar
+to Common Lisp's type specifier syntax:
+
+@itemize
+@item @code{nil} selects no tests.
+@item @code{t} selects all tests.
+@item @code{:new} selects all tests that have not been run yet.
+@item @code{:failed} and @code{:passed} select tests according to their most recent result.
+@item @code{:expected}, @code{:unexpected} select tests according to their most recent result.
+@item A string selects all tests that have a name that matches the string, a regexp.
+@item A test selects that test.
+@item A symbol selects the test that the symbol names.
+@item @code{(member TESTS...)} selects TESTS, a list of tests or symbols naming tests.
+@item @code{(eql TEST)} selects TEST, a test or a symbol naming a test.
+@item @code{(and SELECTORS...)} selects the tests that match all SELECTORS.
+@item @code{(or SELECTORS...)} selects the tests that match any SELECTOR.
+@item @code{(not SELECTOR)} selects all tests that do not match SELECTOR.
+@item @code{(tag TAG)} selects all tests that have TAG on their tags list.
+@item @code{(satisfies PREDICATE)} Selects all tests that satisfy PREDICATE.
+@end itemize
+
+Selectors that are frequently useful when selecting tests to run
+include @code{t} to run all tests that are currently defined in Emacs,
+@code{"^foo-"} to run all tests in package @code{foo} --- this assumes
+that package @code{foo} uses the prefix @code{foo-} for its test names
+---, result-based selectors such as @code{(or :new :unexpected)} to
+run all tests that have either not run yet or that had an unexpected
+result in the last run, and tag-based selectors such as @code{(not
+(tag :causes-redisplay))} to run all tests that are not tagged
+@code{:causes-redisplay}.
+
+
+@node How to Write Tests, How to Debug Tests, How to Run Tests, Top
+@chapter How to Write Tests
+
+ERT lets you define tests in the same way you define functions.  You
+can type @code{ert-deftest} forms in a buffer and evaluate them there
+with @code{eval-defun} or @code{compile-defun}, or you can save the
+file and load it, optionally byte-compiling it first.
+
+Just like @code{find-function} is only able to find where a function
+was defined if the function was loaded from a file, ERT is only able
+to find where a test was defined if the test was loaded from a file.
+
+
+@menu
+* The @code{should} Macro::     A powerful way to express assertions.
+* Expected Failures::           Tests for known bugs.
+* Tests and Their Environment::  Don't depend on customizations; no side effects.
+* Useful Techniques::           Some examples.
+@end menu
+
+@node The @code{should} Macro, Expected Failures, How to Write Tests, How to Write Tests
+@section The @code{should} Macro
+
+Test bodies can include arbitrary code; but to be useful, they need to
+have checks whether the code being tested (or @emph{code under test})
+does what it is supposed to do.  The macro @code{should} is similar to
+@code{assert} from the cl package, but analyzes its argument form and
+records information that ERT can display to help debugging.
+
+This test definition
+
+@lisp
+(ert-deftest addition-test ()
+  (should (= (+ 1 2) 4)))
+@end lisp
+
+will produce this output when run via @kbd{M-x ert}:
+
+@example
+F addition-test
+    (ert-test-failed
+     ((should
+       (=
+        (+ 1 2)
+        4))
+      :form
+      (= 3 4)
+      :value nil))
+@end example
+
+In this example, @code{should} recorded the fact that (= (+ 1 2) 4)
+reduced to (= 3 4) before it reduced to nil.  When debugging why the
+test failed, it helps to know that the function @code{+} returned 3
+here.  ERT records the return value for any predicate called directly
+within @code{should}.
+
+In addition to @code{should}, ERT provides @code{should-not}, which
+checks that the predicate returns nil, and @code{should-error}, which
+checks that the form called within it signals an error.  An example
+use of @code{should-error}:
+
+@lisp
+(ert-deftest test-divide-by-zero ()
+  (should-error (/ 1 0)
+                :type 'arith-error))
+@end lisp
+
+This checks that dividing one by zero signals an error of type
+@code{arith-error}.  The @code{:type} argument to @code{should-error}
+is optional; if absent, any type of error is accepted.
+@code{should-error} returns an error description of the error that was
+signalled, to allow additional checks to be made.  The error
+description has the format @code{(ERROR-SYMBOL . DATA)}.
+
+There is no @code{should-not-error} macro since tests that signal an
+error fail anyway, so @code{should-not-error} is effectively the
+default.
+
+@xref{Understanding Explanations}, for more details on what
+@code{should} reports.
+
+
+@node Expected Failures, Tests and Their Environment, The @code{should} Macro, How to Write Tests
+@section Expected Failures
+
+Some bugs are complicated to fix or not very important and are left as
+@emph{known bugs}.  If there is a test case that triggers the bug and
+fails, ERT will alert you of this failure every time you run all
+tests.  For known bugs, this alert is a distraction.  The way to
+suppress it is to add @code{:expected-result :failed} to the test
+definition:
+
+@lisp
+(ert-deftest future-bug ()
+  "Test `time-forward' with negative arguments.
+Since this functionality isn't implemented yet, the test is known to fail."
+  :expected-result :failed
+  (time-forward -1))
+@end lisp
+
+ERT will still display a small @code{f} in the progress bar as a
+reminder that there is a known bug, and will count the test as failed,
+but it will be quiet about it otherwise.
+
+An alternative to marking the test as a known failure this way is to
+delete the test.  This is a good idea if there is no intent to fix it,
+i.e., if the behavior that was formerly considered a bug has become an
+accepted feature.
+
+In general, however, it can be useful to keep tests that are known to
+fail.  If someone wants to fix the bug, they will have a very good
+starting point: an automated test case that reproduces the bug.  This
+makes it much easier to fix the bug, demonstrate that it is fixed, and
+prevent future regressions.
+
+ERT displays the same kind of alerts for tests that pass unexpectedly
+that it displays for unexpected failures.  This way, if you make code
+changes that happen to fix a bug that you weren't aware of, you will
+know to remove the @code{:expected-result} clause of that test and
+close the corresponding bug report, if any.
+
+Since @code{:expected-result} evaluates its argument when the test is
+loaded, tests can be marked as known failures only on certain Emacs
+versions, specific architectures, etc.:
+
+@lisp
+(ert-deftest foo ()
+  "A test that is expected to fail on Emacs 23 but succeed elsewhere."
+  :expected-result (if (string-match "GNU Emacs 23[.]" (emacs-version))
+                       :failed
+                     :passed)
+  ...)
+@end lisp
+
+
+@node Tests and Their Environment, Useful Techniques, Expected Failures, How to Write Tests
+@section Tests and Their Environment
+
+The outcome of running a test should not depend on the current state
+of the environment, and each test should leave its environment in the
+same state it found it in.  In particular, a test should not depend on
+any Emacs customization variables or hooks, and if it has to make any
+changes to Emacs' state or state external to Emacs such as the file
+system, it should undo these changes before it returns, regardless of
+whether it passed or failed.
+
+Tests should not depend on the environment because any such
+dependencies can make the test brittle or lead to failures that occur
+only under certain circumstances and are hard to reproduce.  Of
+course, the code under test may have settings that affect its
+behavior.  In that case, it is best to make the test @code{let}-bind
+all such settings variables to set up a specific configuration for the
+duration of the test.  The test can also set up a number of different
+configurations and run the code under test with each.
+
+Tests that have side effects on their environment should restore it to
+its original state because any side effects that persist after the
+test can disrupt the workflow of the programmer running the tests.  If
+the code under test has side effects on Emacs' current state, such as
+on the current buffer or window configuration, the test should create
+a temporary buffer for the code to manipulate (using
+@code{with-temp-buffer}), or save and restore the window configuration
+(using @code{save-window-excursion}), respectively.  For aspects of
+the state that can not be preserved with such macros, cleanup should
+be performed with @code{unwind-protect}, to ensure that the cleanup
+occurs even if the test fails.
+
+An exception to this are messages that the code under test prints with
+@code{message} and similar logging; tests should not bother restoring
+the @code{*Message*} buffer to its original state.
+
+The above guidelines imply that tests should avoid calling highly
+customizable commands such as @code{find-file}, except, of course, if
+such commands are what they want to test.  The exact behavior of
+@code{find-file} depends on many settings such as
+@code{find-file-wildcards}, @code{enable-local-variables}, and
+@code{auto-mode-alist}.  It is difficult to write a meaningful test if
+its behavior can be affected by so many external factors.  Also,
+@code{find-file} has side effects that are hard to predict and thus
+hard to undo: It may create a new buffer or may reuse an existing
+buffer if one is already visiting the requested file; and it runs
+@code{find-file-hook}, which can have arbitrary side effects.
+
+Instead, it is better to use lower-level mechanisms with simple and
+predictable semantics like @code{with-temp-buffer}, @code{insert} or
+@code{insert-file-contents-literally}, and activating the desired mode
+by calling the corresponding function directly --- after binding the
+hook variables to nil.  This avoids the above problems.
+
+
+@node Useful Techniques,  , Tests and Their Environment, How to Write Tests
+@section Useful Techniques when Writing Tests
+
+Testing simple functions that have no side effects and no dependencies
+on their environment is easy.  Such tests often look like this:
+
+@lisp
+(ert-deftest ert-test-mismatch ()
+  (should (eql (ert--mismatch "" "") nil))
+  (should (eql (ert--mismatch "" "a") 0))
+  (should (eql (ert--mismatch "a" "a") nil))
+  (should (eql (ert--mismatch "ab" "a") 1))
+  (should (eql (ert--mismatch "Aa" "aA") 0))
+  (should (eql (ert--mismatch '(a b c) '(a b d)) 2)))
+@end lisp
+
+This test calls the function @code{ert--mismatch} several times with
+various combinations of arguments and compares the return value to the
+expected return value.  (Some programmers prefer @code{(should (eql
+EXPECTED ACTUAL))} over the @code{(should (eql ACTUAL EXPECTED))}
+shown here.  ERT works either way.)
+
+Here's a more complicated test:
+
+@lisp
+(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 "  signal(ert-test-failed (\"foo\"))")))))))
+@end lisp
+
+This test creates a test object using @code{make-ert-test} whose body
+will immediately signal failure.  It then runs that test and asserts
+that it fails.  Then, it creates a temporary buffer and invokes
+@code{ert--print-backtrace} to print the backtrace of the failed test
+to the current buffer.  Finally, it extracts the first line from the
+buffer and asserts that it matches what we expect.  It uses
+@code{buffer-substring-no-properties} and @code{equal} to ignore text
+properties; for a test that takes properties into account,
+@code{buffer-substring} and @code{ert-equal-including-properties}
+could be used instead.
+
+The reason why this test only checks the first line of the backtrace
+is that the remainder of the backtrace is dependent on ERT's internals
+as well as whether the code is running interpreted or compiled.  By
+looking only at the first line, the test checks a useful property
+--- that the backtrace correctly captures the call to @code{signal} that
+results from the call to @code{ert-fail} --- without being brittle.
+
+This example also shows that writing tests is much easier if the code
+under test was structured with testing in mind.
+
+For example, if @code{ert-run-test} accepted only symbols that name
+tests rather than test objects, the test would need a name for the
+failing test, which would have to be a temporary symbol generated with
+@code{make-symbol}, to avoid side effects on Emacs' state.  Choosing
+the right interface for @code{ert-run-tests} allows the test to be
+simpler.
+
+Similarly, if @code{ert--print-backtrace} printed the backtrace to a
+buffer with a fixed name rather than the current buffer, it would be
+much harder for the test to undo the side effect.  Of course, some
+code somewhere needs to pick the buffer name.  But that logic is
+independent of the logic that prints backtraces, and keeping them in
+separate functions allows us to test them independently.
+
+A lot of code that you will encounter in Emacs was not written with
+testing in mind.  Sometimes, the easiest way to write tests for such
+code is to restructure the code slightly to provide better interfaces
+for testing.  Usually, this makes the interfaces easier to use as
+well.
+
+
+@node How to Debug Tests, Extending ERT, How to Write Tests, Top
+@chapter How to Debug Tests
+
+This section describes how to use ERT's features to understand why
+a test failed.
+
+
+@menu
+* Understanding Explanations::  How ERT gives details on why an assertion failed.
+* Interactive Debugging::       Tools available in the ERT results buffer.
+@end menu
+
+
+@node Understanding Explanations, Interactive Debugging, How to Debug Tests, How to Debug Tests
+@section Understanding Explanations
+
+Failed @code{should} forms are reported like this:
+
+@example
+F addition-test
+    (ert-test-failed
+     ((should
+       (=
+        (+ 1 2)
+        4))
+      :form
+      (= 3 4)
+      :value nil))
+@end example
+
+ERT shows what the @code{should} expression looked like and what
+values its subexpressions had: The source code of the assertion was
+@code{(should (= (+ 1 2) 4))}, which applied the function @code{=} to
+the arguments @code{3} and @code{4}, resulting in the value
+@code{nil}.  In this case, the test is wrong; it should expect 3
+rather than 4.
+
+If a predicate like @code{equal} is used with @code{should}, ERT
+provides a so-called @emph{explanation}:
+
+@example
+F list-test
+    (ert-test-failed
+     ((should
+       (equal
+        (list 'a 'b 'c)
+        '(a b d)))
+      :form
+      (equal
+       (a b c)
+       (a b d))
+      :value nil :explanation
+      (list-elt 2
+                (different-atoms c d))))
+@end example
+
+In this case, the function @code{equal} was applied to the arguments
+@code{(a b c)} and @code{(a b d)}.  ERT's explanation shows that
+the item at index 2 differs between the two lists; in one list, it is
+the atom c, in the other, it is the atom d.
+
+In simple examples like the above, the explanation is unnecessary.
+But in cases where the difference is not immediately apparent, it can
+save time:
+
+@example
+F test1
+    (ert-test-failed
+     ((should
+       (equal x y))
+      :form
+      (equal a a)
+      :value nil :explanation
+      (different-symbols-with-the-same-name a a)))
+@end example
+
+ERT only provides explanations for predicates that have an explanation
+function registered.  @xref{Defining Explanation Functions}.
+
+
+@node Interactive Debugging,  , Understanding Explanations, How to Debug Tests
+@section Interactive Debugging
+
+Debugging failed tests works essentially the same way as debugging any
+other problems with Lisp code.  Here are a few tricks specific to
+tests:
+
+@itemize
+@item Re-run the failed test a few times to see if it fails in the same way
+each time.  It's good to find out whether the behavior is
+deterministic before spending any time looking for a cause.  In the
+ERT results buffer, @kbd{r} re-runs the selected test.
+
+@item Use @kbd{.} to jump to the source code of the test to find out what
+exactly it does.  Perhaps the test is broken rather than the code
+under test.
+
+@item If the test contains a series of @code{should} forms and you can't
+tell which one failed, use @kbd{l}, which shows you the list of all
+@code{should} forms executed during the test before it failed.
+
+@item Use @kbd{b} to view the backtrace.  You can also use @kbd{d} to re-run
+the test with debugging enabled, this will enter the debugger and show
+the backtrace as well; but the top few frames shown there will not be
+relevant to you since they are ERT's own debugger hook.  @kbd{b}
+strips them out, so it is more convenient.
+
+@item If the test or the code under testing prints messages using
+@code{message}, use @kbd{m} to see what messages it printed before it
+failed.  This can be useful to figure out how far it got.
+
+@item You can instrument tests for debugging the same way you instrument
+@code{defun}s for debugging --- go to the source code of the test and
+type @kbd{@kbd{C-u} @kbd{C-M-x}}.  Then, go back to the ERT buffer and
+re-run the test with @kbd{r} or @kbd{d}.
+
+@item If you have been editing and rearranging tests, it is possible that
+ERT remembers an old test that you have since renamed or removed ---
+renamings or removals of definitions in the source code leave around a
+stray definition under the old name in the running process, this is a
+common problem in Lisp.  In such a situation, hit @kbd{D} to let ERT
+forget about the obsolete test.
+@end itemize
+
+
+@node Extending ERT, Other Testing Concepts, How to Debug Tests, Top
+@chapter Extending ERT
+
+There are several ways to add functionality to ERT.
+
+@menu
+* Defining Explanation Functions::  Teach ERT about more predicates.
+* Low-Level Functions for Working with Tests::  Use ERT's data for your purposes.
+@end menu
+
+
+@node Defining Explanation Functions, Low-Level Functions for Working with Tests, Extending ERT, Extending ERT
+@section Defining Explanation Functions
+
+The explanation function for a predicate is a function that takes the
+same arguments as the predicate and returns an @emph{explanation}.
+The explanation should explain why the predicate, when invoked with
+the arguments given to the explanation function, returns the value
+that it returns.  The explanation can be any object but should have a
+comprehensible printed representation.  If the return value of the
+predicate needs no explanation for a given list of arguments, the
+explanation function should return nil.
+
+To associate an explanation function with a predicate, add the
+property @code{ert-explainer} to the symbol that names the predicate.
+The value of the property should be the symbol that names the
+explanation function.
+
+
+@node Low-Level Functions for Working with Tests,  , Defining Explanation Functions, Extending ERT
+@section Low-Level Functions for Working with Tests
+
+Both @code{ert-run-tests-interactively} and @code{ert-run-tests-batch}
+are implemented on top of the lower-level test handling code in the
+sections named ``Facilities for running a single test'', ``Test
+selectors'', and ``Facilities for running a whole set of tests''.
+
+If you want to write code that works with ERT tests, you should take a
+look at this lower-level code.  Symbols that start with @code{ert--}
+are internal to ERT, those that start with @code{ert-} but not
+@code{ert--} are meant to be usable by other code.  But there is no
+mature API yet.
+
+Contributions to ERT are welcome.
+
+
+@node Other Testing Concepts,  , Extending ERT, Top
+@chapter Other Testing Concepts
+
+For information on mocks, stubs, fixtures, or test suites, see below.
+
+
+@menu
+* Mocks and Stubs::             Stubbing out code that is irrelevant to the test.
+* Fixtures and Test Suites::    How ERT differs from tools for other languages.
+@end menu
+
+@node Mocks and Stubs, Fixtures and Test Suites, Other Testing Concepts, Other Testing Concepts
+@section Other Tools for Emacs Lisp
+
+Stubbing out functions or using so-called @emph{mocks} can make it
+easier to write tests.  See
+@url{http://en.wikipedia.org/wiki/Mock_object} for an explanation of
+the corresponding concepts in object-oriented languages.
+
+ERT does not have built-in support for mocks or stubs.  The package
+@code{el-mock} (see @url{http://www.emacswiki.org/emacs/el-mock.el})
+offers mocks for Emacs Lisp and can be used in conjunction with ERT.
+
+
+@node Fixtures and Test Suites,  , Mocks and Stubs, Other Testing Concepts
+@section Fixtures and Test Suites
+
+In many ways, ERT is similar to frameworks for other languages like
+SUnit or JUnit.  However, two features commonly found in such
+frameworks are notably absent from ERT: fixtures and test suites.
+
+Fixtures, as used e.g. in SUnit or JUnit, are mainly used to provide
+an environment for a set of tests, and consist of set-up and tear-down
+functions.
+
+While fixtures are a useful syntactic simplification in other
+languages, this does not apply to Lisp, where higher-order functions
+and `unwind-protect' are available.  One way to implement and use a
+fixture in ERT is
+
+@lisp
+(defun my-fixture (body)
+  (unwind-protect
+      (progn [set up]
+             (funcall body))
+    [tear down]))
+
+(ert-deftest my-test ()
+  (my-fixture
+   (lambda ()
+     [test code])))
+@end lisp
+
+(Another way would be a @code{with-my-fixture} macro.)  This solves
+the set-up and tear-down part, and additionally allows any test
+to use any combination of fixtures, so it is more flexible than what
+other tools typically allow.
+
+If the test needs access to the environment the fixture sets up, the
+fixture can be modified to pass arguments to the body.
+
+These are well-known Lisp techniques.  Special syntax for them could
+be added but would provide only a minor simplification.
+
+(If you are interested in such syntax, note that splitting set-up and
+tear-down into separate functions, like *Unit tools usually do, makes
+it impossible to establish dynamic `let' bindings as part of the
+fixture.  So, blindly imitating the way fixtures are implemented in
+other languages would be counter-productive in Lisp.)
+
+The purpose of test suites is to group related tests together.
+
+The most common use of this is to run just the tests for one
+particular module.  Since symbol prefixes are the usual way of
+separating module namespaces in Emacs Lisp, test selectors already
+solve this by allowing regexp matching on test names; e.g., the
+selector "^ert-" selects ERT's self-tests.
+
+Other uses include grouping tests by their expected execution time to
+run quick tests during interactive development and slow tests less
+frequently.  This can be achieved with the @code{:tag} argument to
+@code{ert-deftest} and @code{tag} test selectors.
+
+@bye
+
+@c  LocalWords:  ERT Hagelberg Ohler JUnit namespace docstring ERT's
+@c  LocalWords:  backtrace makefiles workflow backtraces API SUnit
+@c  LocalWords:  subexpressions
diff --git a/doc/misc/makefile.w32-in b/doc/misc/makefile.w32-in
index fd3b1476b55..e5150e3b122 100644
--- a/doc/misc/makefile.w32-in
+++ b/doc/misc/makefile.w32-in
@@ -47,7 +47,8 @@ INFO_TARGETS = $(infodir)/ccmode \
                 $(infodir)/org $(infodir)/url $(infodir)/speedbar \
                 $(infodir)/tramp $(infodir)/ses $(infodir)/smtpmail \
                 $(infodir)/flymake $(infodir)/newsticker $(infodir)/rcirc \
-                $(infodir)/erc $(infodir)/remember $(infodir)/nxml-mode \
+                $(infodir)/erc $(infodir)/ert \
+                $(infodir)/remember $(infodir)/nxml-mode \
                 $(infodir)/epa $(infodir)/mairix-el $(infodir)/sasl \
                 $(infodir)/auth $(infodir)/eieio $(infodir)/ede \
                 $(infodir)/semantic $(infodir)/edt
@@ -58,7 +59,8 @@ DVI_TARGETS = calc.dvi cc-mode.dvi cl.dvi dbus.dvi dired-x.dvi \
                 ada-mode.dvi autotype.dvi idlwave.dvi eudc.dvi ebrowse.dvi \
                 pcl-cvs.dvi woman.dvi eshell.dvi org.dvi url.dvi \
                 speedbar.dvi tramp.dvi ses.dvi smtpmail.dvi flymake.dvi \
-                newsticker.dvi rcirc.dvi erc.dvi remember.dvi nxml-mode.dvi \
+                newsticker.dvi rcirc.dvi erc.dvi ert.dvi \
+                remember.dvi nxml-mode.dvi \
                 epa.dvi mairix-el.dvi sasl.dvi auth.dvi eieio.dvi ede.dvi \
                 semantic.dvi edt.dvi
 INFOSOURCES = info.texi
@@ -305,6 +307,11 @@ $(infodir)/erc: erc.texi
 erc.dvi: erc.texi
         $(ENVADD) $(TEXI2DVI) $(srcdir)/erc.texi
 
+$(infodir)/ert: ert.texi
+        $(MAKEINFO) ert.texi
+ert.dvi: ert.texi
+        $(ENVADD) $(TEXI2DVI) $(srcdir)/ert.texi
+
 $(infodir)/epa: epa.texi
         $(MAKEINFO) epa.texi
 epa.dvi: epa.texi
@@ -362,7 +369,7 @@ clean: mostlyclean
                  $(infodir)/url* $(infodir)/org* \
                  $(infodir)/flymake* $(infodir)/newsticker* \
                  $(infodir)/sieve* $(infodir)/pgg* \
-                 $(infodir)/erc* $(infodir)/rcirc* \
+                 $(infodir)/erc* $(infodir)/ert* $(infodir)/rcirc* \
                  $(infodir)/remember* $(infodir)/nxml-mode* \
                  $(infodir)/epa* $(infodir)/sasl* \
                  $(infodir)/mairix-el* $(infodir)/auth* \
diff --git a/etc/ChangeLog b/etc/ChangeLog
index d690c963fba..d8dd5aa0ae0 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
+2011-01-13  Christian Ohler  <ohler@gnu.org>
+
+        * NEWS: Mention ERT.
+
 2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
 
         * NEWS: Add new function dbus-register-service.
diff --git a/etc/NEWS b/etc/NEWS
index 92d96fd1806..8f707331f81 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -210,6 +210,10 @@ automatically when Emacs starts up.  To disable this, set
 `package-enable-at-startup' to nil.  To change which packages are
 loaded, customize `package-load-list'.
 
+** An Emacs Lisp testing tool is now included.
+Emacs Lisp developers can use this tool to write automated tests for
+their code.  See the ERT info manual for details.
+
 ** Custom Themes
 
 *** `M-x customize-themes' lists Custom themes which can be enabled.
@@ -621,6 +625,11 @@ Notifications API.  It requires D-Bus for communication.
 
 * Incompatible Lisp Changes in Emacs 24.1
 
+** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and
+passes it to the mail user agent function.  This argument specifies an
+action for returning to the caller after finishing with the mail.
+This is currently used by Rmail to delete a mail window.
+
 ** For mouse click input events in the text area, the Y pixel
 coordinate in the POSITION list now counts from the top of the text
 area, excluding any header line.  Previously, it counted from the top
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index 4fe86987d87..cc1e86b3306 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -25,12 +25,12 @@
 (custom-theme-set-faces
  'tsdh-dark
  '(default ((t (:background "gray20" :foreground "white smoke"))))
- '(diff-added ((t (:inherit diff-changed :background "light green"))))
- '(diff-changed ((t (:background "light steel blue"))))
+ '(diff-added ((t (:inherit diff-changed :background "dark green"))))
+ '(diff-changed ((t (:background "midnight blue"))))
  '(diff-indicator-added ((t (:inherit diff-indicator-changed))))
  '(diff-indicator-changed ((t (:weight bold))))
  '(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
- '(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
+ '(diff-removed ((t (:inherit diff-changed :background "dark red"))))
  '(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
  '(hl-line ((t (:background "grey28"))))
  '(message-header-subject ((t (:foreground "SkyBlue"))))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0c3f09e157b..eafb096f499 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,48 @@
+2011-01-13  Kim F. Storm  <storm@cua.dk>
+
+        * ido.el (ido-may-cache-directory): Move "too-big" check later.
+        (ido-next-match, ido-prev-match): Fix stray reordering of matching
+        items when cycling through the matches.
+
+2011-01-13  Tassilo Horn  <tassilo@member.fsf.org>
+
+        * dired-x.el (dired-omit-verbose): New defcustom that allows
+        disabling the omit messages.
+        (dired-omit-expunge): Use it.
+
+2011-01-13  Christian Ohler  <ohler@gnu.org>
+
+        * emacs-lisp/ert.el, emacs-lisp/ert-x.el: New files.
+
+2011-01-13  Chong Yidong  <cyd@stupidchicken.com>
+
+        * font-lock.el (font-lock-verbose): Default to nil.
+
+2011-01-13  Chong Yidong  <cyd@stupidchicken.com>
+
+        * simple.el (sendmail-user-agent-compose): Move to sendmail.el.
+        (compose-mail): New arg RETURN-ACTION.
+        (compose-mail-other-window, compose-mail-other-frame): Likewise.
+
+        * mail/sendmail.el (mail-return-action): New var.
+        (mail-mode): Make it buffer-local.
+        (mail-bury): Obey it.  Move special Rmail window handling to
+        rmail-mail-return.
+        (mail, mail-setup): New arg RETURN-ACTION.
+        (sendmail-user-agent-compose): Move from simple.el.
+
+        * mail/rmail.el (rmail-mail-return): New function.
+        (rmail-start-mail): Pass it to compose-mail.
+
+2011-01-12  Chong Yidong  <cyd@stupidchicken.com>
+
+        * menu-bar.el (menu-bar-custom-menu): Tweak Mule and Customize
+        menus.  Add menu item for customize-themes.
+
+        * cus-theme.el (customize-themes):
+        * emacs-lisp/package.el (package--list-packages): Use
+        switch-to-buffer.
+
 2011-01-11  Johan Bockgård  <bojohan@gnu.org>
 
         * emacs-lisp/unsafep.el (unsafep): Handle backquoted forms.
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index e6e286f00fa..6e94b326e53 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -541,7 +541,7 @@ Do not call this mode function yourself.  It is meant for internal use."
 When called from Lisp, BUFFER should be the buffer to use; if
 omitted, a buffer named *Custom Themes* is used."
   (interactive)
-  (pop-to-buffer (get-buffer-create (or buffer "*Custom Themes*")))
+  (switch-to-buffer (get-buffer-create (or buffer "*Custom Themes*")))
   (let ((inhibit-read-only t))
     (erase-buffer))
   (custom-theme-choose-mode)
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 45fdda71356..a0b3bf38c03 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -189,6 +189,12 @@ files and lock files."
   :type 'regexp
   :group 'dired-x)
 
+(defcustom dired-omit-verbose t
+  "When non-nil, show messages when omitting files.
+When nil, don't show messages."
+  :type 'boolean
+  :group 'dired-x)
+
 (defcustom dired-find-subdir nil           ; t is pretty near to DWIM...
   "If non-nil, Dired always finds a directory in a buffer of its own.
 If nil, Dired finds the directory as a subdirectory in some other buffer
@@ -613,8 +619,9 @@ This functions works by temporarily binding `dired-marker-char' to
                (not dired-omit-size-limit)
                (< (buffer-size) dired-omit-size-limit)
                (progn
-                 (message "Not omitting: directory larger than %d characters."
-                          dired-omit-size-limit)
+                 (when dired-omit-verbose
+                   (message "Not omitting: directory larger than %d characters."
+                            dired-omit-size-limit))
                  (setq dired-omit-mode nil)
                  nil)))
       (let ((omit-re (or regexp (dired-omit-regexp)))
@@ -622,12 +629,14 @@ This functions works by temporarily binding `dired-marker-char' to
             count)
         (or (string= omit-re "")
             (let ((dired-marker-char dired-omit-marker-char))
-              (message "Omitting...")
+              (when dired-omit-verbose (message "Omitting..."))
               (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp)
                   (progn
-                    (setq count (dired-do-kill-lines nil "Omitted %d line%s."))
+                    (setq count (dired-do-kill-lines
+                                 nil
+                                 (if dired-omit-verbose "Omitted %d line%s." "")))
                     (force-mode-line-update))
-                (message "(Nothing to omit)"))))
+                (when dired-omit-verbose (message "(Nothing to omit)")))))
         ;; Try to preserve modified state of buffer.  So `%*' doesn't appear
         ;; in mode-line of omitted buffers.
         (set-buffer-modified-p (and old-modified-p
diff --git a/lisp/dired.el b/lisp/dired.el
index e34340c15df..1f9c78a9db3 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4021,7 +4021,7 @@ true then the type of the file linked to by FILE is printed instead.
 ;;;***
 
 ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el"
-;;;;;;  "27c312d6d5d40d8cb4ef8d62e30d5f4a")
+;;;;;;  "6181a5bcc2b61255676a7a41549b9f40")
 ;;; Generated autoloads from dired-x.el
 
 (autoload 'dired-jump "dired-x" "\
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
new file mode 100644
index 00000000000..bb14b84117a
--- /dev/null
+++ b/lisp/emacs-lisp/ert-x.el
@@ -0,0 +1,290 @@
+;;; ert-x.el --- Staging area for experimental extensions to ERT
+
+;; Copyright (C) 2008, 2010, 2011 Free Software Foundation, Inc.
+
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; 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 includes some extra helper functions to use while writing
+;; automated tests with ERT.  These have been proposed as extensions
+;; to ERT but are not mature yet and likely to change.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+(require 'ert)
+
+
+;;; Test buffers.
+
+(defun ert--text-button (string &rest properties)
+  "Return a string containing STRING as a text button with PROPERTIES.
+
+See `make-text-button'."
+  (with-temp-buffer
+    (insert string)
+    (apply #'make-text-button (point-min) (point-max) properties)
+    (buffer-string)))
+
+(defun ert--format-test-buffer-name (base-name)
+  "Compute a test buffer name based on BASE-NAME.
+
+Helper function for `ert--test-buffers'."
+  (format "*Test buffer (%s)%s*"
+          (or (and (ert-running-test)
+                   (ert-test-name (ert-running-test)))
+              "<anonymous test>")
+          (if base-name
+              (format ": %s" base-name)
+            "")))
+
+(defvar ert--test-buffers (make-hash-table :weakness t)
+  "Table of all test buffers.  Keys are the buffer objects, values are t.
+
+The main use of this table is for `ert-kill-all-test-buffers'.
+Not all buffers in this table are necessarily live, but all live
+test buffers are in this table.")
+
+(define-button-type 'ert--test-buffer-button
+  'action #'ert--test-buffer-button-action
+  'help-echo "mouse-2, RET: Pop to test buffer")
+
+(defun ert--test-buffer-button-action (button)
+  "Pop to the test buffer that BUTTON is associated with."
+  (pop-to-buffer (button-get button 'ert--test-buffer)))
+
+(defun ert--call-with-test-buffer (ert--base-name ert--thunk)
+  "Helper function for `ert-with-test-buffer'.
+
+Create a test buffer with a name based on ERT--BASE-NAME and run
+ERT--THUNK with that buffer as current."
+  (let* ((ert--buffer (generate-new-buffer
+                       (ert--format-test-buffer-name ert--base-name)))
+         (ert--button (ert--text-button (buffer-name ert--buffer)
+                                        :type 'ert--test-buffer-button
+                                        'ert--test-buffer ert--buffer)))
+    (puthash ert--buffer 't ert--test-buffers)
+    ;; We don't use `unwind-protect' here since we want to kill the
+    ;; buffer only on success.
+    (prog1 (with-current-buffer ert--buffer
+             (ert-info (ert--button :prefix "Buffer: ")
+               (funcall ert--thunk)))
+      (kill-buffer ert--buffer)
+      (remhash ert--buffer ert--test-buffers))))
+
+(defmacro* ert-with-test-buffer ((&key ((:name name-form)))
+                                 &body body)
+  "Create a test buffer and run BODY in that buffer.
+
+To be used in ERT tests.  If BODY finishes successfully, the test
+buffer is killed; if there is an error, the test buffer is kept
+around on error for further inspection.  Its name is derived from
+the name of the test and the result of NAME-FORM."
+  (declare (debug ((form) body))
+           (indent 1))
+  `(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
+
+;; We use these `put' forms in addition to the (declare (indent)) in
+;; the defmacro form since the `declare' alone does not lead to
+;; correct indentation before the .el/.elc file is loaded.
+;; Autoloading these `put' forms solves this.
+;;;###autoload
+(progn
+  ;; TODO(ohler): Figure out what these mean and make sure they are correct.
+  (put 'ert-with-test-buffer 'lisp-indent-function 1))
+
+;;;###autoload
+(defun ert-kill-all-test-buffers ()
+  "Kill all test buffers that are still live."
+  (interactive)
+  (let ((count 0))
+    (maphash (lambda (buffer dummy)
+               (when (or (not (buffer-live-p buffer))
+                         (kill-buffer buffer))
+                 (incf count)))
+             ert--test-buffers)
+    (message "%s out of %s test buffers killed"
+             count (hash-table-count ert--test-buffers)))
+  ;; It could be that some test buffers were actually kept alive
+  ;; (e.g., due to `kill-buffer-query-functions').  I'm not sure what
+  ;; to do about this.  For now, let's just forget them.
+  (clrhash ert--test-buffers)
+  nil)
+
+
+;;; Simulate commands.
+
+(defun ert-simulate-command (command)
+  ;; FIXME: add unread-events
+  "Simulate calling COMMAND the way the Emacs command loop would call it.
+
+This effectively executes
+
+  \(apply (car COMMAND) (cdr COMMAND)\)
+
+and returns the same value, but additionally runs hooks like
+`pre-command-hook' and `post-command-hook', and sets variables
+like `this-command' and `last-command'.
+
+COMMAND should be a list where the car is the command symbol and
+the rest are arguments to the command.
+
+NOTE: Since the command is not called by `call-interactively'
+test for `called-interactively' in the command will fail."
+  (assert (listp command) t)
+  (assert (commandp (car command)) t)
+  (assert (not unread-command-events) t)
+  (let (return-value)
+    ;; For the order of things here see command_loop_1 in keyboard.c.
+    ;;
+    ;; The command loop will reset the command-related variables so
+    ;; there is no reason to let-bind them. They are set here,
+    ;; however, to be able to test several commands in a row and how
+    ;; they affect each other.
+    (setq deactivate-mark nil
+          this-original-command (car command)
+          ;; remap through active keymaps
+          this-command (or (command-remapping this-original-command)
+                           this-original-command))
+    (run-hooks 'pre-command-hook)
+    (setq return-value (apply (car command) (cdr command)))
+    (run-hooks 'post-command-hook)
+    (when deferred-action-list
+      (run-hooks 'deferred-action-function))
+    (setq real-last-command (car command)
+          last-command this-command)
+    (when (boundp 'last-repeatable-command)
+      (setq last-repeatable-command real-last-command))
+    (when (and deactivate-mark transient-mark-mode) (deactivate-mark))
+    (assert (not unread-command-events) t)
+    return-value))
+
+(defun ert-run-idle-timers ()
+  "Run all idle timers (from `timer-idle-list')."
+  (dolist (timer (copy-sequence timer-idle-list))
+    (timer-event-handler timer)))
+
+
+;;; Miscellaneous utilities.
+
+(defun ert-filter-string (s &rest regexps)
+  "Return a copy of S with all matches of REGEXPS removed.
+
+Elements of REGEXPS may also be two-element lists \(REGEXP
+SUBEXP\), where SUBEXP is the number of a subexpression in
+REGEXP.  In that case, only that subexpression will be removed
+rather than the entire match."
+  ;; Use a temporary buffer since replace-match copies strings, which
+  ;; would lead to N^2 runtime.
+  (with-temp-buffer
+    (insert s)
+    (dolist (x regexps)
+      (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
+        (goto-char (point-min))
+        (while (re-search-forward regexp nil t)
+          (replace-match "" t t nil subexp))))
+    (buffer-string)))
+
+
+(defun ert-propertized-string (&rest args)
+  "Return a string with properties as specified by ARGS.
+
+ARGS is a list of strings and plists.  The strings in ARGS are
+concatenated to produce an output string.  In the output string,
+each string from ARGS will be have the preceding plist as its
+property list, or no properties if there is no plist before it.
+
+As a simple example,
+
+\(ert-propertized-string \"foo \" '(face italic) \"bar\" \" baz\" nil \
+\" quux\"\)
+
+would return the string \"foo bar baz quux\" where the substring
+\"bar baz\" has a `face' property with the value `italic'.
+
+None of the ARGS are modified, but the return value may share
+structure with the plists in ARGS."
+  (with-temp-buffer
+    (loop with current-plist = nil
+          for x in args do
+          (etypecase x
+            (string (let ((begin (point)))
+                      (insert x)
+                      (set-text-properties begin (point) current-plist)))
+            (list (unless (zerop (mod (length x) 2))
+                    (error "Odd number of args in plist: %S" x))
+                  (setq current-plist x))))
+    (buffer-string)))
+
+
+(defun ert-call-with-buffer-renamed (buffer-name thunk)
+  "Protect the buffer named BUFFER-NAME from side-effects and run THUNK.
+
+Renames the buffer BUFFER-NAME to a new temporary name, creates a
+new buffer named BUFFER-NAME, executes THUNK, kills the new
+buffer, and renames the original buffer back to BUFFER-NAME.
+
+This is useful if THUNK has undesirable side-effects on an Emacs
+buffer with a fixed name such as *Messages*."
+  (lexical-let ((new-buffer-name (generate-new-buffer-name
+                                  (format "%s orig buffer" buffer-name))))
+    (with-current-buffer (get-buffer-create buffer-name)
+      (rename-buffer new-buffer-name))
+    (unwind-protect
+        (progn
+          (get-buffer-create buffer-name)
+          (funcall thunk))
+      (when (get-buffer buffer-name)
+        (kill-buffer buffer-name))
+      (with-current-buffer new-buffer-name
+        (rename-buffer buffer-name)))))
+
+(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body)
+  "Protect the buffer named BUFFER-NAME from side-effects and run BODY.
+
+See `ert-call-with-buffer-renamed' for details."
+  (declare (indent 1))
+  `(ert-call-with-buffer-renamed ,buffer-name-form (lambda () ,@body)))
+
+
+(defun ert-buffer-string-reindented (&optional buffer)
+  "Return the contents of BUFFER after reindentation.
+
+BUFFER defaults to current buffer.  Does not modify BUFFER."
+  (with-current-buffer (or buffer (current-buffer))
+    (let ((clone nil))
+      (unwind-protect
+          (progn
+            ;; `clone-buffer' doesn't work if `buffer-file-name' is non-nil.
+            (let ((buffer-file-name nil))
+              (setq clone (clone-buffer)))
+            (with-current-buffer clone
+              (let ((inhibit-read-only t))
+                (indent-region (point-min) (point-max)))
+              (buffer-string)))
+        (when clone
+          (let ((kill-buffer-query-functions nil))
+            (kill-buffer clone)))))))
+
+
+(provide 'ert-x)
+
+;;; ert-x.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
new file mode 100644
index 00000000000..6e543458df4
--- /dev/null
+++ b/lisp/emacs-lisp/ert.el
@@ -0,0 +1,2544 @@
+;;; ert.el --- Emacs Lisp Regression Testing
+
+;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
+
+;; Author: Christian Ohler <ohler@gnu.org>
+;; Keywords: lisp, tools
+
+;; 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:
+
+;; ERT is a tool for automated testing in Emacs Lisp.  Its main
+;; features are facilities for defining and running test cases and
+;; reporting the results as well as for debugging test failures
+;; interactively.
+;;
+;; The main entry points are `ert-deftest', which is similar to
+;; `defun' but defines a test, and `ert-run-tests-interactively',
+;; which runs tests and offers an interactive interface for inspecting
+;; results and debugging.  There is also
+;; `ert-run-tests-batch-and-exit' for non-interactive use.
+;;
+;; The body of `ert-deftest' forms resembles a function body, but the
+;; additional operators `should', `should-not' and `should-error' are
+;; available.  `should' is similar to cl's `assert', but signals a
+;; different error when its condition is violated that is caught and
+;; processed by ERT.  In addition, it analyzes its argument form and
+;; records information that helps debugging (`assert' tries to do
+;; something similar when its second argument SHOW-ARGS is true, but
+;; `should' is more sophisticated).  For information on `should-not'
+;; and `should-error', see their docstrings.
+;;
+;; See ERT's info manual as well as the docstrings for more details.
+;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
+;; directory, then C-u M-x info ert.info in Emacs to view it.
+;;
+;; To see some examples of tests written in ERT, see its self-tests in
+;; ert-tests.el.  Some of these are tricky due to the bootstrapping
+;; problem of writing tests for a testing tool, others test simple
+;; functions and are straightforward.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+(require 'button)
+(require 'debug)
+(require 'easymenu)
+(require 'ewoc)
+(require 'find-func)
+(require 'help)
+
+
+;;; UI customization options.
+
+(defgroup ert ()
+  "ERT, the Emacs Lisp regression testing tool."
+  :prefix "ert-"
+  :group 'lisp)
+
+(defface ert-test-result-expected '((((class color) (background light))
+                                     :background "green1")
+                                    (((class color) (background dark))
+                                     :background "green3"))
+  "Face used for expected results in the ERT results buffer."
+  :group 'ert)
+
+(defface ert-test-result-unexpected '((((class color) (background light))
+                                       :background "red1")
+                                      (((class color) (background dark))
+                                       :background "red3"))
+  "Face used for unexpected results in the ERT results buffer."
+  :group 'ert)
+
+
+;;; Copies/reimplementations of cl functions.
+
+(defun ert--cl-do-remf (plist tag)
+  "Copy of `cl-do-remf'.  Modify PLIST by removing TAG."
+  (let ((p (cdr plist)))
+    (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
+    (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
+
+(defun ert--remprop (sym tag)
+  "Copy of `cl-remprop'.  Modify SYM's plist by removing TAG."
+  (let ((plist (symbol-plist sym)))
+    (if (and plist (eq tag (car plist)))
+        (progn (setplist sym (cdr (cdr plist))) t)
+      (ert--cl-do-remf plist tag))))
+
+(defun ert--remove-if-not (ert-pred ert-list)
+  "A reimplementation of `remove-if-not'.
+
+ERT-PRED is a predicate, ERT-LIST is the input list."
+  (loop for ert-x in ert-list
+        if (funcall ert-pred ert-x)
+        collect ert-x))
+
+(defun ert--intersection (a b)
+  "A reimplementation of `intersection'.  Intersect the sets A and B.
+
+Elements are compared using `eql'."
+  (loop for x in a
+        if (memql x b)
+        collect x))
+
+(defun ert--set-difference (a b)
+  "A reimplementation of `set-difference'.  Subtract the set B from the set A.
+
+Elements are compared using `eql'."
+  (loop for x in a
+        unless (memql x b)
+        collect x))
+
+(defun ert--set-difference-eq (a b)
+  "A reimplementation of `set-difference'.  Subtract the set B from the set A.
+
+Elements are compared using `eq'."
+  (loop for x in a
+        unless (memq x b)
+        collect x))
+
+(defun ert--union (a b)
+  "A reimplementation of `union'.  Compute the union of the sets A and B.
+
+Elements are compared using `eql'."
+  (append a (ert--set-difference b a)))
+
+(eval-and-compile
+  (defvar ert--gensym-counter 0))
+
+(eval-and-compile
+  (defun ert--gensym (&optional prefix)
+    "Only allows string PREFIX, not compatible with CL."
+    (unless prefix (setq prefix "G"))
+    (make-symbol (format "%s%s"
+                         prefix
+                         (prog1 ert--gensym-counter
+                           (incf ert--gensym-counter))))))
+
+(defun ert--coerce-to-vector (x)
+  "Coerce X to a vector."
+  (when (char-table-p x) (error "Not supported"))
+  (if (vectorp x)
+      x
+    (vconcat x)))
+
+(defun* ert--remove* (x list &key key test)
+  "Does not support all the keywords of remove*."
+  (unless key (setq key #'identity))
+  (unless test (setq test #'eql))
+  (loop for y in list
+        unless (funcall test x (funcall key y))
+        collect y))
+
+(defun ert--string-position (c s)
+  "Return the position of the first occurrence of C in S, or nil if none."
+  (loop for i from 0
+        for x across s
+        when (eql x c) return i))
+
+(defun ert--mismatch (a b)
+  "Return index of first element that differs between A and B.
+
+Like `mismatch'.  Uses `equal' for comparison."
+  (cond ((or (listp a) (listp b))
+         (ert--mismatch (ert--coerce-to-vector a)
+                        (ert--coerce-to-vector b)))
+        ((> (length a) (length b))
+         (ert--mismatch b a))
+        (t
+         (let ((la (length a))
+               (lb (length b)))
+           (assert (arrayp a) t)
+           (assert (arrayp b) t)
+           (assert (<= la lb) t)
+           (loop for i below la
+                 when (not (equal (aref a i) (aref b i))) return i
+                 finally (return (if (/= la lb)
+                                     la
+                                   (assert (equal a b) t)
+                                   nil)))))))
+
+(defun ert--subseq (seq start &optional end)
+  "Return a subsequence of SEQ from START to END."
+  (when (char-table-p seq) (error "Not supported"))
+  (let ((vector (substring (ert--coerce-to-vector seq) start end)))
+    (etypecase seq
+      (vector vector)
+      (string (concat vector))
+      (list (append vector nil))
+      (bool-vector (loop with result = (make-bool-vector (length vector) nil)
+                         for i below (length vector) do
+                         (setf (aref result i) (aref vector i))
+                         finally (return result)))
+      (char-table (assert nil)))))
+
+(defun ert-equal-including-properties (a b)
+  "Return t if A and B have similar structure and contents.
+
+This is like `equal-including-properties' except that it compares
+the property values of text properties structurally (by
+recursing) rather than with `eq'.  Perhaps this is what
+`equal-including-properties' should do in the first place; see
+Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
+  ;; This implementation is inefficient.  Rather than making it
+  ;; efficient, let's hope bug 6581 gets fixed so that we can delete
+  ;; it altogether.
+  (not (ert--explain-not-equal-including-properties a b)))
+
+
+;;; Defining and locating tests.
+
+;; The data structure that represents a test case.
+(defstruct ert-test
+  (name nil)
+  (documentation nil)
+  (body (assert nil))
+  (most-recent-result nil)
+  (expected-result-type ':passed)
+  (tags '()))
+
+(defun ert-test-boundp (symbol)
+  "Return non-nil if SYMBOL names a test."
+  (and (get symbol 'ert--test) t))
+
+(defun ert-get-test (symbol)
+  "If SYMBOL names a test, return that.  Signal an error otherwise."
+  (unless (ert-test-boundp symbol) (error "No test named `%S'" symbol))
+  (get symbol 'ert--test))
+
+(defun ert-set-test (symbol definition)
+  "Make SYMBOL name the test DEFINITION, and return DEFINITION."
+  (when (eq symbol 'nil)
+    ;; We disallow nil since `ert-test-at-point' and related functions
+    ;; want to return a test name, but also need an out-of-band value
+    ;; on failure.  Nil is the most natural out-of-band value; using 0
+    ;; or "" or signalling an error would be too awkward.
+    ;;
+    ;; Note that nil is still a valid value for the `name' slot in
+    ;; ert-test objects.  It designates an anonymous test.
+    (error "Attempt to define a test named nil"))
+  (put symbol 'ert--test definition)
+  definition)
+
+(defun ert-make-test-unbound (symbol)
+  "Make SYMBOL name no test.  Return SYMBOL."
+  (ert--remprop symbol 'ert--test)
+  symbol)
+
+(defun ert--parse-keys-and-body (keys-and-body)
+  "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body.
+
+KEYS-AND-BODY should have the form of a property list, with the
+exception that only keywords are permitted as keys and that the
+tail -- the body -- is a list of forms that does not start with a
+keyword.
+
+Returns a two-element list containing the keys-and-values plist
+and the body."
+  (let ((extracted-key-accu '())
+        (remaining keys-and-body))
+    (while (and (consp remaining) (keywordp (first remaining)))
+      (let ((keyword (pop remaining)))
+        (unless (consp remaining)
+          (error "Value expected after keyword %S in %S"
+                 keyword keys-and-body))
+        (when (assoc keyword extracted-key-accu)
+          (warn "Keyword %S appears more than once in %S" keyword
+                keys-and-body))
+        (push (cons keyword (pop remaining)) extracted-key-accu)))
+    (setq extracted-key-accu (nreverse extracted-key-accu))
+    (list (loop for (key . value) in extracted-key-accu
+                collect key
+                collect value)
+          remaining)))
+
+;;;###autoload
+(defmacro* ert-deftest (name () &body docstring-keys-and-body)
+  "Define NAME (a symbol) as a test.
+
+BODY is evaluated as a `progn' when the test is run.  It should
+signal a condition on failure or just return if the test passes.
+
+`should', `should-not' and `should-error' are useful for
+assertions in BODY.
+
+Use `ert' to run tests interactively.
+
+Tests that are expected to fail can be marked as such
+using :expected-result.  See `ert-test-result-type-p' for a
+description of valid values for RESULT-TYPE.
+
+\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
+\[:tags '(TAG...)] BODY...)"
+  (declare (debug (&define :name test
+                           name sexp [&optional stringp]
+                           [&rest keywordp sexp] def-body))
+           (doc-string 3)
+           (indent 2))
+  (let ((documentation nil)
+        (documentation-supplied-p nil))
+    (when (stringp (first docstring-keys-and-body))
+      (setq documentation (pop docstring-keys-and-body)
+            documentation-supplied-p t))
+    (destructuring-bind ((&key (expected-result nil expected-result-supplied-p)
+                               (tags nil tags-supplied-p))
+                         body)
+        (ert--parse-keys-and-body docstring-keys-and-body)
+      `(progn
+         (ert-set-test ',name
+                       (make-ert-test
+                        :name ',name
+                        ,@(when documentation-supplied-p
+                            `(:documentation ,documentation))
+                        ,@(when expected-result-supplied-p
+                            `(:expected-result-type ,expected-result))
+                        ,@(when tags-supplied-p
+                            `(:tags ,tags))
+                        :body (lambda () ,@body)))
+         ;; This hack allows `symbol-file' to associate `ert-deftest'
+         ;; forms with files, and therefore enables `find-function' to
+         ;; work with tests.  However, it leads to warnings in
+         ;; `unload-feature', which doesn't know how to undefine tests
+         ;; and has no mechanism for extension.
+         (push '(ert-deftest . ,name) current-load-list)
+         ',name))))
+
+;; We use these `put' forms in addition to the (declare (indent)) in
+;; the defmacro form since the `declare' alone does not lead to
+;; correct indentation before the .el/.elc file is loaded.
+;; Autoloading these `put' forms solves this.
+;;;###autoload
+(progn
+  ;; TODO(ohler): Figure out what these mean and make sure they are correct.
+  (put 'ert-deftest 'lisp-indent-function 2)
+  (put 'ert-info 'lisp-indent-function 1))
+
+(defvar ert--find-test-regexp
+  (concat "^\\s-*(ert-deftest"
+          find-function-space-re
+          "%s\\(\\s-\\|$\\)")
+  "The regexp the `find-function' mechanisms use for finding test definitions.")
+
+
+(put 'ert-test-failed 'error-conditions '(error ert-test-failed))
+(put 'ert-test-failed 'error-message "Test failed")
+
+(defun ert-pass ()
+  "Terminate the current test and mark it passed.  Does not return."
+  (throw 'ert--pass nil))
+
+(defun ert-fail (data)
+  "Terminate the current test and mark it failed.  Does not return.
+DATA is displayed to the user and should state the reason of the failure."
+  (signal 'ert-test-failed (list data)))
+
+
+;;; The `should' macros.
+
+(defvar ert--should-execution-observer nil)
+
+(defun ert--signal-should-execution (form-description)
+  "Tell the current `should' form observer (if any) about FORM-DESCRIPTION."
+  (when ert--should-execution-observer
+    (funcall ert--should-execution-observer form-description)))
+
+(defun ert--special-operator-p (thing)
+  "Return non-nil if THING is a symbol naming a special operator."
+  (and (symbolp thing)
+       (let ((definition (indirect-function thing t)))
+         (and (subrp definition)
+              (eql (cdr (subr-arity definition)) 'unevalled)))))
+
+(defun ert--expand-should-1 (whole form inner-expander)
+  "Helper function for the `should' macro and its variants."
+  (let ((form
+         ;; If `cl-macroexpand' isn't bound, the code that we're
+         ;; compiling doesn't depend on cl and thus doesn't need an
+         ;; environment arg for `macroexpand'.
+         (if (fboundp 'cl-macroexpand)
+             ;; Suppress warning about run-time call to cl funtion: we
+             ;; only call it if it's fboundp.
+             (with-no-warnings
+               (cl-macroexpand form (and (boundp 'cl-macro-environment)
+                                         cl-macro-environment)))
+           (macroexpand form))))
+    (cond
+     ((or (atom form) (ert--special-operator-p (car form)))
+      (let ((value (ert--gensym "value-")))
+        `(let ((,value (ert--gensym "ert-form-evaluation-aborted-")))
+           ,(funcall inner-expander
+                     `(setq ,value ,form)
+                     `(list ',whole :form ',form :value ,value)
+                     value)
+           ,value)))
+     (t
+      (let ((fn-name (car form))
+            (arg-forms (cdr form)))
+        (assert (or (symbolp fn-name)
+                    (and (consp fn-name)
+                         (eql (car fn-name) 'lambda)
+                         (listp (cdr fn-name)))))
+        (let ((fn (ert--gensym "fn-"))
+              (args (ert--gensym "args-"))
+              (value (ert--gensym "value-"))
+              (default-value (ert--gensym "ert-form-evaluation-aborted-")))
+          `(let ((,fn (function ,fn-name))
+                 (,args (list ,@arg-forms)))
+             (let ((,value ',default-value))
+               ,(funcall inner-expander
+                         `(setq ,value (apply ,fn ,args))
+                         `(nconc (list ',whole)
+                                 (list :form `(,,fn ,@,args))
+                                 (unless (eql ,value ',default-value)
+                                   (list :value ,value))
+                                 (let ((-explainer-
+                                        (and (symbolp ',fn-name)
+                                             (get ',fn-name 'ert-explainer))))
+                                   (when -explainer-
+                                     (list :explanation
+                                           (apply -explainer- ,args)))))
+                         value)
+               ,value))))))))
+
+(defun ert--expand-should (whole form inner-expander)
+  "Helper function for the `should' macro and its variants.
+
+Analyzes FORM and returns an expression that has the same
+semantics under evaluation but records additional debugging
+information.
+
+INNER-EXPANDER should be a function and is called with two
+arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM
+is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is
+an expression that returns a description of FORM.  INNER-EXPANDER
+should return code that calls INNER-FORM and performs the checks
+and error signalling specific to the particular variant of
+`should'.  The code that INNER-EXPANDER returns must not call
+FORM-DESCRIPTION-FORM before it has called INNER-FORM."
+  (lexical-let ((inner-expander inner-expander))
+    (ert--expand-should-1
+     whole form
+     (lambda (inner-form form-description-form value-var)
+       (let ((form-description (ert--gensym "form-description-")))
+         `(let (,form-description)
+            ,(funcall inner-expander
+                      `(unwind-protect
+                           ,inner-form
+                         (setq ,form-description ,form-description-form)
+                         (ert--signal-should-execution ,form-description))
+                      `,form-description
+                      value-var)))))))
+
+(defmacro* should (form)
+  "Evaluate FORM.  If it returns nil, abort the current test as failed.
+
+Returns the value of FORM."
+  (ert--expand-should `(should ,form) form
+                      (lambda (inner-form form-description-form value-var)
+                        `(unless ,inner-form
+                           (ert-fail ,form-description-form)))))
+
+(defmacro* should-not (form)
+  "Evaluate FORM.  If it returns non-nil, abort the current test as failed.
+
+Returns nil."
+  (ert--expand-should `(should-not ,form) form
+                      (lambda (inner-form form-description-form value-var)
+                        `(unless (not ,inner-form)
+                           (ert-fail ,form-description-form)))))
+
+(defun ert--should-error-handle-error (form-description-fn
+                                       condition type exclude-subtypes)
+  "Helper function for `should-error'.
+
+Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES,
+and aborts the current test as failed if it doesn't."
+  (let ((signalled-conditions (get (car condition) 'error-conditions))
+        (handled-conditions (etypecase type
+                              (list type)
+                              (symbol (list type)))))
+    (assert signalled-conditions)
+    (unless (ert--intersection signalled-conditions handled-conditions)
+      (ert-fail (append
+                 (funcall form-description-fn)
+                 (list
+                  :condition condition
+                  :fail-reason (concat "the error signalled did not"
+                                       " have the expected type")))))
+    (when exclude-subtypes
+      (unless (member (car condition) handled-conditions)
+        (ert-fail (append
+                   (funcall form-description-fn)
+                   (list
+                    :condition condition
+                    :fail-reason (concat "the error signalled was a subtype"
+                                         " of the expected type"))))))))
+
+;; FIXME: The expansion will evaluate the keyword args (if any) in
+;; nonstandard order.
+(defmacro* should-error (form &rest keys &key type exclude-subtypes)
+  "Evaluate FORM and check that it signals an error.
+
+The error signalled needs to match TYPE.  TYPE should be a list
+of condition names.  (It can also be a non-nil symbol, which is
+equivalent to a singleton list containing that symbol.)  If
+EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its
+condition names is an element of TYPE.  If EXCLUDE-SUBTYPES is
+non-nil, the error matches TYPE if it is an element of TYPE.
+
+If the error matches, returns (ERROR-SYMBOL . DATA) from the
+error.  If not, or if no error was signalled, abort the test as
+failed."
+  (unless type (setq type ''error))
+  (ert--expand-should
+   `(should-error ,form ,@keys)
+   form
+   (lambda (inner-form form-description-form value-var)
+     (let ((errorp (ert--gensym "errorp"))
+           (form-description-fn (ert--gensym "form-description-fn-")))
+       `(let ((,errorp nil)
+              (,form-description-fn (lambda () ,form-description-form)))
+          (condition-case -condition-
+              ,inner-form
+            ;; We can't use ,type here because we want to evaluate it.
+            (error
+             (setq ,errorp t)
+             (ert--should-error-handle-error ,form-description-fn
+                                             -condition-
+                                             ,type ,exclude-subtypes)
+             (setq ,value-var -condition-)))
+          (unless ,errorp
+            (ert-fail (append
+                       (funcall ,form-description-fn)
+                       (list
+                        :fail-reason "did not signal an error")))))))))
+
+
+;;; Explanation of `should' failures.
+
+;; TODO(ohler): Rework explanations so that they are displayed in a
+;; similar way to `ert-info' messages; in particular, allow text
+;; buttons in explanations that give more detail or open an ediff
+;; buffer.  Perhaps explanations should be reported through `ert-info'
+;; rather than as part of the condition.
+
+(defun ert--proper-list-p (x)
+  "Return non-nil if X is a proper list, nil otherwise."
+  (loop
+   for firstp = t then nil
+   for fast = x then (cddr fast)
+   for slow = x then (cdr slow) do
+   (when (null fast) (return t))
+   (when (not (consp fast)) (return nil))
+   (when (null (cdr fast)) (return t))
+   (when (not (consp (cdr fast))) (return nil))
+   (when (and (not firstp) (eq fast slow)) (return nil))))
+
+(defun ert--explain-format-atom (x)
+  "Format the atom X for `ert--explain-not-equal'."
+  (typecase x
+    (fixnum (list x (format "#x%x" x) (format "?%c" x)))
+    (t x)))
+
+(defun ert--explain-not-equal (a b)
+  "Explainer function for `equal'.
+
+Returns a programmer-readable explanation of why A and B are not
+`equal', or nil if they are."
+  (if (not (equal (type-of a) (type-of b)))
+      `(different-types ,a ,b)
+    (etypecase a
+      (cons
+       (let ((a-proper-p (ert--proper-list-p a))
+             (b-proper-p (ert--proper-list-p b)))
+         (if (not (eql (not a-proper-p) (not b-proper-p)))
+             `(one-list-proper-one-improper ,a ,b)
+           (if a-proper-p
+               (if (not (equal (length a) (length b)))
+                   `(proper-lists-of-different-length ,(length a) ,(length b)
+                                                      ,a ,b
+                                                      first-mismatch-at
+                                                      ,(ert--mismatch a b))
+                 (loop for i from 0
+                       for ai in a
+                       for bi in b
+                       for xi = (ert--explain-not-equal ai bi)
+                       do (when xi (return `(list-elt ,i ,xi)))
+                       finally (assert (equal a b) t)))
+             (let ((car-x (ert--explain-not-equal (car a) (car b))))
+               (if car-x
+                   `(car ,car-x)
+                 (let ((cdr-x (ert--explain-not-equal (cdr a) (cdr b))))
+                   (if cdr-x
+                       `(cdr ,cdr-x)
+                     (assert (equal a b) t)
+                     nil))))))))
+      (array (if (not (equal (length a) (length b)))
+                 `(arrays-of-different-length ,(length a) ,(length b)
+                                              ,a ,b
+                                              ,@(unless (char-table-p a)
+                                                  `(first-mismatch-at
+                                                    ,(ert--mismatch a b))))
+               (loop for i from 0
+                     for ai across a
+                     for bi across b
+                     for xi = (ert--explain-not-equal ai bi)
+                     do (when xi (return `(array-elt ,i ,xi)))
+                     finally (assert (equal a b) t))))
+      (atom (if (not (equal a b))
+                (if (and (symbolp a) (symbolp b) (string= a b))
+                    `(different-symbols-with-the-same-name ,a ,b)
+                  `(different-atoms ,(ert--explain-format-atom a)
+                                    ,(ert--explain-format-atom b)))
+              nil)))))
+(put 'equal 'ert-explainer 'ert--explain-not-equal)
+
+(defun ert--significant-plist-keys (plist)
+  "Return the keys of PLIST that have non-null values, in order."
+  (assert (zerop (mod (length plist) 2)) t)
+  (loop for (key value . rest) on plist by #'cddr
+        unless (or (null value) (memq key accu)) collect key into accu
+        finally (return accu)))
+
+(defun ert--plist-difference-explanation (a b)
+  "Return a programmer-readable explanation of why A and B are different plists.
+
+Returns nil if they are equivalent, i.e., have the same value for
+each key, where absent values are treated as nil.  The order of
+key/value pairs in each list does not matter."
+  (assert (zerop (mod (length a) 2)) t)
+  (assert (zerop (mod (length b) 2)) t)
+  ;; Normalizing the plists would be another way to do this but it
+  ;; requires a total ordering on all lisp objects (since any object
+  ;; is valid as a text property key).  Perhaps defining such an
+  ;; ordering is useful in other contexts, too, but it's a lot of
+  ;; work, so let's punt on it for now.
+  (let* ((keys-a (ert--significant-plist-keys a))
+         (keys-b (ert--significant-plist-keys b))
+         (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b))
+         (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a)))
+    (flet ((explain-with-key (key)
+             (let ((value-a (plist-get a key))
+                   (value-b (plist-get b key)))
+               (assert (not (equal value-a value-b)) t)
+               `(different-properties-for-key
+                 ,key ,(ert--explain-not-equal-including-properties value-a
+                                                                    value-b)))))
+      (cond (keys-in-a-not-in-b
+             (explain-with-key (first keys-in-a-not-in-b)))
+            (keys-in-b-not-in-a
+             (explain-with-key (first keys-in-b-not-in-a)))
+            (t
+             (loop for key in keys-a
+                   when (not (equal (plist-get a key) (plist-get b key)))
+                   return (explain-with-key key)))))))
+
+(defun ert--abbreviate-string (s len suffixp)
+  "Shorten string S to at most LEN chars.
+
+If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix."
+  (let ((n (length s)))
+    (cond ((< n len)
+           s)
+          (suffixp
+           (substring s (- n len)))
+          (t
+           (substring s 0 len)))))
+
+(defun ert--explain-not-equal-including-properties (a b)
+  "Explainer function for `ert-equal-including-properties'.
+
+Returns a programmer-readable explanation of why A and B are not
+`ert-equal-including-properties', or nil if they are."
+  (if (not (equal a b))
+      (ert--explain-not-equal a b)
+    (assert (stringp a) t)
+    (assert (stringp b) t)
+    (assert (eql (length a) (length b)) t)
+    (loop for i from 0 to (length a)
+          for props-a = (text-properties-at i a)
+          for props-b = (text-properties-at i b)
+          for difference = (ert--plist-difference-explanation props-a props-b)
+          do (when difference
+               (return `(char ,i ,(substring-no-properties a i (1+ i))
+                              ,difference
+                              context-before
+                              ,(ert--abbreviate-string
+                                (substring-no-properties a 0 i)
+                                10 t)
+                              context-after
+                              ,(ert--abbreviate-string
+                                (substring-no-properties a (1+ i))
+                                10 nil))))
+          ;; TODO(ohler): Get `equal-including-properties' fixed in
+          ;; Emacs, delete `ert-equal-including-properties', and
+          ;; re-enable this assertion.
+          ;;finally (assert (equal-including-properties a b) t)
+          )))
+(put 'ert-equal-including-properties
+     'ert-explainer
+     'ert--explain-not-equal-including-properties)
+
+
+;;; Implementation of `ert-info'.
+
+;; TODO(ohler): The name `info' clashes with
+;; `ert--test-execution-info'.  One or both should be renamed.
+(defvar ert--infos '()
+  "The stack of `ert-info' infos that currently apply.
+
+Bound dynamically.  This is a list of (PREFIX . MESSAGE) pairs.")
+
+(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
+                     &body body)
+  "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails.
+
+To be used within ERT tests.  MESSAGE-FORM should evaluate to a
+string that will be displayed together with the test result if
+the test fails.  PREFIX-FORM should evaluate to a string as well
+and is displayed in front of the value of MESSAGE-FORM."
+  (declare (debug ((form &rest [sexp form]) body))
+           (indent 1))
+  `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos)))
+     ,@body))
+
+
+
+;;; Facilities for running a single test.
+
+(defvar ert-debug-on-error nil
+  "Non-nil means enter debugger when a test fails or terminates with an error.")
+
+;; The data structures that represent the result of running a test.
+(defstruct ert-test-result
+  (messages nil)
+  (should-forms nil)
+  )
+(defstruct (ert-test-passed (:include ert-test-result)))
+(defstruct (ert-test-result-with-condition (:include ert-test-result))
+  (condition (assert nil))
+  (backtrace (assert nil))
+  (infos (assert nil)))
+(defstruct (ert-test-quit (:include ert-test-result-with-condition)))
+(defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result)))
+
+
+(defun ert--record-backtrace ()
+  "Record the current backtrace (as a list) and return it."
+  ;; Since the backtrace is stored in the result object, result
+  ;; objects must only be printed with appropriate limits
+  ;; (`print-level' and `print-length') in place.  For interactive
+  ;; use, the cost of ensuring this possibly outweighs the advantage
+  ;; of storing the backtrace for
+  ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
+  ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
+  ;; For batch use, however, printing the backtrace may be useful.
+  (loop
+   ;; 6 is the number of frames our own debugger adds (when
+   ;; compiled; more when interpreted).  FIXME: Need to describe a
+   ;; procedure for determining this constant.
+   for i from 6
+   for frame = (backtrace-frame i)
+   while frame
+   collect frame))
+
+(defun ert--print-backtrace (backtrace)
+  "Format the backtrace BACKTRACE to the current buffer."
+  ;; This is essentially a reimplementation of Fbacktrace
+  ;; (src/eval.c), but for a saved backtrace, not the current one.
+  (let ((print-escape-newlines t)
+        (print-level 8)
+        (print-length 50))
+    (dolist (frame backtrace)
+      (ecase (first frame)
+        ((nil)
+         ;; Special operator.
+         (destructuring-bind (special-operator &rest arg-forms)
+             (cdr frame)
+           (insert
+            (format "  %S\n" (list* special-operator arg-forms)))))
+        ((t)
+         ;; Function call.
+         (destructuring-bind (fn &rest args) (cdr frame)
+           (insert (format "  %S(" fn))
+           (loop for firstp = t then nil
+                 for arg in args do
+                 (unless firstp
+                   (insert " "))
+                 (insert (format "%S" arg)))
+           (insert ")\n")))))))
+
+;; A container for the state of the execution of a single test and
+;; environment data needed during its execution.
+(defstruct ert--test-execution-info
+  (test (assert nil))
+  (result (assert nil))
+  ;; A thunk that may be called when RESULT has been set to its final
+  ;; value and test execution should be terminated.  Should not
+  ;; return.
+  (exit-continuation (assert nil))
+  ;; The binding of `debugger' outside of the execution of the test.
+  next-debugger
+  ;; The binding of `ert-debug-on-error' that is in effect for the
+  ;; execution of the current test.  We store it to avoid being
+  ;; affected by any new bindings the test itself may establish.  (I
+  ;; don't remember whether this feature is important.)
+  ert-debug-on-error)
+
+(defun ert--run-test-debugger (info debugger-args)
+  "During a test run, `debugger' is bound to a closure that calls this function.
+
+This function records failures and errors and either terminates
+the test silently or calls the interactive debugger, as
+appropriate.
+
+INFO is the ert--test-execution-info corresponding to this test
+run.  DEBUGGER-ARGS are the arguments to `debugger'."
+  (destructuring-bind (first-debugger-arg &rest more-debugger-args)
+      debugger-args
+    (ecase first-debugger-arg
+      ((lambda debug t exit nil)
+       (apply (ert--test-execution-info-next-debugger info) debugger-args))
+      (error
+       (let* ((condition (first more-debugger-args))
+              (type (case (car condition)
+                      ((quit) 'quit)
+                      (otherwise 'failed)))
+              (backtrace (ert--record-backtrace))
+              (infos (reverse ert--infos)))
+         (setf (ert--test-execution-info-result info)
+               (ecase type
+                 (quit
+                  (make-ert-test-quit :condition condition
+                                      :backtrace backtrace
+                                      :infos infos))
+                 (failed
+                  (make-ert-test-failed :condition condition
+                                        :backtrace backtrace
+                                        :infos infos))))
+         ;; Work around Emacs' heuristic (in eval.c) for detecting
+         ;; errors in the debugger.
+         (incf num-nonmacro-input-events)
+         ;; FIXME: We should probably implement more fine-grained
+         ;; control a la non-t `debug-on-error' here.
+         (cond
+          ((ert--test-execution-info-ert-debug-on-error info)
+           (apply (ert--test-execution-info-next-debugger info) debugger-args))
+          (t))
+         (funcall (ert--test-execution-info-exit-continuation info)))))))
+
+(defun ert--run-test-internal (ert-test-execution-info)
+  "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO.
+
+This mainly sets up debugger-related bindings."
+  (lexical-let ((info ert-test-execution-info))
+    (setf (ert--test-execution-info-next-debugger info) debugger
+          (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error)
+    (catch 'ert--pass
+      ;; For now, each test gets its own temp buffer and its own
+      ;; window excursion, just to be safe.  If this turns out to be
+      ;; too expensive, we can remove it.
+      (with-temp-buffer
+        (save-window-excursion
+          (let ((debugger (lambda (&rest debugger-args)
+                            (ert--run-test-debugger info debugger-args)))
+                (debug-on-error t)
+                (debug-on-quit t)
+                ;; FIXME: Do we need to store the old binding of this
+                ;; and consider it in `ert--run-test-debugger'?
+                (debug-ignored-errors nil)
+                (ert--infos '()))
+            (funcall (ert-test-body (ert--test-execution-info-test info))))))
+      (ert-pass))
+    (setf (ert--test-execution-info-result info) (make-ert-test-passed)))
+  nil)
+
+(defun ert--force-message-log-buffer-truncation ()
+  "Immediately truncate *Messages* buffer according to `message-log-max'.
+
+This can be useful after reducing the value of `message-log-max'."
+  (with-current-buffer (get-buffer-create "*Messages*")
+    ;; This is a reimplementation of this part of message_dolog() in xdisp.c:
+    ;; if (NATNUMP (Vmessage_log_max))
+    ;;   {
+    ;;     scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
+    ;;                   -XFASTINT (Vmessage_log_max) - 1, 0);
+    ;;     del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0);
+    ;;   }
+    (when (and (integerp message-log-max) (>= message-log-max 0))
+      (let ((begin (point-min))
+            (end (save-excursion
+                   (goto-char (point-max))
+                   (forward-line (- message-log-max))
+                   (point))))
+        (delete-region begin end)))))
+
+(defvar ert--running-tests nil
+  "List of tests that are currently in execution.
+
+This list is empty while no test is running, has one element
+while a test is running, two elements while a test run from
+inside a test is running, etc.  The list is in order of nesting,
+innermost test first.
+
+The elements are of type `ert-test'.")
+
+(defun ert-run-test (ert-test)
+  "Run ERT-TEST.
+
+Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
+  (setf (ert-test-most-recent-result ert-test) nil)
+  (block error
+    (lexical-let ((begin-marker
+                   (with-current-buffer (get-buffer-create "*Messages*")
+                     (set-marker (make-marker) (point-max)))))
+      (unwind-protect
+          (lexical-let ((info (make-ert--test-execution-info
+                               :test ert-test
+                               :result
+                               (make-ert-test-aborted-with-non-local-exit)
+                               :exit-continuation (lambda ()
+                                                    (return-from error nil))))
+                        (should-form-accu (list)))
+            (unwind-protect
+                (let ((ert--should-execution-observer
+                       (lambda (form-description)
+                         (push form-description should-form-accu)))
+                      (message-log-max t)
+                      (ert--running-tests (cons ert-test ert--running-tests)))
+                  (ert--run-test-internal info))
+              (let ((result (ert--test-execution-info-result info)))
+                (setf (ert-test-result-messages result)
+                      (with-current-buffer (get-buffer-create "*Messages*")
+                        (buffer-substring begin-marker (point-max))))
+                (ert--force-message-log-buffer-truncation)
+                (setq should-form-accu (nreverse should-form-accu))
+                (setf (ert-test-result-should-forms result)
+                      should-form-accu)
+                (setf (ert-test-most-recent-result ert-test) result))))
+        (set-marker begin-marker nil))))
+  (ert-test-most-recent-result ert-test))
+
+(defun ert-running-test ()
+  "Return the top-level test currently executing."
+  (car (last ert--running-tests)))
+
+
+;;; Test selectors.
+
+(defun ert-test-result-type-p (result result-type)
+  "Return non-nil if RESULT matches type RESULT-TYPE.
+
+Valid result types:
+
+nil -- Never matches.
+t -- Always matches.
+:failed, :passed -- Matches corresponding results.
+\(and TYPES...\) -- Matches if all TYPES match.
+\(or TYPES...\) -- Matches if some TYPES match.
+\(not TYPE\) -- Matches if TYPE does not match.
+\(satisfies PREDICATE\) -- Matches if PREDICATE returns true when called with
+                           RESULT."
+  ;; It would be easy to add `member' and `eql' types etc., but I
+  ;; haven't bothered yet.
+  (etypecase result-type
+    ((member nil) nil)
+    ((member t) t)
+    ((member :failed) (ert-test-failed-p result))
+    ((member :passed) (ert-test-passed-p result))
+    (cons
+     (destructuring-bind (operator &rest operands) result-type
+       (ecase operator
+         (and
+          (case (length operands)
+            (0 t)
+            (t
+             (and (ert-test-result-type-p result (first operands))
+                  (ert-test-result-type-p result `(and ,@(rest operands)))))))
+         (or
+          (case (length operands)
+            (0 nil)
+            (t
+             (or (ert-test-result-type-p result (first operands))
+                 (ert-test-result-type-p result `(or ,@(rest operands)))))))
+         (not
+          (assert (eql (length operands) 1))
+          (not (ert-test-result-type-p result (first operands))))
+         (satisfies
+          (assert (eql (length operands) 1))
+          (funcall (first operands) result)))))))
+
+(defun ert-test-result-expected-p (test result)
+  "Return non-nil if TEST's expected result type matches RESULT."
+  (ert-test-result-type-p result (ert-test-expected-result-type test)))
+
+(defun ert-select-tests (selector universe)
+  "Return the tests that match SELECTOR.
+
+UNIVERSE specifies the set of tests to select from; it should be
+a list of tests, or t, which refers to all tests named by symbols
+in `obarray'.
+
+Returns the set of tests as a list.
+
+Valid selectors:
+
+nil -- Selects the empty set.
+t -- Selects UNIVERSE.
+:new -- Selects all tests that have not been run yet.
+:failed, :passed -- Select tests according to their most recent result.
+:expected, :unexpected -- Select tests according to their most recent result.
+a string -- Selects all tests that have a name that matches the string,
+            a regexp.
+a test -- Selects that test.
+a symbol -- Selects the test that the symbol names, errors if none.
+\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests.
+\(eql TEST\) -- Selects TEST, a test or a symbol naming a test.
+\(and SELECTORS...\) -- Selects the tests that match all SELECTORS.
+\(or SELECTORS...\) -- Selects the tests that match any SELECTOR.
+\(not SELECTOR\) -- Selects all tests that do not match SELECTOR.
+\(tag TAG) -- Selects all tests that have TAG on their tags list.
+\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE.
+
+Only selectors that require a superset of tests, such
+as (satisfies ...), strings, :new, etc. make use of UNIVERSE.
+Selectors that do not, such as \(member ...\), just return the
+set implied by them without checking whether it is really
+contained in UNIVERSE."
+  ;; This code needs to match the etypecase in
+  ;; `ert-insert-human-readable-selector'.
+  (etypecase selector
+    ((member nil) nil)
+    ((member t) (etypecase universe
+                  (list universe)
+                  ((member t) (ert-select-tests "" universe))))
+    ((member :new) (ert-select-tests
+                    `(satisfies ,(lambda (test)
+                                   (null (ert-test-most-recent-result test))))
+                    universe))
+    ((member :failed) (ert-select-tests
+                       `(satisfies ,(lambda (test)
+                                      (ert-test-result-type-p
+                                       (ert-test-most-recent-result test)
+                                       ':failed)))
+                       universe))
+    ((member :passed) (ert-select-tests
+                       `(satisfies ,(lambda (test)
+                                      (ert-test-result-type-p
+                                       (ert-test-most-recent-result test)
+                                       ':passed)))
+                       universe))
+    ((member :expected) (ert-select-tests
+                         `(satisfies
+                           ,(lambda (test)
+                              (ert-test-result-expected-p
+                               test
+                               (ert-test-most-recent-result test))))
+                         universe))
+    ((member :unexpected) (ert-select-tests `(not :expected) universe))
+    (string
+     (etypecase universe
+       ((member t) (mapcar #'ert-get-test
+                           (apropos-internal selector #'ert-test-boundp)))
+       (list (ert--remove-if-not (lambda (test)
+                                   (and (ert-test-name test)
+                                        (string-match selector
+                                                      (ert-test-name test))))
+                                 universe))))
+    (ert-test (list selector))
+    (symbol
+     (assert (ert-test-boundp selector))
+     (list (ert-get-test selector)))
+    (cons
+     (destructuring-bind (operator &rest operands) selector
+       (ecase operator
+         (member
+          (mapcar (lambda (purported-test)
+                    (etypecase purported-test
+                      (symbol (assert (ert-test-boundp purported-test))
+                              (ert-get-test purported-test))
+                      (ert-test purported-test)))
+                  operands))
+         (eql
+          (assert (eql (length operands) 1))
+          (ert-select-tests `(member ,@operands) universe))
+         (and
+          ;; Do these definitions of AND, NOT and OR satisfy de
+          ;; Morgan's laws?  Should they?
+          (case (length operands)
+            (0 (ert-select-tests 't universe))
+            (t (ert-select-tests `(and ,@(rest operands))
+                                 (ert-select-tests (first operands)
+                                                   universe)))))
+         (not
+          (assert (eql (length operands) 1))
+          (let ((all-tests (ert-select-tests 't universe)))
+            (ert--set-difference all-tests
+                                 (ert-select-tests (first operands)
+                                                   all-tests))))
+         (or
+          (case (length operands)
+            (0 (ert-select-tests 'nil universe))
+            (t (ert--union (ert-select-tests (first operands) universe)
+                           (ert-select-tests `(or ,@(rest operands))
+                                             universe)))))
+         (tag
+          (assert (eql (length operands) 1))
+          (let ((tag (first operands)))
+            (ert-select-tests `(satisfies
+                                ,(lambda (test)
+                                   (member tag (ert-test-tags test))))
+                              universe)))
+         (satisfies
+          (assert (eql (length operands) 1))
+          (ert--remove-if-not (first operands)
+                              (ert-select-tests 't universe))))))))
+
+(defun ert--insert-human-readable-selector (selector)
+  "Insert a human-readable presentation of SELECTOR into the current buffer."
+  ;; This is needed to avoid printing the (huge) contents of the
+  ;; `backtrace' slot of the result objects in the
+  ;; `most-recent-result' slots of test case objects in (eql ...) or
+  ;; (member ...) selectors.
+  (labels ((rec (selector)
+             ;; This code needs to match the etypecase in `ert-select-tests'.
+             (etypecase selector
+               ((or (member nil t
+                            :new :failed :passed
+                            :expected :unexpected)
+                    string
+                    symbol)
+                selector)
+               (ert-test
+                (if (ert-test-name selector)
+                    (make-symbol (format "<%S>" (ert-test-name selector)))
+                  (make-symbol "<unnamed test>")))
+               (cons
+                (destructuring-bind (operator &rest operands) selector
+                  (ecase operator
+                    ((member eql and not or)
+                     `(,operator ,@(mapcar #'rec operands)))
+                    ((member tag satisfies)
+                     selector)))))))
+    (insert (format "%S" (rec selector)))))
+
+
+;;; Facilities for running a whole set of tests.
+
+;; The data structure that contains the set of tests being executed
+;; during one particular test run, their results, the state of the
+;; execution, and some statistics.
+;;
+;; The data about results and expected results of tests may seem
+;; redundant here, since the test objects also carry such information.
+;; However, the information in the test objects may be more recent, it
+;; may correspond to a different test run.  We need the information
+;; that corresponds to this run in order to be able to update the
+;; statistics correctly when a test is re-run interactively and has a
+;; different result than before.
+(defstruct ert--stats
+  (selector (assert nil))
+  ;; The tests, in order.
+  (tests (assert nil) :type vector)
+  ;; A map of test names (or the test objects themselves for unnamed
+  ;; tests) to indices into the `tests' vector.
+  (test-map (assert nil) :type hash-table)
+  ;; The results of the tests during this run, in order.
+  (test-results (assert nil) :type vector)
+  ;; The start times of the tests, in order, as reported by
+  ;; `current-time'.
+  (test-start-times (assert nil) :type vector)
+  ;; The end times of the tests, in order, as reported by
+  ;; `current-time'.
+  (test-end-times (assert nil) :type vector)
+  (passed-expected 0)
+  (passed-unexpected 0)
+  (failed-expected 0)
+  (failed-unexpected 0)
+  (start-time nil)
+  (end-time nil)
+  (aborted-p nil)
+  (current-test nil)
+  ;; The time at or after which the next redisplay should occur, as a
+  ;; float.
+  (next-redisplay 0.0))
+
+(defun ert-stats-completed-expected (stats)
+  "Return the number of tests in STATS that had expected results."
+  (+ (ert--stats-passed-expected stats)
+     (ert--stats-failed-expected stats)))
+
+(defun ert-stats-completed-unexpected (stats)
+  "Return the number of tests in STATS that had unexpected results."
+  (+ (ert--stats-passed-unexpected stats)
+     (ert--stats-failed-unexpected stats)))
+
+(defun ert-stats-completed (stats)
+  "Number of tests in STATS that have run so far."
+  (+ (ert-stats-completed-expected stats)
+     (ert-stats-completed-unexpected stats)))
+
+(defun ert-stats-total (stats)
+  "Number of tests in STATS, regardless of whether they have run yet."
+  (length (ert--stats-tests stats)))
+
+;; The stats object of the current run, dynamically bound.  This is
+;; used for the mode line progress indicator.
+(defvar ert--current-run-stats nil)
+
+(defun ert--stats-test-key (test)
+  "Return the key used for TEST in the test map of ert--stats objects.
+
+Returns the name of TEST if it has one, or TEST itself otherwise."
+  (or (ert-test-name test) test))
+
+(defun ert--stats-set-test-and-result (stats pos test result)
+  "Change STATS by replacing the test at position POS with TEST and RESULT.
+
+Also changes the counters in STATS to match."
+  (let* ((tests (ert--stats-tests stats))
+         (results (ert--stats-test-results stats))
+         (old-test (aref tests pos))
+         (map (ert--stats-test-map stats)))
+    (flet ((update (d)
+             (if (ert-test-result-expected-p (aref tests pos)
+                                             (aref results pos))
+                 (etypecase (aref results pos)
+                   (ert-test-passed (incf (ert--stats-passed-expected stats) d))
+                   (ert-test-failed (incf (ert--stats-failed-expected stats) d))
+                   (null)
+                   (ert-test-aborted-with-non-local-exit))
+               (etypecase (aref results pos)
+                 (ert-test-passed (incf (ert--stats-passed-unexpected stats) d))
+                 (ert-test-failed (incf (ert--stats-failed-unexpected stats) d))
+                 (null)
+                 (ert-test-aborted-with-non-local-exit)))))
+      ;; Adjust counters to remove the result that is currently in stats.
+      (update -1)
+      ;; Put new test and result into stats.
+      (setf (aref tests pos) test
+            (aref results pos) result)
+      (remhash (ert--stats-test-key old-test) map)
+      (setf (gethash (ert--stats-test-key test) map) pos)
+      ;; Adjust counters to match new result.
+      (update +1)
+      nil)))
+
+(defun ert--make-stats (tests selector)
+  "Create a new `ert--stats' object for running TESTS.
+
+SELECTOR is the selector that was used to select TESTS."
+  (setq tests (ert--coerce-to-vector tests))
+  (let ((map (make-hash-table :size (length tests))))
+    (loop for i from 0
+          for test across tests
+          for key = (ert--stats-test-key test) do
+          (assert (not (gethash key map)))
+          (setf (gethash key map) i))
+    (make-ert--stats :selector selector
+                     :tests tests
+                     :test-map map
+                     :test-results (make-vector (length tests) nil)
+                     :test-start-times (make-vector (length tests) nil)
+                     :test-end-times (make-vector (length tests) nil))))
+
+(defun ert-run-or-rerun-test (stats test listener)
+  ;; checkdoc-order: nil
+  "Run the single test TEST and record the result using STATS and LISTENER."
+  (let ((ert--current-run-stats stats)
+        (pos (ert--stats-test-pos stats test)))
+    (ert--stats-set-test-and-result stats pos test nil)
+    ;; Call listener after setting/before resetting
+    ;; (ert--stats-current-test stats); the listener might refresh the
+    ;; mode line display, and if the value is not set yet/any more
+    ;; during this refresh, the mode line will flicker unnecessarily.
+    (setf (ert--stats-current-test stats) test)
+    (funcall listener 'test-started stats test)
+    (setf (ert-test-most-recent-result test) nil)
+    (setf (aref (ert--stats-test-start-times stats) pos) (current-time))
+    (unwind-protect
+        (ert-run-test test)
+      (setf (aref (ert--stats-test-end-times stats) pos) (current-time))
+      (let ((result (ert-test-most-recent-result test)))
+        (ert--stats-set-test-and-result stats pos test result)
+        (funcall listener 'test-ended stats test result))
+      (setf (ert--stats-current-test stats) nil))))
+
+(defun ert-run-tests (selector listener)
+  "Run the tests specified by SELECTOR, sending progress updates to LISTENER."
+  (let* ((tests (ert-select-tests selector t))
+         (stats (ert--make-stats tests selector)))
+    (setf (ert--stats-start-time stats) (current-time))
+    (funcall listener 'run-started stats)
+    (let ((abortedp t))
+      (unwind-protect
+          (let ((ert--current-run-stats stats))
+            (force-mode-line-update)
+            (unwind-protect
+                (progn
+                  (loop for test in tests do
+                        (ert-run-or-rerun-test stats test listener))
+                  (setq abortedp nil))
+              (setf (ert--stats-aborted-p stats) abortedp)
+              (setf (ert--stats-end-time stats) (current-time))
+              (funcall listener 'run-ended stats abortedp)))
+        (force-mode-line-update))
+      stats)))
+
+(defun ert--stats-test-pos (stats test)
+  ;; checkdoc-order: nil
+  "Return the position (index) of TEST in the run represented by STATS."
+  (gethash (ert--stats-test-key test) (ert--stats-test-map stats)))
+
+
+;;; Formatting functions shared across UIs.
+
+(defun ert--format-time-iso8601 (time)
+  "Format TIME in the variant of ISO 8601 used for timestamps in ERT."
+  (format-time-string "%Y-%m-%d %T%z" time))
+
+(defun ert-char-for-test-result (result expectedp)
+  "Return a character that represents the test result RESULT.
+
+EXPECTEDP specifies whether the result was expected."
+  (let ((s (etypecase result
+             (ert-test-passed ".P")
+             (ert-test-failed "fF")
+             (null "--")
+             (ert-test-aborted-with-non-local-exit "aA"))))
+    (elt s (if expectedp 0 1))))
+
+(defun ert-string-for-test-result (result expectedp)
+  "Return a string that represents the test result RESULT.
+
+EXPECTEDP specifies whether the result was expected."
+  (let ((s (etypecase result
+             (ert-test-passed '("passed" "PASSED"))
+             (ert-test-failed '("failed" "FAILED"))
+             (null '("unknown" "UNKNOWN"))
+             (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED")))))
+    (elt s (if expectedp 0 1))))
+
+(defun ert--pp-with-indentation-and-newline (object)
+  "Pretty-print OBJECT, indenting it to the current column of point.
+Ensures a final newline is inserted."
+  (let ((begin (point)))
+    (pp object (current-buffer))
+    (unless (bolp) (insert "\n"))
+    (save-excursion
+      (goto-char begin)
+      (indent-sexp))))
+
+(defun ert--insert-infos (result)
+  "Insert `ert-info' infos from RESULT into current buffer.
+
+RESULT must be an `ert-test-result-with-condition'."
+  (check-type result ert-test-result-with-condition)
+  (dolist (info (ert-test-result-with-condition-infos result))
+    (destructuring-bind (prefix . message) info
+      (let ((begin (point))
+            (indentation (make-string (+ (length prefix) 4) ?\s))
+            (end nil))
+        (unwind-protect
+            (progn
+              (insert message "\n")
+              (setq end (copy-marker (point)))
+              (goto-char begin)
+              (insert "    " prefix)
+              (forward-line 1)
+              (while (< (point) end)
+                (insert indentation)
+                (forward-line 1)))
+          (when end (set-marker end nil)))))))
+
+
+;;; Running tests in batch mode.
+
+(defvar ert-batch-backtrace-right-margin 70
+  "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+
+;;;###autoload
+(defun ert-run-tests-batch (&optional selector)
+  "Run the tests specified by SELECTOR, printing results to the terminal.
+
+SELECTOR works as described in `ert-select-tests', except if
+SELECTOR is nil, in which case all tests rather than none will be
+run; this makes the command line \"emacs -batch -l my-tests.el -f
+ert-run-tests-batch-and-exit\" useful.
+
+Returns the stats object."
+  (unless selector (setq selector 't))
+  (ert-run-tests
+   selector
+   (lambda (event-type &rest event-args)
+     (ecase event-type
+       (run-started
+        (destructuring-bind (stats) event-args
+          (message "Running %s tests (%s)"
+                   (length (ert--stats-tests stats))
+                   (ert--format-time-iso8601 (ert--stats-start-time stats)))))
+       (run-ended
+        (destructuring-bind (stats abortedp) event-args
+          (let ((unexpected (ert-stats-completed-unexpected stats))
+                (expected-failures (ert--stats-failed-expected stats)))
+            (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
+                     (if (not abortedp)
+                         ""
+                       "Aborted: ")
+                     (ert-stats-total stats)
+                     (ert-stats-completed-expected stats)
+                     (if (zerop unexpected)
+                         ""
+                       (format ", %s unexpected" unexpected))
+                     (ert--format-time-iso8601 (ert--stats-end-time stats))
+                     (if (zerop expected-failures)
+                         ""
+                       (format "\n%s expected failures" expected-failures)))
+            (unless (zerop unexpected)
+              (message "%s unexpected results:" unexpected)
+              (loop for test across (ert--stats-tests stats)
+                    for result = (ert-test-most-recent-result test) do
+                    (when (not (ert-test-result-expected-p test result))
+                      (message "%9s  %S"
+                               (ert-string-for-test-result result nil)
+                               (ert-test-name test))))
+              (message "%s" "")))))
+       (test-started
+        )
+       (test-ended
+        (destructuring-bind (stats test result) event-args
+          (unless (ert-test-result-expected-p test result)
+            (etypecase result
+              (ert-test-passed
+               (message "Test %S passed unexpectedly" (ert-test-name test)))
+              (ert-test-result-with-condition
+               (message "Test %S backtrace:" (ert-test-name test))
+               (with-temp-buffer
+                 (ert--print-backtrace (ert-test-result-with-condition-backtrace
+                                        result))
+                 (goto-char (point-min))
+                 (while (not (eobp))
+                   (let ((start (point))
+                         (end (progn (end-of-line) (point))))
+                     (setq end (min end
+                                    (+ start ert-batch-backtrace-right-margin)))
+                     (message "%s" (buffer-substring-no-properties
+                                    start end)))
+                   (forward-line 1)))
+               (with-temp-buffer
+                 (ert--insert-infos result)
+                 (insert "    ")
+                 (let ((print-escape-newlines t)
+                       (print-level 5)
+                       (print-length 10))
+                   (let ((begin (point)))
+                     (ert--pp-with-indentation-and-newline
+                      (ert-test-result-with-condition-condition result))))
+                 (goto-char (1- (point-max)))
+                 (assert (looking-at "\n"))
+                 (delete-char 1)
+                 (message "Test %S condition:" (ert-test-name test))
+                 (message "%s" (buffer-string))))
+              (ert-test-aborted-with-non-local-exit
+               (message "Test %S aborted with non-local exit"
+                        (ert-test-name test)))))
+          (let* ((max (prin1-to-string (length (ert--stats-tests stats))))
+                 (format-string (concat "%9s  %"
+                                        (prin1-to-string (length max))
+                                        "s/" max "  %S")))
+            (message format-string
+                     (ert-string-for-test-result result
+                                                 (ert-test-result-expected-p
+                                                  test result))
+                     (1+ (ert--stats-test-pos stats test))
+                     (ert-test-name test)))))))))
+
+;;;###autoload
+(defun ert-run-tests-batch-and-exit (&optional selector)
+  "Like `ert-run-tests-batch', but exits Emacs when done.
+
+The exit status will be 0 if all test results were as expected, 1
+on unexpected results, or 2 if the tool detected an error outside
+of the tests (e.g. invalid SELECTOR or bug in the code that runs
+the tests)."
+  (unwind-protect
+      (let ((stats (ert-run-tests-batch selector)))
+        (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1)))
+    (unwind-protect
+        (progn
+          (message "Error running tests")
+          (backtrace))
+      (kill-emacs 2))))
+
+
+;;; Utility functions for load/unload actions.
+
+(defun ert--activate-font-lock-keywords ()
+  "Activate font-lock keywords for some of ERT's symbols."
+  (font-lock-add-keywords
+   nil
+   '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\sw+\\)?"
+      (1 font-lock-keyword-face nil t)
+      (2 font-lock-function-name-face nil t)))))
+
+(defun* ert--remove-from-list (list-var element &key key test)
+  "Remove ELEMENT from the value of LIST-VAR if present.
+
+This can be used as an inverse of `add-to-list'."
+  (unless key (setq key #'identity))
+  (unless test (setq test #'equal))
+  (setf (symbol-value list-var)
+        (ert--remove* element
+                      (symbol-value list-var)
+                      :key key
+                      :test test)))
+
+
+;;; Some basic interactive functions.
+
+(defun ert-read-test-name (prompt &optional default history
+                                  add-default-to-prompt)
+  "Read the name of a test and return it as a symbol.
+
+Prompt with PROMPT.  If DEFAULT is a valid test name, use it as a
+default.  HISTORY is the history to use; see `completing-read'.
+If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to
+include the default, if any.
+
+Signals an error if no test name was read."
+  (etypecase default
+    (string (let ((symbol (intern-soft default)))
+              (unless (and symbol (ert-test-boundp symbol))
+                (setq default nil))))
+    (symbol (setq default
+                  (if (ert-test-boundp default)
+                      (symbol-name default)
+                    nil)))
+    (ert-test (setq default (ert-test-name default))))
+  (when add-default-to-prompt
+    (setq prompt (if (null default)
+                     (format "%s: " prompt)
+                   (format "%s (default %s): " prompt default))))
+  (let ((input (completing-read prompt obarray #'ert-test-boundp
+                                t nil history default nil)))
+    ;; completing-read returns an empty string if default was nil and
+    ;; the user just hit enter.
+    (let ((sym (intern-soft input)))
+      (if (ert-test-boundp sym)
+          sym
+        (error "Input does not name a test")))))
+
+(defun ert-read-test-name-at-point (prompt)
+  "Read the name of a test and return it as a symbol.
+As a default, use the symbol at point, or the test at point if in
+the ERT results buffer.  Prompt with PROMPT, augmented with the
+default (if any)."
+  (ert-read-test-name prompt (ert-test-at-point) nil t))
+
+(defun ert-find-test-other-window (test-name)
+  "Find, in another window, the definition of TEST-NAME."
+  (interactive (list (ert-read-test-name-at-point "Find test definition: ")))
+  (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window))
+
+(defun ert-delete-test (test-name)
+  "Make the test TEST-NAME unbound.
+
+Nothing more than an interactive interface to `ert-make-test-unbound'."
+  (interactive (list (ert-read-test-name-at-point "Delete test")))
+  (ert-make-test-unbound test-name))
+
+(defun ert-delete-all-tests ()
+  "Make all symbols in `obarray' name no test."
+  (interactive)
+  (when (interactive-p)
+    (unless (y-or-n-p "Delete all tests? ")
+      (error "Aborted")))
+  ;; We can't use `ert-select-tests' here since that gives us only
+  ;; test objects, and going from them back to the test name symbols
+  ;; can fail if the `ert-test' defstruct has been redefined.
+  (mapc #'ert-make-test-unbound (apropos-internal "" #'ert-test-boundp))
+  t)
+
+
+;;; Display of test progress and results.
+
+;; An entry in the results buffer ewoc.  There is one entry per test.
+(defstruct ert--ewoc-entry
+  (test (assert nil))
+  ;; If the result of this test was expected, its ewoc entry is hidden
+  ;; initially.
+  (hidden-p (assert nil))
+  ;; An ewoc entry may be collapsed to hide details such as the error
+  ;; condition.
+  ;;
+  ;; I'm not sure the ability to expand and collapse entries is still
+  ;; a useful feature.
+  (expanded-p t)
+  ;; By default, the ewoc entry presents the error condition with
+  ;; certain limits on how much to print (`print-level',
+  ;; `print-length').  The user can interactively switch to a set of
+  ;; higher limits.
+  (extended-printer-limits-p nil))
+
+;; Variables local to the results buffer.
+
+;; The ewoc.
+(defvar ert--results-ewoc)
+;; The stats object.
+(defvar ert--results-stats)
+;; A string with one character per test.  Each character represents
+;; the result of the corresponding test.  The string is displayed near
+;; the top of the buffer and serves as a progress bar.
+(defvar ert--results-progress-bar-string)
+;; The position where the progress bar button begins.
+(defvar ert--results-progress-bar-button-begin)
+;; The test result listener that updates the buffer when tests are run.
+(defvar ert--results-listener)
+
+(defun ert-insert-test-name-button (test-name)
+  "Insert a button that links to TEST-NAME."
+  (insert-text-button (format "%S" test-name)
+                      :type 'ert--test-name-button
+                      'ert-test-name test-name))
+
+(defun ert--results-format-expected-unexpected (expected unexpected)
+  "Return a string indicating EXPECTED expected results, UNEXPECTED unexpected."
+  (if (zerop unexpected)
+      (format "%s" expected)
+    (format "%s (%s unexpected)" (+ expected unexpected) unexpected)))
+
+(defun ert--results-update-ewoc-hf (ewoc stats)
+  "Update the header and footer of EWOC to show certain information from STATS.
+
+Also sets `ert--results-progress-bar-button-begin'."
+  (let ((run-count (ert-stats-completed stats))
+        (results-buffer (current-buffer))
+        ;; Need to save buffer-local value.
+        (font-lock font-lock-mode))
+    (ewoc-set-hf
+     ewoc
+     ;; header
+     (with-temp-buffer
+       (insert "Selector: ")
+       (ert--insert-human-readable-selector (ert--stats-selector stats))
+       (insert "\n")
+       (insert
+        (format (concat "Passed: %s\n"
+                        "Failed: %s\n"
+                        "Total:  %s/%s\n\n")
+                (ert--results-format-expected-unexpected
+                 (ert--stats-passed-expected stats)
+                 (ert--stats-passed-unexpected stats))
+                (ert--results-format-expected-unexpected
+                 (ert--stats-failed-expected stats)
+                 (ert--stats-failed-unexpected stats))
+                run-count
+                (ert-stats-total stats)))
+       (insert
+        (format "Started at:   %s\n"
+                (ert--format-time-iso8601 (ert--stats-start-time stats))))
+       ;; FIXME: This is ugly.  Need to properly define invariants of
+       ;; the `stats' data structure.
+       (let ((state (cond ((ert--stats-aborted-p stats) 'aborted)
+                          ((ert--stats-current-test stats) 'running)
+                          ((ert--stats-end-time stats) 'finished)
+                          (t 'preparing))))
+         (ecase state
+           (preparing
+            (insert ""))
+           (aborted
+            (cond ((ert--stats-current-test stats)
+                   (insert "Aborted during test: ")
+                   (ert-insert-test-name-button
+                    (ert-test-name (ert--stats-current-test stats))))
+                  (t
+                   (insert "Aborted."))))
+           (running
+            (assert (ert--stats-current-test stats))
+            (insert "Running test: ")
+            (ert-insert-test-name-button (ert-test-name
+                                          (ert--stats-current-test stats))))
+           (finished
+            (assert (not (ert--stats-current-test stats)))
+            (insert "Finished.")))
+         (insert "\n")
+         (if (ert--stats-end-time stats)
+             (insert
+              (format "%s%s\n"
+                      (if (ert--stats-aborted-p stats)
+                          "Aborted at:   "
+                        "Finished at:  ")
+                      (ert--format-time-iso8601 (ert--stats-end-time stats))))
+           (insert "\n"))
+         (insert "\n"))
+       (let ((progress-bar-string (with-current-buffer results-buffer
+                                    ert--results-progress-bar-string)))
+         (let ((progress-bar-button-begin
+                (insert-text-button progress-bar-string
+                                    :type 'ert--results-progress-bar-button
+                                    'face (or (and font-lock
+                                                   (ert-face-for-stats stats))
+                                              'button))))
+           ;; The header gets copied verbatim to the results buffer,
+           ;; and all positions remain the same, so
+           ;; `progress-bar-button-begin' will be the right position
+           ;; even in the results buffer.
+           (with-current-buffer results-buffer
+             (set (make-local-variable 'ert--results-progress-bar-button-begin)
+                  progress-bar-button-begin))))
+       (insert "\n\n")
+       (buffer-string))
+     ;; footer
+     ;;
+     ;; We actually want an empty footer, but that would trigger a bug
+     ;; in ewoc, sometimes clearing the entire buffer.  (It's possible
+     ;; that this bug has been fixed since this has been tested; we
+     ;; should test it again.)
+     "\n")))
+
+
+(defvar ert-test-run-redisplay-interval-secs .1
+  "How many seconds ERT should wait between redisplays while running tests.
+
+While running tests, ERT shows the current progress, and this variable
+determines how frequently the progress display is updated.")
+
+(defun ert--results-update-stats-display (ewoc stats)
+  "Update EWOC and the mode line to show data from STATS."
+  ;; TODO(ohler): investigate using `make-progress-reporter'.
+  (ert--results-update-ewoc-hf ewoc stats)
+  (force-mode-line-update)
+  (redisplay t)
+  (setf (ert--stats-next-redisplay stats)
+        (+ (float-time) ert-test-run-redisplay-interval-secs)))
+
+(defun ert--results-update-stats-display-maybe (ewoc stats)
+  "Call `ert--results-update-stats-display' if not called recently.
+
+EWOC and STATS are arguments for `ert--results-update-stats-display'."
+  (when (>= (float-time) (ert--stats-next-redisplay stats))
+    (ert--results-update-stats-display ewoc stats)))
+
+(defun ert--tests-running-mode-line-indicator ()
+  "Return a string for the mode line that shows the test run progress."
+  (let* ((stats ert--current-run-stats)
+         (tests-total (ert-stats-total stats))
+         (tests-completed (ert-stats-completed stats)))
+    (if (>= tests-completed tests-total)
+        (format " ERT(%s/%s,finished)" tests-completed tests-total)
+      (format " ERT(%s/%s):%s"
+              (1+ tests-completed)
+              tests-total
+              (if (null (ert--stats-current-test stats))
+                  "?"
+                (format "%S"
+                        (ert-test-name (ert--stats-current-test stats))))))))
+
+(defun ert--make-xrefs-region (begin end)
+  "Attach cross-references to function names between BEGIN and END.
+
+BEGIN and END specify a region in the current buffer."
+  (save-excursion
+    (save-restriction
+      (narrow-to-region begin (point))
+      ;; Inhibit optimization in `debugger-make-xrefs' that would
+      ;; sometimes insert unrelated backtrace info into our buffer.
+      (let ((debugger-previous-backtrace nil))
+        (debugger-make-xrefs)))))
+
+(defun ert--string-first-line (s)
+  "Return the first line of S, or S if it contains no newlines.
+
+The return value does not include the line terminator."
+  (substring s 0 (ert--string-position ?\n s)))
+
+(defun ert-face-for-test-result (expectedp)
+  "Return a face that shows whether a test result was expected or unexpected.
+
+If EXPECTEDP is nil, returns the face for unexpected results; if
+non-nil, returns the face for expected results.."
+  (if expectedp 'ert-test-result-expected 'ert-test-result-unexpected))
+
+(defun ert-face-for-stats (stats)
+  "Return a face that represents STATS."
+  (cond ((ert--stats-aborted-p stats) 'nil)
+        ((plusp (ert-stats-completed-unexpected stats))
+         (ert-face-for-test-result nil))
+        ((eql (ert-stats-completed-expected stats) (ert-stats-total stats))
+         (ert-face-for-test-result t))
+        (t 'nil)))
+
+(defun ert--print-test-for-ewoc (entry)
+  "The ewoc print function for ewoc test entries.  ENTRY is the entry to print."
+  (let* ((test (ert--ewoc-entry-test entry))
+         (stats ert--results-stats)
+         (result (let ((pos (ert--stats-test-pos stats test)))
+                   (assert pos)
+                   (aref (ert--stats-test-results stats) pos)))
+         (hiddenp (ert--ewoc-entry-hidden-p entry))
+         (expandedp (ert--ewoc-entry-expanded-p entry))
+         (extended-printer-limits-p (ert--ewoc-entry-extended-printer-limits-p
+                                     entry)))
+    (cond (hiddenp)
+          (t
+           (let ((expectedp (ert-test-result-expected-p test result)))
+             (insert-text-button (format "%c" (ert-char-for-test-result
+                                               result expectedp))
+                                 :type 'ert--results-expand-collapse-button
+                                 'face (or (and font-lock-mode
+                                                (ert-face-for-test-result
+                                                 expectedp))
+                                           'button)))
+           (insert " ")
+           (ert-insert-test-name-button (ert-test-name test))
+           (insert "\n")
+           (when (and expandedp (not (eql result 'nil)))
+             (when (ert-test-documentation test)
+               (insert "    "
+                       (propertize
+                        (ert--string-first-line (ert-test-documentation test))
+                        'font-lock-face 'font-lock-doc-face)
+                       "\n"))
+             (etypecase result
+               (ert-test-passed
+                (if (ert-test-result-expected-p test result)
+                    (insert "    passed\n")
+                  (insert "    passed unexpectedly\n"))
+                (insert ""))
+               (ert-test-result-with-condition
+                (ert--insert-infos result)
+                (let ((print-escape-newlines t)
+                      (print-level (if extended-printer-limits-p 12 6))
+                      (print-length (if extended-printer-limits-p 100 10)))
+                  (insert "    ")
+                  (let ((begin (point)))
+                    (ert--pp-with-indentation-and-newline
+                     (ert-test-result-with-condition-condition result))
+                    (ert--make-xrefs-region begin (point)))))
+               (ert-test-aborted-with-non-local-exit
+                (insert "    aborted\n")))
+             (insert "\n")))))
+  nil)
+
+(defun ert--results-font-lock-function (enabledp)
+  "Redraw the ERT results buffer after font-lock-mode was switched on or off.
+
+ENABLEDP is true if font-lock-mode is switched on, false
+otherwise."
+  (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
+  (ewoc-refresh ert--results-ewoc)
+  (font-lock-default-function enabledp))
+
+(defun ert--setup-results-buffer (stats listener buffer-name)
+  "Set up a test results buffer.
+
+STATS is the stats object; LISTENER is the results listener;
+BUFFER-NAME, if non-nil, is the buffer name to use."
+  (unless buffer-name (setq buffer-name "*ert*"))
+  (let ((buffer (get-buffer-create buffer-name)))
+    (with-current-buffer buffer
+      (setq buffer-read-only t)
+      (let ((inhibit-read-only t))
+        (buffer-disable-undo)
+        (erase-buffer)
+        (ert-results-mode)
+        ;; Erase buffer again in case switching out of the previous
+        ;; mode inserted anything.  (This happens e.g. when switching
+        ;; from ert-results-mode to ert-results-mode when
+        ;; font-lock-mode turns itself off in change-major-mode-hook.)
+        (erase-buffer)
+        (set (make-local-variable 'font-lock-function)
+             'ert--results-font-lock-function)
+        (let ((ewoc (ewoc-create 'ert--print-test-for-ewoc nil nil t)))
+          (set (make-local-variable 'ert--results-ewoc) ewoc)
+          (set (make-local-variable 'ert--results-stats) stats)
+          (set (make-local-variable 'ert--results-progress-bar-string)
+               (make-string (ert-stats-total stats)
+                            (ert-char-for-test-result nil t)))
+          (set (make-local-variable 'ert--results-listener) listener)
+          (loop for test across (ert--stats-tests stats) do
+                (ewoc-enter-last ewoc
+                                 (make-ert--ewoc-entry :test test :hidden-p t)))
+          (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
+          (goto-char (1- (point-max)))
+          buffer)))))
+
+
+(defvar ert--selector-history nil
+  "List of recent test selectors read from terminal.")
+
+;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here?
+;; They are needed only for our automated self-tests at the moment.
+;; Or should there be some other mechanism?
+;;;###autoload
+(defun ert-run-tests-interactively (selector
+                                    &optional output-buffer-name message-fn)
+  "Run the tests specified by SELECTOR and display the results in a buffer.
+
+SELECTOR works as described in `ert-select-tests'.
+OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they
+are used for automated self-tests and specify which buffer to use
+and how to display message."
+  (interactive
+   (list (let ((default (if ert--selector-history
+                            ;; Can't use `first' here as this form is
+                            ;; not compiled, and `first' is not
+                            ;; defined without cl.
+                            (car ert--selector-history)
+                          "t")))
+           (read-from-minibuffer (if (null default)
+                                     "Run tests: "
+                                   (format "Run tests (default %s): " default))
+                                 nil nil t 'ert--selector-history
+                                 default nil))
+         nil))
+  (unless message-fn (setq message-fn 'message))
+  (lexical-let ((output-buffer-name output-buffer-name)
+                buffer
+                listener
+                (message-fn message-fn))
+    (setq listener
+          (lambda (event-type &rest event-args)
+            (ecase event-type
+              (run-started
+               (destructuring-bind (stats) event-args
+                 (setq buffer (ert--setup-results-buffer stats
+                                                         listener
+                                                         output-buffer-name))
+                 (pop-to-buffer buffer)))
+              (run-ended
+               (destructuring-bind (stats abortedp) event-args
+                 (funcall message-fn
+                          "%sRan %s tests, %s results were as expected%s"
+                          (if (not abortedp)
+                              ""
+                            "Aborted: ")
+                          (ert-stats-total stats)
+                          (ert-stats-completed-expected stats)
+                          (let ((unexpected
+                                 (ert-stats-completed-unexpected stats)))
+                            (if (zerop unexpected)
+                                ""
+                              (format ", %s unexpected" unexpected))))
+                 (ert--results-update-stats-display (with-current-buffer buffer
+                                                      ert--results-ewoc)
+                                                    stats)))
+              (test-started
+               (destructuring-bind (stats test) event-args
+                 (with-current-buffer buffer
+                   (let* ((ewoc ert--results-ewoc)
+                          (pos (ert--stats-test-pos stats test))
+                          (node (ewoc-nth ewoc pos)))
+                     (assert node)
+                     (setf (ert--ewoc-entry-test (ewoc-data node)) test)
+                     (aset ert--results-progress-bar-string pos
+                           (ert-char-for-test-result nil t))
+                     (ert--results-update-stats-display-maybe ewoc stats)
+                     (ewoc-invalidate ewoc node)))))
+              (test-ended
+               (destructuring-bind (stats test result) event-args
+                 (with-current-buffer buffer
+                   (let* ((ewoc ert--results-ewoc)
+                          (pos (ert--stats-test-pos stats test))
+                          (node (ewoc-nth ewoc pos)))
+                     (when (ert--ewoc-entry-hidden-p (ewoc-data node))
+                       (setf (ert--ewoc-entry-hidden-p (ewoc-data node))
+                             (ert-test-result-expected-p test result)))
+                     (aset ert--results-progress-bar-string pos
+                           (ert-char-for-test-result result
+                                                     (ert-test-result-expected-p
+                                                      test result)))
+                     (ert--results-update-stats-display-maybe ewoc stats)
+                     (ewoc-invalidate ewoc node))))))))
+    (ert-run-tests
+     selector
+     listener)))
+;;;###autoload
+(defalias 'ert 'ert-run-tests-interactively)
+
+
+;;; Simple view mode for auxiliary information like stack traces or
+;;; messages.  Mainly binds "q" for quit.
+
+(define-derived-mode ert-simple-view-mode fundamental-mode "ERT-View"
+  "Major mode for viewing auxiliary information in ERT.")
+
+(loop for (key binding) in
+      '(("q" quit-window)
+        )
+      do
+      (define-key ert-simple-view-mode-map key binding))
+
+
+;;; Commands and button actions for the results buffer.
+
+(define-derived-mode ert-results-mode fundamental-mode "ERT-Results"
+  "Major mode for viewing results of ERT test runs.")
+
+(loop for (key binding) in
+      '(;; Stuff that's not in the menu.
+        ("\t" forward-button)
+        ([backtab] backward-button)
+        ("j" ert-results-jump-between-summary-and-result)
+        ("q" quit-window)
+        ("L" ert-results-toggle-printer-limits-for-test-at-point)
+        ("n" ert-results-next-test)
+        ("p" ert-results-previous-test)
+        ;; Stuff that is in the menu.
+        ("R" ert-results-rerun-all-tests)
+        ("r" ert-results-rerun-test-at-point)
+        ("d" ert-results-rerun-test-at-point-debugging-errors)
+        ("." ert-results-find-test-at-point-other-window)
+        ("b" ert-results-pop-to-backtrace-for-test-at-point)
+        ("m" ert-results-pop-to-messages-for-test-at-point)
+        ("l" ert-results-pop-to-should-forms-for-test-at-point)
+        ("h" ert-results-describe-test-at-point)
+        ("D" ert-delete-test)
+        ("T" ert-results-pop-to-timings)
+        )
+      do
+      (define-key ert-results-mode-map key binding))
+
+(easy-menu-define ert-results-mode-menu ert-results-mode-map
+  "Menu for `ert-results-mode'."
+  '("ERT Results"
+    ["Re-run all tests" ert-results-rerun-all-tests]
+    "--"
+    ["Re-run test" ert-results-rerun-test-at-point]
+    ["Debug test" ert-results-rerun-test-at-point-debugging-errors]
+    ["Show test definition" ert-results-find-test-at-point-other-window]
+    "--"
+    ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point]
+    ["Show messages" ert-results-pop-to-messages-for-test-at-point]
+    ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point]
+    ["Describe test" ert-results-describe-test-at-point]
+    "--"
+    ["Delete test" ert-delete-test]
+    "--"
+    ["Show execution time of each test" ert-results-pop-to-timings]
+    ))
+
+(define-button-type 'ert--results-progress-bar-button
+  'action #'ert--results-progress-bar-button-action
+  'help-echo "mouse-2, RET: Reveal test result")
+
+(define-button-type 'ert--test-name-button
+  'action #'ert--test-name-button-action
+  'help-echo "mouse-2, RET: Find test definition")
+
+(define-button-type 'ert--results-expand-collapse-button
+  'action #'ert--results-expand-collapse-button-action
+  'help-echo "mouse-2, RET: Expand/collapse test result")
+
+(defun ert--results-test-node-or-null-at-point ()
+  "If point is on a valid ewoc node, return it; return nil otherwise.
+
+To be used in the ERT results buffer."
+  (let* ((ewoc ert--results-ewoc)
+         (node (ewoc-locate ewoc)))
+    ;; `ewoc-locate' will return an arbitrary node when point is on
+    ;; header or footer, or when all nodes are invisible.  So we need
+    ;; to validate its return value here.
+    ;;
+    ;; Update: I'm seeing nil being returned in some cases now,
+    ;; perhaps this has been changed?
+    (if (and node
+             (>= (point) (ewoc-location node))
+             (not (ert--ewoc-entry-hidden-p (ewoc-data node))))
+        node
+      nil)))
+
+(defun ert--results-test-node-at-point ()
+  "If point is on a valid ewoc node, return it; signal an error otherwise.
+
+To be used in the ERT results buffer."
+  (or (ert--results-test-node-or-null-at-point)
+      (error "No test at point")))
+
+(defun ert-results-next-test ()
+  "Move point to the next test.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next
+                     "No tests below"))
+
+(defun ert-results-previous-test ()
+  "Move point to the previous test.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev
+                     "No tests above"))
+
+(defun ert--results-move (node ewoc-fn error-message)
+  "Move point from NODE to the previous or next node.
+
+EWOC-FN specifies the direction and should be either `ewoc-prev'
+or `ewoc-next'.  If there are no more nodes in that direction, an
+error is signalled with the message ERROR-MESSAGE."
+  (loop
+   (setq node (funcall ewoc-fn ert--results-ewoc node))
+   (when (null node)
+     (error "%s" error-message))
+   (unless (ert--ewoc-entry-hidden-p (ewoc-data node))
+     (goto-char (ewoc-location node))
+     (return))))
+
+(defun ert--results-expand-collapse-button-action (button)
+  "Expand or collapse the test node BUTTON belongs to."
+  (let* ((ewoc ert--results-ewoc)
+         (node (save-excursion
+                 (goto-char (ert--button-action-position))
+                 (ert--results-test-node-at-point)))
+         (entry (ewoc-data node)))
+    (setf (ert--ewoc-entry-expanded-p entry)
+          (not (ert--ewoc-entry-expanded-p entry)))
+    (ewoc-invalidate ewoc node)))
+
+(defun ert-results-find-test-at-point-other-window ()
+  "Find the definition of the test at point in another window.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let ((name (ert-test-at-point)))
+    (unless name
+      (error "No test at point"))
+    (ert-find-test-other-window name)))
+
+(defun ert--test-name-button-action (button)
+  "Find the definition of the test BUTTON belongs to, in another window."
+  (let ((name (button-get button 'ert-test-name)))
+    (ert-find-test-other-window name)))
+
+(defun ert--ewoc-position (ewoc node)
+  ;; checkdoc-order: nil
+  "Return the position of NODE in EWOC, or nil if NODE is not in EWOC."
+  (loop for i from 0
+        for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
+        do (when (eql node node-here)
+             (return i))
+        finally (return nil)))
+
+(defun ert-results-jump-between-summary-and-result ()
+  "Jump back and forth between the test run summary and individual test results.
+
+From an ewoc node, jumps to the character that represents the
+same test in the progress bar, and vice versa.
+
+To be used in the ERT results buffer."
+  ;; Maybe this command isn't actually needed much, but if it is, it
+  ;; seems like an indication that the UI design is not optimal.  If
+  ;; jumping back and forth between a summary at the top of the buffer
+  ;; and the error log in the remainder of the buffer is useful, then
+  ;; the summary apparently needs to be easily accessible from the
+  ;; error log, and perhaps it would be better to have it in a
+  ;; separate buffer to keep it visible.
+  (interactive)
+  (let ((ewoc ert--results-ewoc)
+        (progress-bar-begin ert--results-progress-bar-button-begin))
+    (cond ((ert--results-test-node-or-null-at-point)
+           (let* ((node (ert--results-test-node-at-point))
+                  (pos (ert--ewoc-position ewoc node)))
+             (goto-char (+ progress-bar-begin pos))))
+          ((and (<= progress-bar-begin (point))
+                (< (point) (button-end (button-at progress-bar-begin))))
+           (let* ((node (ewoc-nth ewoc (- (point) progress-bar-begin)))
+                  (entry (ewoc-data node)))
+             (when (ert--ewoc-entry-hidden-p entry)
+               (setf (ert--ewoc-entry-hidden-p entry) nil)
+               (ewoc-invalidate ewoc node))
+             (ewoc-goto-node ewoc node)))
+          (t
+           (goto-char progress-bar-begin)))))
+
+(defun ert-test-at-point ()
+  "Return the name of the test at point as a symbol, or nil if none."
+  (or (and (eql major-mode 'ert-results-mode)
+           (let ((test (ert--results-test-at-point-no-redefinition)))
+             (and test (ert-test-name test))))
+      (let* ((thing (thing-at-point 'symbol))
+             (sym (intern-soft thing)))
+        (and (ert-test-boundp sym)
+             sym))))
+
+(defun ert--results-test-at-point-no-redefinition ()
+  "Return the test at point, or nil.
+
+To be used in the ERT results buffer."
+  (assert (eql major-mode 'ert-results-mode))
+  (if (ert--results-test-node-or-null-at-point)
+      (let* ((node (ert--results-test-node-at-point))
+             (test (ert--ewoc-entry-test (ewoc-data node))))
+        test)
+    (let ((progress-bar-begin ert--results-progress-bar-button-begin))
+      (when (and (<= progress-bar-begin (point))
+                 (< (point) (button-end (button-at progress-bar-begin))))
+        (let* ((test-index (- (point) progress-bar-begin))
+               (test (aref (ert--stats-tests ert--results-stats)
+                           test-index)))
+          test)))))
+
+(defun ert--results-test-at-point-allow-redefinition ()
+  "Look up the test at point, and check whether it has been redefined.
+
+To be used in the ERT results buffer.
+
+Returns a list of two elements: the test (or nil) and a symbol
+specifying whether the test has been redefined.
+
+If a new test has been defined with the same name as the test at
+point, replaces the test at point with the new test, and returns
+the new test and the symbol `redefined'.
+
+If the test has been deleted, returns the old test and the symbol
+`deleted'.
+
+If the test is still current, returns the test and the symbol nil.
+
+If there is no test at point, returns a list with two nils."
+  (let ((test (ert--results-test-at-point-no-redefinition)))
+    (cond ((null test)
+           `(nil nil))
+          ((null (ert-test-name test))
+           `(,test nil))
+          (t
+           (let* ((name (ert-test-name test))
+                  (new-test (and (ert-test-boundp name)
+                                 (ert-get-test name))))
+             (cond ((eql test new-test)
+                    `(,test nil))
+                   ((null new-test)
+                    `(,test deleted))
+                   (t
+                    (ert--results-update-after-test-redefinition
+                     (ert--stats-test-pos ert--results-stats test)
+                     new-test)
+                    `(,new-test redefined))))))))
+
+(defun ert--results-update-after-test-redefinition (pos new-test)
+  "Update results buffer after the test at pos POS has been redefined.
+
+Also updates the stats object.  NEW-TEST is the new test
+definition."
+  (let* ((stats ert--results-stats)
+         (ewoc ert--results-ewoc)
+         (node (ewoc-nth ewoc pos))
+         (entry (ewoc-data node)))
+    (ert--stats-set-test-and-result stats pos new-test nil)
+    (setf (ert--ewoc-entry-test entry) new-test
+          (aref ert--results-progress-bar-string pos) (ert-char-for-test-result
+                                                       nil t))
+    (ewoc-invalidate ewoc node))
+  nil)
+
+(defun ert--button-action-position ()
+  "The buffer position where the last button action was triggered."
+  (cond ((integerp last-command-event)
+         (point))
+        ((eventp last-command-event)
+         (posn-point (event-start last-command-event)))
+        (t (assert nil))))
+
+(defun ert--results-progress-bar-button-action (button)
+  "Jump to details for the test represented by the character clicked in BUTTON."
+  (goto-char (ert--button-action-position))
+  (ert-results-jump-between-summary-and-result))
+
+(defun ert-results-rerun-all-tests ()
+  "Re-run all tests, using the same selector.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (assert (eql major-mode 'ert-results-mode))
+  (let ((selector (ert--stats-selector ert--results-stats)))
+    (ert-run-tests-interactively selector (buffer-name))))
+
+(defun ert-results-rerun-test-at-point ()
+  "Re-run the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (destructuring-bind (test redefinition-state)
+      (ert--results-test-at-point-allow-redefinition)
+    (when (null test)
+      (error "No test at point"))
+    (let* ((stats ert--results-stats)
+           (progress-message (format "Running %stest %S"
+                                     (ecase redefinition-state
+                                       ((nil) "")
+                                       (redefined "new definition of ")
+                                       (deleted "deleted "))
+                                     (ert-test-name test))))
+      ;; Need to save and restore point manually here: When point is on
+      ;; the first visible ewoc entry while the header is updated, point
+      ;; moves to the top of the buffer.  This is undesirable, and a
+      ;; simple `save-excursion' doesn't prevent it.
+      (let ((point (point)))
+        (unwind-protect
+            (unwind-protect
+                (progn
+                  (message "%s..." progress-message)
+                  (ert-run-or-rerun-test stats test
+                                         ert--results-listener))
+              (ert--results-update-stats-display ert--results-ewoc stats)
+              (message "%s...%s"
+                       progress-message
+                       (let ((result (ert-test-most-recent-result test)))
+                         (ert-string-for-test-result
+                          result (ert-test-result-expected-p test result)))))
+          (goto-char point))))))
+
+(defun ert-results-rerun-test-at-point-debugging-errors ()
+  "Re-run the test at point with `ert-debug-on-error' bound to t.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let ((ert-debug-on-error t))
+    (ert-results-rerun-test-at-point)))
+
+(defun ert-results-pop-to-backtrace-for-test-at-point ()
+  "Display the backtrace for the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let* ((test (ert--results-test-at-point-no-redefinition))
+         (stats ert--results-stats)
+         (pos (ert--stats-test-pos stats test))
+         (result (aref (ert--stats-test-results stats) pos)))
+    (etypecase result
+      (ert-test-passed (error "Test passed, no backtrace available"))
+      (ert-test-result-with-condition
+       (let ((backtrace (ert-test-result-with-condition-backtrace result))
+             (buffer (get-buffer-create "*ERT Backtrace*")))
+         (pop-to-buffer buffer)
+         (setq buffer-read-only t)
+         (let ((inhibit-read-only t))
+           (buffer-disable-undo)
+           (erase-buffer)
+           (ert-simple-view-mode)
+           ;; Use unibyte because `debugger-setup-buffer' also does so.
+           (set-buffer-multibyte nil)
+           (setq truncate-lines t)
+           (ert--print-backtrace backtrace)
+           (debugger-make-xrefs)
+           (goto-char (point-min))
+           (insert "Backtrace for test `")
+           (ert-insert-test-name-button (ert-test-name test))
+           (insert "':\n")))))))
+
+(defun ert-results-pop-to-messages-for-test-at-point ()
+  "Display the part of the *Messages* buffer generated during the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let* ((test (ert--results-test-at-point-no-redefinition))
+         (stats ert--results-stats)
+         (pos (ert--stats-test-pos stats test))
+         (result (aref (ert--stats-test-results stats) pos)))
+    (let ((buffer (get-buffer-create "*ERT Messages*")))
+      (pop-to-buffer buffer)
+      (setq buffer-read-only t)
+      (let ((inhibit-read-only t))
+        (buffer-disable-undo)
+        (erase-buffer)
+        (ert-simple-view-mode)
+        (insert (ert-test-result-messages result))
+        (goto-char (point-min))
+        (insert "Messages for test `")
+        (ert-insert-test-name-button (ert-test-name test))
+        (insert "':\n")))))
+
+(defun ert-results-pop-to-should-forms-for-test-at-point ()
+  "Display the list of `should' forms executed during the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let* ((test (ert--results-test-at-point-no-redefinition))
+         (stats ert--results-stats)
+         (pos (ert--stats-test-pos stats test))
+         (result (aref (ert--stats-test-results stats) pos)))
+    (let ((buffer (get-buffer-create "*ERT list of should forms*")))
+      (pop-to-buffer buffer)
+      (setq buffer-read-only t)
+      (let ((inhibit-read-only t))
+        (buffer-disable-undo)
+        (erase-buffer)
+        (ert-simple-view-mode)
+        (if (null (ert-test-result-should-forms result))
+            (insert "\n(No should forms during this test.)\n")
+          (loop for form-description in (ert-test-result-should-forms result)
+                for i from 1 do
+                (insert "\n")
+                (insert (format "%s: " i))
+                (let ((begin (point)))
+                  (ert--pp-with-indentation-and-newline form-description)
+                  (ert--make-xrefs-region begin (point)))))
+        (goto-char (point-min))
+        (insert "`should' forms executed during test `")
+        (ert-insert-test-name-button (ert-test-name test))
+        (insert "':\n")
+        (insert "\n")
+        (insert (concat "(Values are shallow copies and may have "
+                        "looked different during the test if they\n"
+                        "have been modified destructively.)\n"))
+        (forward-line 1)))))
+
+(defun ert-results-toggle-printer-limits-for-test-at-point ()
+  "Toggle how much of the condition to print for the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let* ((ewoc ert--results-ewoc)
+         (node (ert--results-test-node-at-point))
+         (entry (ewoc-data node)))
+    (setf (ert--ewoc-entry-extended-printer-limits-p entry)
+          (not (ert--ewoc-entry-extended-printer-limits-p entry)))
+    (ewoc-invalidate ewoc node)))
+
+(defun ert-results-pop-to-timings ()
+  "Display test timings for the last run.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (let* ((stats ert--results-stats)
+         (start-times (ert--stats-test-start-times stats))
+         (end-times (ert--stats-test-end-times stats))
+         (buffer (get-buffer-create "*ERT timings*"))
+         (data (loop for test across (ert--stats-tests stats)
+                     for start-time across (ert--stats-test-start-times stats)
+                     for end-time across (ert--stats-test-end-times stats)
+                     collect (list test
+                                   (float-time (subtract-time end-time
+                                                              start-time))))))
+    (setq data (sort data (lambda (a b)
+                            (> (second a) (second b)))))
+    (pop-to-buffer buffer)
+    (setq buffer-read-only t)
+    (let ((inhibit-read-only t))
+      (buffer-disable-undo)
+      (erase-buffer)
+      (ert-simple-view-mode)
+      (if (null data)
+          (insert "(No data)\n")
+        (insert (format "%-3s  %8s %8s\n" "" "time" "cumul"))
+        (loop for (test time) in data
+              for cumul-time = time then (+ cumul-time time)
+              for i from 1 do
+              (let ((begin (point)))
+                (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
+                (ert-insert-test-name-button (ert-test-name test))
+                (insert "\n"))))
+      (goto-char (point-min))
+      (insert "Tests by run time (seconds):\n\n")
+      (forward-line 1))))
+
+;;;###autoload
+(defun ert-describe-test (test-or-test-name)
+  "Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test)."
+  (interactive (list (ert-read-test-name-at-point "Describe test")))
+  (when (< emacs-major-version 24)
+    (error "Requires Emacs 24"))
+  (let (test-name
+        test-definition)
+    (etypecase test-or-test-name
+      (symbol (setq test-name test-or-test-name
+                    test-definition (ert-get-test test-or-test-name)))
+      (ert-test (setq test-name (ert-test-name test-or-test-name)
+                      test-definition test-or-test-name)))
+    (help-setup-xref (list #'ert-describe-test test-or-test-name)
+                     (called-interactively-p 'interactive))
+    (save-excursion
+      (with-help-window (help-buffer)
+        (with-current-buffer (help-buffer)
+          (insert (if test-name (format "%S" test-name) "<anonymous test>"))
+          (insert " is a test")
+          (let ((file-name (and test-name
+                                (symbol-file test-name 'ert-deftest))))
+            (when file-name
+              (insert " defined in `" (file-name-nondirectory file-name) "'")
+              (save-excursion
+                (re-search-backward "`\\([^`']+\\)'" nil t)
+                (help-xref-button 1 'help-function-def test-name file-name)))
+            (insert ".")
+            (fill-region-as-paragraph (point-min) (point))
+            (insert "\n\n")
+            (unless (and (ert-test-boundp test-name)
+                         (eql (ert-get-test test-name) test-definition))
+              (let ((begin (point)))
+                (insert "Note: This test has been redefined or deleted, "
+                        "this documentation refers to an old definition.")
+                (fill-region-as-paragraph begin (point)))
+              (insert "\n\n"))
+            (insert (or (ert-test-documentation test-definition)
+                        "It is not documented.")
+                    "\n")))))))
+
+(defun ert-results-describe-test-at-point ()
+  "Display the documentation of the test at point.
+
+To be used in the ERT results buffer."
+  (interactive)
+  (ert-describe-test (ert--results-test-at-point-no-redefinition)))
+
+
+;;; Actions on load/unload.
+
+(add-to-list 'find-function-regexp-alist '(ert-deftest . ert--find-test-regexp))
+(add-to-list 'minor-mode-alist '(ert--current-run-stats
+                                 (:eval
+                                  (ert--tests-running-mode-line-indicator))))
+(add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords)
+
+(defun ert--unload-function ()
+  "Unload function to undo the side-effects of loading ert.el."
+  (ert--remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car)
+  (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car)
+  (ert--remove-from-list 'emacs-lisp-mode-hook
+                         'ert--activate-font-lock-keywords)
+  nil)
+
+(defvar ert-unload-hook '())
+(add-hook 'ert-unload-hook 'ert--unload-function)
+
+
+(provide 'ert)
+
+;;; ert.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index fecddcf16ed..dfe1a4309ca 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1663,15 +1663,15 @@ A value of nil means to display all packages.")
 Optional PACKAGES is a list of names of packages (symbols) to
 list; the default is to display everything in `package-alist'."
   (require 'finder-inf nil t)
-  (with-current-buffer (get-buffer-create "*Packages*")
-    (package-menu-mode)
-    (set (make-local-variable 'package-menu-package-list) packages)
-    (set (make-local-variable 'package-menu-sort-key) nil)
-    (package--generate-package-list)
-    ;; It's okay to use pop-to-buffer here.  The package menu buffer
-    ;; has keybindings, and the user just typed `M-x list-packages',
-    ;; suggesting that they might want to use them.
-    (pop-to-buffer (current-buffer))))
+  (let ((buf (get-buffer-create "*Packages*")))
+    (with-current-buffer buf
+      (package-menu-mode)
+      (set (make-local-variable 'package-menu-package-list) packages)
+      (set (make-local-variable 'package-menu-sort-key) nil)
+      (package--generate-package-list))
+    ;; The package menu buffer has keybindings.  If the user types
+    ;; `M-x list-packages', that suggests it should become current.
+    (switch-to-buffer buf)))
 
 ;;;###autoload
 (defun list-packages ()
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index fe873297dc2..b10c3d8b9ee 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -276,13 +276,14 @@ decoration for buffers in C++ mode, and level 1 decoration otherwise."
                                       (integer :tag "level" 1)))))
   :group 'font-lock)
 
-(defcustom font-lock-verbose 0
+(defcustom font-lock-verbose nil
   "If non-nil, means show status messages for buffer fontification.
 If a number, only buffers greater than this size have fontification messages."
   :type '(choice (const :tag "never" nil)
                  (other :tag "always" t)
                  (integer :tag "size"))
-  :group 'font-lock)
+  :group 'font-lock
+  :version "24.1")
 
 
 ;; Originally these variable values were face names such as `bold' etc.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c0c6533d531..dcb2353208c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,16 @@
+2011-01-13  Chong Yidong  <cyd@stupidchicken.com>
+
+        * message.el (message-tool-bar-gnome): Tweak tool-bar items.  Add
+        :vert-only tags.
+        (message-mail): New arg RETURN-ACTION.
+        (message-return-action): New var.
+        (message-bury): Use it.
+        (message-mode): Make it buffer-local.
+        (message-send-and-exit): Always call message-bury.
+
+        * gnus-msg.el (gnus-msg-mail): New arg RETURN-ACTION.  Pass it to
+        message-mail.
+
 2011-01-11  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * nnimap.el (nnimap-convert-partial-article): Protect against
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index d66e1692a80..e352ffacef8 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -477,7 +477,7 @@ Thank you for your help in stamping out bugs.
 
 ;;;###autoload
 (defun gnus-msg-mail (&optional to subject other-headers continue
-                                switch-action yank-action send-actions)
+                      switch-action yank-action send-actions return-action)
   "Start editing a mail message to be sent.
 Like `message-mail', but with Gnus paraphernalia, particularly the
 Gcc: header for archiving purposes."
@@ -486,7 +486,7 @@ Gcc: header for archiving purposes."
         mail-buf)
     (gnus-setup-message 'message
       (message-mail to subject other-headers continue
-                    nil yank-action send-actions))
+                    nil yank-action send-actions return-action))
     (when switch-action
       (setq mail-buf (current-buffer))
       (switch-to-buffer buf)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 78652fb2ee0..e8b6d141720 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1120,6 +1120,8 @@ It is a vector of the following headers:
 (defvar message-checksum nil)
 (defvar message-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
+(defvar message-return-action nil
+  "Action to return to the caller after sending or postphoning a message.")
 (defvar message-exit-actions nil
   "A list of actions to be performed upon exiting after sending a message.")
 (defvar message-kill-actions nil
@@ -2863,6 +2865,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (set (make-local-variable 'message-reply-buffer) nil)
   (set (make-local-variable 'message-inserted-headers) nil)
   (set (make-local-variable 'message-send-actions) nil)
+  (set (make-local-variable 'message-return-action) nil)
   (set (make-local-variable 'message-exit-actions) nil)
   (set (make-local-variable 'message-kill-actions) nil)
   (set (make-local-variable 'message-postpone-actions) nil)
@@ -3955,11 +3958,9 @@ The text will also be indented the normal way."
         (actions message-exit-actions))
     (when (and (message-send arg)
                (buffer-name buf))
+      (message-bury buf)
       (if message-kill-buffer-on-exit
-          (kill-buffer buf)
-        (bury-buffer buf)
-        (when (eq buf (current-buffer))
-          (message-bury buf)))
+          (kill-buffer buf))
       (message-do-actions actions)
       t)))
 
@@ -4009,9 +4010,8 @@ Instead, just auto-save the buffer and then bury it."
   "Bury this mail BUFFER."
   (let ((newbuf (other-buffer buffer)))
     (bury-buffer buffer)
-    (if (and (window-dedicated-p (selected-window))
-             (not (null (delq (selected-frame) (visible-frame-list)))))
-        (delete-frame (selected-frame))
+    (if message-return-action
+        (apply (car message-return-action) (cdr message-return-action))
       (switch-to-buffer newbuf))))
 
 (defun message-send (&optional arg)
@@ -6304,11 +6304,11 @@ between beginning of field and beginning of line."
 ;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
 ;; form (FUNCTION . ARGS).
 (defun message-setup (headers &optional yank-action actions
-                              continue switch-function)
+                              continue switch-function return-action)
   (let ((mua (message-mail-user-agent))
         subject to field)
     (if (not (and message-this-is-mail mua))
-        (message-setup-1 headers yank-action actions)
+        (message-setup-1 headers yank-action actions return-action)
       (setq headers (copy-sequence headers))
       (setq field (assq 'Subject headers))
       (when field
@@ -6356,11 +6356,12 @@ are not included."
         (push header result)))
     (nreverse result)))
 
-(defun message-setup-1 (headers &optional yank-action actions)
+(defun message-setup-1 (headers &optional yank-action actions return-action)
   (dolist (action actions)
     (condition-case nil
         (add-to-list 'message-send-actions
                      `(apply ',(car action) ',(cdr action)))))
+  (setq message-return-action return-action)
   (setq message-reply-buffer
         (if (and (consp yank-action)
                  (eq (car yank-action) 'insert-buffer))
@@ -6489,9 +6490,9 @@ are not included."
 ;;;
 
 ;;;###autoload
-(defun message-mail (&optional to subject
-                               other-headers continue switch-function
-                               yank-action send-actions)
+(defun message-mail (&optional to subject other-headers continue
+                               switch-function yank-action send-actions
+                               return-action &rest ignored)
   "Start editing a mail message to be sent.
 OTHER-HEADERS is an alist of header/value pairs.  CONTINUE says whether
 to continue editing a message already being composed.  SWITCH-FUNCTION
@@ -6512,7 +6513,8 @@ is a function used to switch to and display the mail buffer."
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
       (when other-headers other-headers))
-     yank-action send-actions continue switch-function)
+     yank-action send-actions continue switch-function
+     return-action)
     ;; FIXME: Should return nil if failure.
     t))
 
@@ -7642,24 +7644,22 @@ Pre-defined symbols include `message-tool-bar-gnome' and
 
 (defcustom message-tool-bar-gnome
   '((ispell-message "spell" nil
+                    :vert-only t
                     :visible (or (not (boundp 'flyspell-mode))
                                  (not flyspell-mode)))
     (flyspell-buffer "spell" t
+                     :vert-only t
                      :visible (and (boundp 'flyspell-mode)
                                    flyspell-mode)
                      :help "Flyspell whole buffer")
-    (gmm-ignore "separator")
-    (message-send-and-exit "mail/send")
+    (message-send-and-exit "mail/send" t :label "Send")
     (message-dont-send "mail/save-draft")
-    (message-kill-buffer "close") ;; stock_cancel
-    (mml-attach-file "attach" mml-mode-map)
+    (mml-attach-file "attach" mml-mode-map :vert-only t)
     (mml-preview "mail/preview" mml-mode-map)
     (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
     (message-insert-importance-high "important" nil :visible nil)
     (message-insert-importance-low "unimportant" nil :visible nil)
-    (message-insert-disposition-notification-to "receipt" nil :visible nil)
-    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
-    (message-info "help" t :help "Message manual"))
+    (message-insert-disposition-notification-to "receipt" nil :visible nil))
   "List of items for the message tool bar (GNOME style).
 
 See `gmm-tool-bar-from-list' for details on the format of the list."
diff --git a/lisp/ido.el b/lisp/ido.el
index 84ae93142b4..502dd39e327 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1289,8 +1289,6 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
 (defun ido-may-cache-directory (&optional dir)
   (setq dir (or dir ido-current-directory))
   (cond
-   ((ido-directory-too-big-p dir)
-    nil)
    ((and (ido-is-root-directory dir)
          (or ido-enable-tramp-completion
              (memq system-type '(windows-nt ms-dos))))
@@ -1299,6 +1297,8 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
     (ido-cache-unc-valid))
    ((ido-is-ftp-directory dir)
     (ido-cache-ftp-valid))
+   ((ido-directory-too-big-p dir)
+    nil)
    (t t)))
 
 (defun ido-pp (list &optional sep)
@@ -3072,8 +3072,8 @@ If repeated, insert text from buffer instead."
   (if ido-matches
       (let ((next (cadr ido-matches)))
         (setq ido-cur-list (ido-chop ido-cur-list next))
-        (setq ido-rescan t)
-        (setq ido-rotate t))))
+        (setq ido-matches (ido-chop ido-matches next))
+        (setq ido-rescan nil))))
 
 (defun ido-prev-match ()
   "Put last element of `ido-matches' at the front of the list."
@@ -3081,8 +3081,8 @@ If repeated, insert text from buffer instead."
   (if ido-matches
       (let ((prev (car (last ido-matches))))
         (setq ido-cur-list (ido-chop ido-cur-list prev))
-        (setq ido-rescan t)
-        (setq ido-rotate t))))
+        (setq ido-matches (ido-chop ido-matches prev))
+        (setq ido-rescan nil))))
 
 (defun ido-next-match-dir ()
   "Find next directory in match list.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 250481c20b5..1697bce91a5 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -3441,30 +3441,62 @@ does not pop any summary buffer."
 ;;;; *** Rmail Mailing Commands ***
 
 (defun rmail-start-mail (&optional noerase to subject in-reply-to cc
-                                   replybuffer sendactions same-window others)
-  (let (yank-action)
+                                   replybuffer sendactions same-window
+                                   other-headers)
+  (let ((switch-function
+         (cond (same-window nil)
+               (rmail-mail-new-frame 'switch-to-buffer-other-frame)
+               (t 'switch-to-buffer-other-window)))
+        yank-action)
     (if replybuffer
         ;; The function used here must behave like insert-buffer wrt
         ;; point and mark (see doc of sc-cite-original).
         (setq yank-action (list 'insert-buffer replybuffer)))
-    (setq others (cons (cons "cc" cc) others))
-    (setq others (cons (cons "in-reply-to" in-reply-to) others))
-    (if same-window
-        (compose-mail to subject others
-                      noerase nil
-                      yank-action sendactions)
-      (if rmail-mail-new-frame
-          (prog1
-              (compose-mail to subject others
-                            noerase 'switch-to-buffer-other-frame
-                            yank-action sendactions)
-            ;; This is not a standard frame parameter;
-            ;; nothing except sendmail.el looks at it.
-            (modify-frame-parameters (selected-frame)
-                                     '((mail-dedicated-frame . t))))
-        (compose-mail to subject others
-                      noerase 'switch-to-buffer-other-window
-                      yank-action sendactions)))))
+    (push (cons "cc" cc) other-headers)
+    (push (cons "in-reply-to" in-reply-to) other-headers)
+    (prog1
+        (compose-mail to subject other-headers noerase
+                      switch-function yank-action sendactions
+                      '(rmail-mail-return))
+      (if (eq switch-function 'switch-to-buffer-other-frame)
+          ;; This is not a standard frame parameter; nothing except
+          ;; sendmail.el looks at it.
+          (modify-frame-parameters (selected-frame)
+                                   '((mail-dedicated-frame . t)))))))
+
+(defun rmail-mail-return ()
+  (cond
+   ;; If there is only one visible frame with no special handling,
+   ;; consider deleting the mail window to return to Rmail.
+   ((or (null (delq (selected-frame) (visible-frame-list)))
+        (not (or (window-dedicated-p (frame-selected-window))
+                 (and pop-up-frames (one-window-p))
+                 (cdr (assq 'mail-dedicated-frame
+                            (frame-parameters))))))
+    (let (rmail-flag summary-buffer)
+      (and (not (one-window-p))
+           (with-current-buffer
+               (window-buffer (next-window (selected-window) 'not))
+             (setq rmail-flag (eq major-mode 'rmail-mode))
+             (setq summary-buffer
+                   (and (boundp 'mail-bury-selects-summary)
+                        mail-bury-selects-summary
+                        (boundp 'rmail-summary-buffer)
+                        rmail-summary-buffer
+                        (buffer-name rmail-summary-buffer)
+                        (not (get-buffer-window rmail-summary-buffer))
+                        rmail-summary-buffer))))
+      (if rmail-flag
+          ;; If the Rmail buffer has a summary, show that.
+          (if summary-buffer (switch-to-buffer summary-buffer)
+            (delete-window)))))
+   ;; If the frame was probably made for this buffer, the user
+   ;; probably wants to delete it now.
+   ((display-multi-frame-p)
+    (delete-frame (selected-frame)))
+   ;; The previous frame is where normally they have the Rmail buffer
+   ;; displayed.
+   (t (other-frame -1))))
 
 (defun rmail-mail ()
   "Send mail in another window.
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index ca91d9512ee..4fa513089bc 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -419,8 +419,7 @@ in `message-auto-save-directory'."
 (defvar mail-reply-action nil)
 (defvar mail-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
-(put 'mail-reply-action 'permanent-local t)
-(put 'mail-send-actions 'permanent-local t)
+(defvar mail-return-action nil)
 
 ;;;###autoload
 (defcustom mail-default-headers nil
@@ -521,7 +520,46 @@ by Emacs.)")
           (setq mail-alias-modtime modtime
                 mail-aliases t)))))
 
-(defun mail-setup (to subject in-reply-to cc replybuffer actions)
+
+;;;###autoload
+(define-mail-user-agent 'sendmail-user-agent
+  'sendmail-user-agent-compose
+  'mail-send-and-exit)
+
+;;;###autoload
+(defun sendmail-user-agent-compose (&optional to subject other-headers
+                                    continue switch-function yank-action
+                                    send-actions return-action
+                                    &rest ignored)
+  (if switch-function
+      (let ((special-display-buffer-names nil)
+            (special-display-regexps nil)
+            (same-window-buffer-names nil)
+            (same-window-regexps nil))
+        (funcall switch-function "*mail*")))
+  (let ((cc (cdr (assoc-string "cc" other-headers t)))
+        (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
+        (body (cdr (assoc-string "body" other-headers t))))
+    (or (mail continue to subject in-reply-to cc yank-action
+              send-actions return-action)
+        continue
+        (error "Message aborted"))
+    (save-excursion
+      (rfc822-goto-eoh)
+      (while other-headers
+        (unless (member-ignore-case (car (car other-headers))
+                                    '("in-reply-to" "cc" "body"))
+          (insert (car (car other-headers)) ": "
+                  (cdr (car other-headers))
+                  (if use-hard-newlines hard-newline "\n")))
+        (setq other-headers (cdr other-headers)))
+      (when body
+        (forward-line 1)
+        (insert body))
+      t)))
+
+(defun mail-setup (to subject in-reply-to cc replybuffer
+                   actions return-action)
   (or mail-default-reply-to
       (setq mail-default-reply-to (getenv "REPLYTO")))
   (sendmail-sync-aliases)
@@ -537,8 +575,12 @@ by Emacs.)")
   (set-buffer-multibyte (default-value 'enable-multibyte-characters))
   (if current-input-method
       (inactivate-input-method))
+
+  ;; Local variables for Mail mode.
   (setq mail-send-actions actions)
   (setq mail-reply-action replybuffer)
+  (setq mail-return-action return-action)
+
   (goto-char (point-min))
   (if mail-setup-with-from
       (mail-insert-from-field))
@@ -629,6 +671,7 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
 `mail-mode-hook' (in that order)."
   (make-local-variable 'mail-reply-action)
   (make-local-variable 'mail-send-actions)
+  (make-local-variable 'mail-return-action)
   (setq buffer-offer-save t)
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(mail-font-lock-keywords t t))
@@ -762,39 +805,9 @@ Prefix arg means don't delete this window."
   "Bury this mail buffer."
   (let ((newbuf (other-buffer (current-buffer))))
     (bury-buffer (current-buffer))
-    (if (and (or nil
-                 ;; In this case, we need to go to a different frame.
-                 (window-dedicated-p (frame-selected-window))
-                 ;; In this mode of operation, the frame was probably
-                 ;; made for this buffer, so the user probably wants
-                 ;; to delete it now.
-                 (and pop-up-frames (one-window-p))
-                 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
-             (not (null (delq (selected-frame) (visible-frame-list)))))
-        (progn
-          (if (display-multi-frame-p)
-              (delete-frame (selected-frame))
-            ;; The previous frame is where normally they have the
-            ;; Rmail buffer displayed.
-            (other-frame -1)))
-      (let (rmail-flag summary-buffer)
-        (and (not arg)
-             (not (one-window-p))
-             (with-current-buffer
-                 (window-buffer (next-window (selected-window) 'not))
-               (setq rmail-flag (eq major-mode 'rmail-mode))
-               (setq summary-buffer
-                     (and mail-bury-selects-summary
-                          (boundp 'rmail-summary-buffer)
-                          rmail-summary-buffer
-                          (buffer-name rmail-summary-buffer)
-                          (not (get-buffer-window rmail-summary-buffer))
-                          rmail-summary-buffer))))
-        (if rmail-flag
-            ;; If the Rmail buffer has a summary, show that.
-            (if summary-buffer (switch-to-buffer summary-buffer)
-              (delete-window))
-          (switch-to-buffer newbuf))))))
+    (if (and (null arg) mail-return-action)
+        (apply (car mail-return-action) (cdr mail-return-action))
+      (switch-to-buffer newbuf))))
 
 (defcustom mail-send-hook nil
   "Hook run just before sending a message."
@@ -1643,7 +1656,8 @@ If the current line has `mail-yank-prefix', insert it on the new line."
 ;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*unsent mail*"))
 
 ;;;###autoload
-(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
+(defun mail (&optional noerase to subject in-reply-to cc replybuffer
+                       actions return-action)
   "Edit a message to be sent.  Prefix arg means resume editing (don't erase).
 When this function returns, the buffer `*mail*' is selected.
 The value is t if the message was newly initialized; otherwise, nil.
@@ -1691,49 +1705,6 @@ The seventh argument ACTIONS is a list of actions to take
  when the message is sent, we apply FUNCTION to ARGS.
  This is how Rmail arranges to mark messages `answered'."
   (interactive "P")
- ;; This is commented out because I found it was confusing in practice.
- ;; It is easy enough to rename *mail* by hand with rename-buffer
- ;; if you want to have multiple mail buffers.
- ;; And then you can control which messages to save. --rms.
- ;; (let ((index 1)
- ;;        buffer)
- ;;   ;; If requested, look for a mail buffer that is modified and go to it.
- ;;   (if noerase
- ;;        (progn
- ;;          (while (and (setq buffer
- ;;                         (get-buffer (if (= 1 index) "*mail*"
- ;;                                       (format "*mail*<%d>" index))))
- ;;                   (not (buffer-modified-p buffer)))
- ;;            (setq index (1+ index)))
- ;;          (if buffer (switch-to-buffer buffer)
- ;;            ;; If none exists, start a new message.
- ;;            ;; This will never re-use an existing unmodified mail buffer
- ;;            ;; (since index is not 1 anymore).  Perhaps it should.
- ;;            (setq noerase nil))))
- ;;   ;; Unless we found a modified message and are happy, start a new message.
- ;;   (if (not noerase)
- ;;        (progn
- ;;          ;; Look for existing unmodified mail buffer.
- ;;          (while (and (setq buffer
- ;;                         (get-buffer (if (= 1 index) "*mail*"
- ;;                                       (format "*mail*<%d>" index))))
- ;;                   (buffer-modified-p buffer))
- ;;            (setq index (1+ index)))
- ;;          ;; If none, make a new one.
- ;;          (or buffer
- ;;              (setq buffer (generate-new-buffer "*mail*")))
- ;;          ;; Go there and initialize it.
- ;;          (switch-to-buffer buffer)
- ;;          (erase-buffer)
- ;;         (setq default-directory (expand-file-name "~/"))
- ;;         (auto-save-mode auto-save-default)
- ;;         (mail-mode)
- ;;         (mail-setup to subject in-reply-to cc replybuffer actions)
- ;;          (if (and buffer-auto-save-file-name
- ;;                (file-exists-p buffer-auto-save-file-name))
- ;;              (message "Auto save file for draft message exists; consider M-x mail-recover"))
- ;;         t))
-
   (if (eq noerase 'new)
       (pop-to-buffer (generate-new-buffer "*mail*"))
     (and noerase
@@ -1772,7 +1743,8 @@ The seventh argument ACTIONS is a list of actions to take
              t))
          (let ((inhibit-read-only t))
            (erase-buffer)
-           (mail-setup to subject in-reply-to cc replybuffer actions)
+           (mail-setup to subject in-reply-to cc replybuffer actions
+                       return-action)
            (setq initialized t)))
     (if (and buffer-auto-save-file-name
              (file-exists-p buffer-auto-save-file-name))
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 7babd41b69d..2fe5f94ac7f 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -584,18 +584,15 @@ Do the same for the keys of the same name."
 
 (defvar menu-bar-custom-menu (make-sparse-keymap "Customize"))
 
-(define-key menu-bar-custom-menu [customize-apropos-groups]
-  `(menu-item ,(purecopy "Groups Matching Regexp...") customize-apropos-groups
-              :help ,(purecopy "Browse groups whose names match regexp")))
 (define-key menu-bar-custom-menu [customize-apropos-faces]
-  `(menu-item ,(purecopy "Faces Matching Regexp...") customize-apropos-faces
-              :help ,(purecopy "Browse faces whose names match regexp")))
+  `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces
+              :help ,(purecopy "Browse faces matching a regexp or word list")))
 (define-key menu-bar-custom-menu [customize-apropos-options]
-  `(menu-item ,(purecopy "Options Matching Regexp...") customize-apropos-options
-              :help ,(purecopy "Browse options whose names match regexp")))
+  `(menu-item ,(purecopy "Options Matching...") customize-apropos-options
+              :help ,(purecopy "Browse options matching a regexp or word list")))
 (define-key menu-bar-custom-menu [customize-apropos]
-  `(menu-item ,(purecopy "Settings Matching Regexp...") customize-apropos
-              :help ,(purecopy "Browse customizable settings whose names match regexp")))
+  `(menu-item ,(purecopy "All Settings Matching...") customize-apropos
+              :help ,(purecopy "Browse customizable settings matching a regexp or word list")))
 (define-key menu-bar-custom-menu [separator-1]
   menu-bar-separator)
 (define-key menu-bar-custom-menu [customize-group]
@@ -623,6 +620,9 @@ Do the same for the keys of the same name."
 (define-key menu-bar-custom-menu [customize]
   `(menu-item ,(purecopy "Top-level Customization Group") customize
               :help ,(purecopy "The master group called `Emacs'")))
+(define-key menu-bar-custom-menu [customize-themes]
+  `(menu-item ,(purecopy "Custom Themes") customize-themes
+              :help ,(purecopy "Choose a pre-defined customization theme")))
 
 ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
 
@@ -1144,7 +1144,7 @@ mail status in mode line"))
   ;; It is better not to use backquote here,
   ;; because that makes a bootstrapping problem
   ;; if you need to recompile all the Lisp files using interpreted code.
-  `(menu-item ,(purecopy "Mule (Multilingual Environment)") ,mule-menu-keymap
+  `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap
 ;; Most of the MULE menu actually does make sense in unibyte mode,
 ;; e.g. language selection.
 ;;;     :visible '(default-value 'enable-multibyte-characters)
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 336fd0100c1..d6cc987bf41 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,7 @@
+2011-01-13  Chong Yidong  <cyd@stupidchicken.com>
+
+        * mh-comp.el (mh-user-agent-compose): New arg RETURN-ACTION.
+
 2010-11-07  Glenn Morris  <rgm@gnu.org>
 
         * mh-seq.el (mh-read-msg-list): Use point-at-eol.
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 762aad86080..b2de7ab706e 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -199,7 +199,8 @@ applications should use `mh-user-agent-compose'."
 ;;;###autoload
 (defun mh-user-agent-compose (&optional to subject other-headers continue
                                         switch-function yank-action
-                                        send-actions)
+                                        send-actions return-action
+                                        &rest ignored)
   "Set up mail composition draft with the MH mail system.
 This is the `mail-user-agent' entry point to MH-E. This function
 conforms to the contract specified by `define-mail-user-agent'
@@ -213,8 +214,8 @@ OTHER-HEADERS is an alist specifying additional header fields.
 Elements look like (HEADER . VALUE) where both HEADER and VALUE
 are strings.
 
-CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
-ignored."
+CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
+RETURN-ACTION are ignored."
   (mh-find-path)
   (let ((mh-error-if-no-draft t))
     (mh-send to "" subject)
diff --git a/lisp/simple.el b/lisp/simple.el
index ca365e9f854..57ef84882d0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5712,10 +5712,6 @@ appears to have customizations applying to the old default,
   :version "23.2"
   :group 'mail)
 
-(define-mail-user-agent 'sendmail-user-agent
-  'sendmail-user-agent-compose
-  'mail-send-and-exit)
-
 (defun rfc822-goto-eoh ()
   ;; Go to header delimiter line in a mail message, following RFC822 rules
   (goto-char (point-min))
@@ -5723,37 +5719,9 @@ appears to have customizations applying to the old default,
          "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
     (goto-char (match-beginning 0))))
 
-(defun sendmail-user-agent-compose (&optional to subject other-headers continue
-                                              switch-function yank-action
-                                              send-actions)
-  (if switch-function
-      (let ((special-display-buffer-names nil)
-            (special-display-regexps nil)
-            (same-window-buffer-names nil)
-            (same-window-regexps nil))
-        (funcall switch-function "*mail*")))
-  (let ((cc (cdr (assoc-string "cc" other-headers t)))
-        (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
-        (body (cdr (assoc-string "body" other-headers t))))
-    (or (mail continue to subject in-reply-to cc yank-action send-actions)
-        continue
-        (error "Message aborted"))
-    (save-excursion
-      (rfc822-goto-eoh)
-      (while other-headers
-        (unless (member-ignore-case (car (car other-headers))
-                                    '("in-reply-to" "cc" "body"))
-            (insert (car (car other-headers)) ": "
-                    (cdr (car other-headers))
-                    (if use-hard-newlines hard-newline "\n")))
-        (setq other-headers (cdr other-headers)))
-      (when body
-        (forward-line 1)
-        (insert body))
-      t)))
-
 (defun compose-mail (&optional to subject other-headers continue
-                               switch-function yank-action send-actions)
+                     switch-function yank-action send-actions
+                     return-action)
   "Start composing a mail message to send.
 This uses the user's chosen mail composition package
 as selected with the variable `mail-user-agent'.
@@ -5778,7 +5746,12 @@ FUNCTION to ARGS, to insert the raw text of the original message.
 original text has been inserted in this way.)
 
 SEND-ACTIONS is a list of actions to call when the message is sent.
-Each action has the form (FUNCTION . ARGS)."
+Each action has the form (FUNCTION . ARGS).
+
+RETURN-ACTION, if non-nil, is an action for returning to the
+caller.  It has the form (FUNCTION . ARGS).  The function is
+called after the mail has been sent or put aside, and the mail
+buffer buried."
   (interactive
    (list nil nil nil current-prefix-arg))
 
@@ -5808,25 +5781,27 @@ To disable this warning, set `compose-mail-user-agent-warnings' to nil."
                                                warn-vars " "))))))
 
   (let ((function (get mail-user-agent 'composefunc)))
-    (funcall function to subject other-headers continue
-             switch-function yank-action send-actions)))
+    (funcall function to subject other-headers continue switch-function
+             yank-action send-actions return-action)))
 
 (defun compose-mail-other-window (&optional to subject other-headers continue
-                                            yank-action send-actions)
+                                            yank-action send-actions
+                                            return-action)
   "Like \\[compose-mail], but edit the outgoing message in another window."
-  (interactive
-   (list nil nil nil current-prefix-arg))
+  (interactive (list nil nil nil current-prefix-arg))
   (compose-mail to subject other-headers continue
-                'switch-to-buffer-other-window yank-action send-actions))
-
+                'switch-to-buffer-other-window yank-action send-actions
+                return-action))
 
 (defun compose-mail-other-frame (&optional to subject other-headers continue
-                                            yank-action send-actions)
+                                            yank-action send-actions
+                                            return-action)
   "Like \\[compose-mail], but edit the outgoing message in another frame."
-  (interactive
-   (list nil nil nil current-prefix-arg))
+  (interactive (list nil nil nil current-prefix-arg))
   (compose-mail to subject other-headers continue
-                'switch-to-buffer-other-frame yank-action send-actions))
+                'switch-to-buffer-other-frame yank-action send-actions
+                return-action))
+
 
 (defvar set-variable-value-history nil
   "History of values entered with `set-variable'.
diff --git a/src/image.c b/src/image.c
index 1125309a9f7..023c9763abd 100644
--- a/src/image.c
+++ b/src/image.c
@@ -7519,7 +7519,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
      image to see how many sub-images it contains. Pinging is faster
      than loading the image to find out things about it.  */
 
-  /* MagickWandGenesis() initializes the imagemagick library.  */
+  /* `MagickWandGenesis' initializes the imagemagick environment.  */
   MagickWandGenesis ();
   image = image_spec_value (img->spec, QCindex, NULL);
   ino = INTEGERP (image) ? XFASTINT (image) : 0;
@@ -7807,6 +7807,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
 
   /* Final cleanup. image_wand should be the only resource left. */
   DestroyMagickWand (image_wand);
+  /* `MagickWandTerminus' terminates the imagemagick environment.  */
   MagickWandTerminus ();
 
   return 1;
diff --git a/test/ChangeLog b/test/ChangeLog
index 3b1921c5987..695a51b7f4f 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,11 @@
+2011-01-13  Christian Ohler  <ohler@gnu.org>
+
+        * automated: New directory for automated tests.
+
+        * automated/ert-tests.el, automated/ert-x-tests.el: New files.
+
+        * automated/Makefile.in: New file.
+
 2010-11-11  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * indent/modula2.mod: New file.
diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in
new file mode 100644
index 00000000000..80a853056b1
--- /dev/null
+++ b/test/automated/Makefile.in
@@ -0,0 +1,158 @@
+# Maintenance productions for the automated test directory
+# Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+
+# This file is part of GNU Emacs.
+
+# GNU Emacs 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.
+
+# GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+SHELL = /bin/sh
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+abs_top_builddir = @abs_top_builddir@
+test = $(srcdir)
+VPATH = $(srcdir)
+lispsrc = $(top_srcdir)/lisp
+lisp = ${abs_top_builddir}/lisp
+
+# You can specify a different executable on the make command line,
+# e.g. "make EMACS=../src/emacs ...".
+
+# We sometimes change directory before running Emacs (typically when
+# building out-of-tree, we chdir to the source directory), so we need
+# to use an absolute file name.
+EMACS = ${abs_top_builddir}/src/emacs
+
+# Command line flags for Emacs.
+
+EMACSOPT = -batch --no-site-file --no-site-lisp
+
+# Extra flags to pass to the byte compiler
+BYTE_COMPILE_EXTRA_FLAGS =
+# For example to not display the undefined function warnings you can use this:
+# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
+# The example above is just for developers, it should not be used by default.
+
+# The actual Emacs command run in the targets below.
+emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT)
+
+# Common command to find subdirectories
+setwins=subdirs=`(find . -type d -print)`; \
+        for file in $$subdirs; do \
+           case $$file in */.* | */.*/* | */=* ) ;; \
+                *) wins="$$wins $$file" ;; \
+           esac; \
+        done
+
+all: test
+
+doit:
+
+
+# Files MUST be compiled one by one. If we compile several files in a
+# row (i.e., in the same instance of Emacs) we can't make sure that
+# the compilation environment is clean.  We also set the load-path of
+# the Emacs used for compilation to the current directory and its
+# subdirectories, to make sure require's and load's in the files being
+# compiled find the right files.
+
+.SUFFIXES: .elc .el
+
+# An old-fashioned suffix rule, which, according to the GNU Make manual,
+# cannot have prerequisites.
+.el.elc:
+        @echo Compiling $<
+        @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $<
+
+.PHONY: lisp-compile compile-main compile compile-always
+
+lisp-compile:
+        cd $(lisp); $(MAKE) $(MFLAGS) compile EMACS=$(EMACS)
+
+# In `compile-main' we could directly do
+#    ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)"
+# and it works, but it generates a lot of messages like
+#    make[2]: « gnus/gnus-mlspl.elc » is up to date.
+# so instead, we use "xargs echo" to split the list of file into manageable
+# chunks and then use an intermediate `compile-targets' target so the
+# actual targets (the .elc files) are not mentioned as targets on the
+# make command line.
+
+
+.PHONY: compile-targets
+# TARGETS is set dynamically in the recursive call from `compile-main'.
+compile-targets: $(TARGETS)
+
+# Compile all the Elisp files that need it.  Beware: it approximates
+# `no-byte-compile', so watch out for false-positives!
+compile-main: compile-clean lisp-compile
+        @(cd $(test); $(setwins); \
+        els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
+        for el in $$els; do \
+          test -f $$el || continue; \
+          test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \
+          echo "$${el}c"; \
+        done | xargs echo) | \
+        while read chunk; do \
+          $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \
+        done
+
+.PHONY: compile-clean
+# Erase left-over .elc files that do not have a corresponding .el file.
+compile-clean:
+        @cd $(test); $(setwins); \
+        elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \
+        for el in $$(echo $$elcs | sed -e 's/\.elc/\.el/g'); do \
+          if test -f "$$el" -o \! -f "$${el}c"; then :; else \
+            echo rm "$${el}c"; \
+            rm "$${el}c"; \
+          fi \
+        done
+
+# Compile all Lisp files, but don't recompile those that are up to
+# date.  Some .el files don't get compiled because they set the
+# local variable no-byte-compile.
+# Calling make recursively because suffix rule cannot have prerequisites.
+# Explicitly pass EMACS (sometimes ../src/bootstrap-emacs) to those
+# sub-makes that run rules that use it, for the sake of some non-GNU makes.
+compile: $(LOADDEFS) autoloads compile-first
+        $(MAKE) $(MFLAGS) compile-main EMACS=$(EMACS)
+
+# Compile all Lisp files.  This is like `compile' but compiles files
+# unconditionally.  Some files don't actually get compiled because they
+# set the local variable no-byte-compile.
+compile-always: doit
+        cd $(test); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
+        $(MAKE) $(MFLAGS) compile EMACS=$(EMACS)
+
+bootstrap-clean:
+        cd $(test); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
+
+distclean:
+        -rm -f ./Makefile
+
+maintainer-clean: distclean bootstrap-clean
+
+check: compile-main
+        @(cd $(test); $(setwins); \
+        pattern=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
+        for el in $$pattern; do \
+          test -f $$el || continue; \
+          args="$$args -l $$el"; \
+          els="$$els $$el"; \
+        done; \
+        echo Testing $$els; \
+        $(emacs) $$args -f ert-run-tests-batch-and-exit)
+
+# Makefile ends here.
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el
new file mode 100644
index 00000000000..3c9e2fef0c7
--- /dev/null
+++ b/test/automated/ert-tests.el
@@ -0,0 +1,949 @@
+;;; ert-tests.el --- ERT's self-tests
+
+;; Copyright (C) 2007, 2008, 2010, 2011 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:
+
+(eval-when-compile
+  (require 'cl))
+(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*")))
+        (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."
+  (lexical-let ((was-run nil))
+    (let ((test (make-ert-test :body (lambda ()
+                                       (setq was-run t)))))
+      (assert (not was-run))
+      (ert-run-test test)
+      (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)))
+      (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))))
+      (assert (ert-test-failed-p result) t)
+      (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))
+          (assert nil))
+      ((error)
+       (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 debugger-args)
+                      (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")))))
+    (block nil
+      (let ((debugger (lambda (&rest debugger-args)
+                        (return-from nil nil))))
+        (let ((ert-debug-on-error t))
+          (ert-run-test test))
+        (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 debugger-args)
+                      (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"))))))
+    (block nil
+      (let ((debugger (lambda (&rest debugger-args)
+                        (return-from nil nil))))
+        (let ((ert-debug-on-error t))
+          (ert-run-test test))
+        (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))))
+      (assert (ert-test-failed-p result) t)
+      (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))
+          (assert nil))
+      ((error)
+       (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))))
+      (assert (ert-test-failed-p result) t)
+      (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)))
+      (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))))
+      (assert (ert-test-failed-p result) t)
+      (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)))
+      (assert (ert-test-passed-p result)))))
+
+(ert-deftest ert-test-should-with-macrolet ()
+  (let ((test (make-ert-test :body (lambda ()
+                                     (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 signalled 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 signalled 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 signalled 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 signalled was a subtype of the expected type")))))
+    ))
+
+(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."
+  (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))
+                (assert nil))
+            ((error)
+             (should (equal actual-condition expected-condition)))))))
+
+(ert-deftest ert-test-deftest ()
+  (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
+                 '(progn
+                    (ert-set-test 'abc
+                                  (make-ert-test :name 'abc
+                                                 :documentation "foo"
+                                                 :tags '(bar)
+                                                 :body (lambda ())))
+                    (push '(ert-deftest . abc) current-load-list)
+                    'abc)))
+  (should (equal (macroexpand '(ert-deftest def ()
+                                 :expected-result ':passed))
+                 '(progn
+                    (ert-set-test 'def
+                                  (make-ert-test :name 'def
+                                                 :expected-result-type ':passed
+                                                 :body (lambda ())))
+                    (push '(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 "  signal(ert-test-failed (\"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)) (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")))))
+    (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) buffer-name
+                 mock-message-fn)
+                (should (equal messages `(,(concat
+                                            "Ran 2 tests, 1 results were "
+                                            "as expected, 1 unexpected"))))
+                (with-current-buffer buffer-name
+                  (goto-char (point-min))
+                  (should (equal
+                           (buffer-substring (point-min)
+                                             (save-excursion
+                                               (forward-line 4)
+                                               (point)))
+                           (concat
+                            "Selector: (member <passing-test> <failing-test>)\n"
+                            "Passed: 1\n"
+                            "Failed: 1 (1 unexpected)\n"
+                            "Total:  2/2\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 (ert--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-remprop ()
+  (let ((x (ert--gensym)))
+    (should (equal (symbol-plist x) '()))
+    ;; Remove nonexistent property on empty plist.
+    (ert--remprop x 'b)
+    (should (equal (symbol-plist x) '()))
+    (put x 'a 1)
+    (should (equal (symbol-plist x) '(a 1)))
+    ;; Remove nonexistent property on nonempty plist.
+    (ert--remprop x 'b)
+    (should (equal (symbol-plist x) '(a 1)))
+    (put x 'b 2)
+    (put x 'c 3)
+    (put x 'd 4)
+    (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4)))
+    ;; Remove property that is neither first nor last.
+    (ert--remprop x 'c)
+    (should (equal (symbol-plist x) '(a 1 b 2 d 4)))
+    ;; Remove last property from a plist of length >1.
+    (ert--remprop x 'd)
+    (should (equal (symbol-plist x) '(a 1 b 2)))
+    ;; Remove first property from a plist of length >1.
+    (ert--remprop x 'a)
+    (should (equal (symbol-plist x) '(b 2)))
+    ;; Remove property when there is only one.
+    (ert--remprop x 'b)
+    (should (equal (symbol-plist x) '()))))
+
+(ert-deftest ert-test-remove-if-not ()
+  (let ((list (list 'a 'b 'c 'd))
+        (i 0))
+    (let ((result (ert--remove-if-not (lambda (x)
+                                        (should (eql x (nth i list)))
+                                        (incf i)
+                                        (member i '(2 3)))
+                                      list)))
+      (should (equal i 4))
+      (should (equal result '(b c)))
+      (should (equal list '(a b c d)))))
+  (should (equal '()
+                 (ert--remove-if-not (lambda (x) (should nil)) '()))))
+
+(ert-deftest ert-test-remove* ()
+  (let ((list (list 'a 'b 'c 'd))
+        (key-index 0)
+        (test-index 0))
+    (let ((result
+           (ert--remove* 'foo list
+                         :key (lambda (x)
+                                (should (eql x (nth key-index list)))
+                                (prog1
+                                    (list key-index x)
+                                  (incf key-index)))
+                         :test
+                         (lambda (a b)
+                           (should (eql a 'foo))
+                           (should (equal b (list test-index
+                                                  (nth test-index list))))
+                           (incf test-index)
+                           (member test-index '(2 3))))))
+      (should (equal key-index 4))
+      (should (equal test-index 4))
+      (should (equal result '(a d)))
+      (should (equal list '(a b c d)))))
+  (let ((x (cons nil nil))
+        (y (cons nil nil)))
+    (should (equal (ert--remove* x (list x y))
+                   ;; or (list x), since we use `equal' -- the
+                   ;; important thing is that only one element got
+                   ;; removed, this proves that the default test is
+                   ;; `eql', not `equal'
+                   (list y)))))
+
+
+(ert-deftest ert-test-set-functions ()
+  (let ((c1 (cons nil nil))
+        (c2 (cons nil nil))
+        (sym (make-symbol "a")))
+    (let ((e '())
+          (a (list 'a 'b sym nil "" "x" c1 c2))
+          (b (list c1 'y 'b sym 'x)))
+      (should (equal (ert--set-difference e e) e))
+      (should (equal (ert--set-difference a e) a))
+      (should (equal (ert--set-difference e a) e))
+      (should (equal (ert--set-difference a a) e))
+      (should (equal (ert--set-difference b e) b))
+      (should (equal (ert--set-difference e b) e))
+      (should (equal (ert--set-difference b b) e))
+      (should (equal (ert--set-difference a b) (list 'a nil "" "x" c2)))
+      (should (equal (ert--set-difference b a) (list 'y 'x)))
+
+      ;; We aren't testing whether this is really using `eq' rather than `eql'.
+      (should (equal (ert--set-difference-eq e e) e))
+      (should (equal (ert--set-difference-eq a e) a))
+      (should (equal (ert--set-difference-eq e a) e))
+      (should (equal (ert--set-difference-eq a a) e))
+      (should (equal (ert--set-difference-eq b e) b))
+      (should (equal (ert--set-difference-eq e b) e))
+      (should (equal (ert--set-difference-eq b b) e))
+      (should (equal (ert--set-difference-eq a b) (list 'a nil "" "x" c2)))
+      (should (equal (ert--set-difference-eq b a) (list 'y 'x)))
+
+      (should (equal (ert--union e e) e))
+      (should (equal (ert--union a e) a))
+      (should (equal (ert--union e a) a))
+      (should (equal (ert--union a a) a))
+      (should (equal (ert--union b e) b))
+      (should (equal (ert--union e b) b))
+      (should (equal (ert--union b b) b))
+      (should (equal (ert--union a b) (list 'a 'b sym nil "" "x" c1 c2 'y 'x)))
+      (should (equal (ert--union b a) (list c1 'y 'b sym 'x 'a nil "" "x" c2)))
+
+      (should (equal (ert--intersection e e) e))
+      (should (equal (ert--intersection a e) e))
+      (should (equal (ert--intersection e a) e))
+      (should (equal (ert--intersection a a) a))
+      (should (equal (ert--intersection b e) e))
+      (should (equal (ert--intersection e b) e))
+      (should (equal (ert--intersection b b) b))
+      (should (equal (ert--intersection a b) (list 'b sym c1)))
+      (should (equal (ert--intersection b a) (list c1 'b sym))))))
+
+(ert-deftest ert-test-gensym ()
+  ;; Since the expansion of `should' calls `ert--gensym' and thus has a
+  ;; side-effect on `ert--gensym-counter', we have to make sure all
+  ;; macros in our test body are expanded before we rebind
+  ;; `ert--gensym-counter' and run the body.  Otherwise, the test would
+  ;; fail if run interpreted.
+  (let ((body (byte-compile
+               '(lambda ()
+                  (should (equal (symbol-name (ert--gensym)) "G0"))
+                  (should (equal (symbol-name (ert--gensym)) "G1"))
+                  (should (equal (symbol-name (ert--gensym)) "G2"))
+                  (should (equal (symbol-name (ert--gensym "foo")) "foo3"))
+                  (should (equal (symbol-name (ert--gensym "bar")) "bar4"))
+                  (should (equal ert--gensym-counter 5))))))
+    (let ((ert--gensym-counter 0))
+      (funcall body))))
+
+(ert-deftest ert-test-coerce-to-vector ()
+  (let* ((a (vector))
+         (b (vector 1 a 3))
+         (c (list))
+         (d (list b a)))
+    (should (eql (ert--coerce-to-vector a) a))
+    (should (eql (ert--coerce-to-vector b) b))
+    (should (equal (ert--coerce-to-vector c) (vector)))
+    (should (equal (ert--coerce-to-vector d) (vector b a)))))
+
+(ert-deftest ert-test-string-position ()
+  (should (eql (ert--string-position ?x "") nil))
+  (should (eql (ert--string-position ?a "abc") 0))
+  (should (eql (ert--string-position ?b "abc") 1))
+  (should (eql (ert--string-position ?c "abc") 2))
+  (should (eql (ert--string-position ?d "abc") nil))
+  (should (eql (ert--string-position ?A "abc") nil)))
+
+(ert-deftest ert-test-mismatch ()
+  (should (eql (ert--mismatch "" "") nil))
+  (should (eql (ert--mismatch "" "a") 0))
+  (should (eql (ert--mismatch "a" "a") nil))
+  (should (eql (ert--mismatch "ab" "a") 1))
+  (should (eql (ert--mismatch "Aa" "aA") 0))
+  (should (eql (ert--mismatch '(a b c) '(a b d)) 2)))
+
+(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-not-equal ()
+  (should (equal (ert--explain-not-equal nil 'foo)
+                 '(different-atoms nil foo)))
+  (should (equal (ert--explain-not-equal '(a a) '(a b))
+                 '(list-elt 1 (different-atoms a b))))
+  (should (equal (ert--explain-not-equal '(1 48) '(1 49))
+                 '(list-elt 1 (different-atoms (48 "#x30" "?0")
+                                               (49 "#x31" "?1")))))
+  (should (equal (ert--explain-not-equal 'nil '(a))
+                 '(different-types nil (a))))
+  (should (equal (ert--explain-not-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-not-equal 'a sym)
+                   `(different-symbols-with-the-same-name a ,sym)))))
+
+(ert-deftest ert-test-explain-not-equal-improper-list ()
+  (should (equal (ert--explain-not-equal '(a . b) '(a . c))
+                 '(cdr (different-atoms b c)))))
+
+(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-not-equal-string-properties ()
+  (should
+   (equal (ert--explain-not-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-not-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-not-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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))
+    (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)))))
+
+
+(provide 'ert-tests)
+
+;;; ert-tests.el ends here
diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el
new file mode 100644
index 00000000000..80fff40d86a
--- /dev/null
+++ b/test/automated/ert-x-tests.el
@@ -0,0 +1,273 @@
+;;; ert-x-tests.el --- Tests for ert-x.el
+
+;; Copyright (C) 2008, 2010, 2011 Free Software Foundation, Inc.
+
+;; Author: Phil Hagelberg
+;; 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:
+
+(eval-when-compile
+  (require 'cl))
+(require 'ert)
+(require 'ert-x)
+
+;;; Utilities
+
+(ert-deftest ert-test-buffer-string-reindented ()
+  (ert-with-test-buffer (:name "well-indented")
+    (insert (concat "(hello (world\n"
+                    "        'elisp)\n"))
+    (emacs-lisp-mode)
+    (should (equal (ert-buffer-string-reindented) (buffer-string))))
+  (ert-with-test-buffer (:name "badly-indented")
+    (insert (concat "(hello\n"
+                    "       world)"))
+    (emacs-lisp-mode)
+    (should-not (equal (ert-buffer-string-reindented) (buffer-string)))))
+
+(defun ert--hash-table-to-alist (table)
+  (let ((accu nil))
+    (maphash (lambda (key value)
+               (push (cons key value) accu))
+             table)
+    (nreverse accu)))
+
+(ert-deftest ert-test-test-buffers ()
+  (let (buffer-1
+        buffer-2)
+    (let ((test-1
+           (make-ert-test
+            :name 'test-1
+            :body (lambda ()
+                    (ert-with-test-buffer (:name "foo")
+                      (should (string-match
+                               "[*]Test buffer (ert-test-test-buffers): foo[*]"
+                               (buffer-name)))
+                      (setq buffer-1 (current-buffer))))))
+          (test-2
+           (make-ert-test
+            :name 'test-2
+            :body (lambda ()
+                    (ert-with-test-buffer (:name "bar")
+                      (should (string-match
+                               "[*]Test buffer (ert-test-test-buffers): bar[*]"
+                               (buffer-name)))
+                      (setq buffer-2 (current-buffer))
+                      (ert-fail "fail for test"))))))
+      (let ((ert--test-buffers (make-hash-table :weakness t)))
+        (ert-run-tests `(member ,test-1 ,test-2) #'ignore)
+        (should (equal (ert--hash-table-to-alist ert--test-buffers)
+                       `((,buffer-2 . t))))
+        (should-not (buffer-live-p buffer-1))
+        (should (buffer-live-p buffer-2))))))
+
+
+(ert-deftest ert-filter-string ()
+  (should (equal (ert-filter-string "foo bar baz" "quux")
+                 "foo bar baz"))
+  (should (equal (ert-filter-string "foo bar baz" "bar")
+                 "foo  baz")))
+
+(ert-deftest ert-propertized-string ()
+  (should (ert-equal-including-properties
+           (ert-propertized-string "a" '(a b) "b" '(c t) "cd")
+           #("abcd" 1 2 (a b) 2 4 (c t))))
+  (should (ert-equal-including-properties
+           (ert-propertized-string "foo " '(face italic) "bar" " baz" nil
+                                   " quux")
+           #("foo bar baz quux" 4 11 (face italic)))))
+
+
+;;; Tests for ERT itself that require test features from ert-x.el.
+
+(ert-deftest ert-test-run-tests-interactively-2 ()
+  :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-info ((propertize "foo\nbar"
+                                                                    'a 'b))
+                                              (ert-fail
+                                               "failure 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))))
+        (flet ((expected-string (with-font-lock-p)
+                 (ert-propertized-string
+                  "Selector: (member <passing-test> <failing-test>)\n"
+                  "Passed: 1\n"
+                  "Failed: 1 (1 unexpected)\n"
+                  "Total:  2/2\n\n"
+                  "Started at:\n"
+                  "Finished.\n"
+                  "Finished at:\n\n"
+                  `(category ,(button-category-symbol
+                               'ert--results-progress-bar-button)
+                             button (t)
+                             face ,(if with-font-lock-p
+                                       'ert-test-result-unexpected
+                                     'button))
+                  ".F" nil "\n\n"
+                  `(category ,(button-category-symbol
+                               'ert--results-expand-collapse-button)
+                             button (t)
+                             face ,(if with-font-lock-p
+                                       'ert-test-result-unexpected
+                                     'button))
+                  "F" nil " "
+                  `(category ,(button-category-symbol
+                               'ert--test-name-button)
+                             button (t)
+                             ert-test-name failing-test)
+                  "failing-test"
+                  nil "\n    Info: " '(a b) "foo\n"
+                  nil "          " '(a b) "bar"
+                  nil "\n    (ert-test-failed \"failure message\")\n\n\n"
+                  )))
+        (save-window-excursion
+          (unwind-protect
+              (let ((case-fold-search nil))
+                (ert-run-tests-interactively
+                 `(member ,passing-test ,failing-test) buffer-name
+                 mock-message-fn)
+                (should (equal messages `(,(concat
+                                            "Ran 2 tests, 1 results were "
+                                            "as expected, 1 unexpected"))))
+                (with-current-buffer buffer-name
+                  (font-lock-mode 0)
+                  (should (ert-equal-including-properties
+                           (ert-filter-string (buffer-string)
+                                              '("Started at:\\(.*\\)$" 1)
+                                              '("Finished at:\\(.*\\)$" 1))
+                           (expected-string nil)))
+                  ;; `font-lock-mode' only works if interactive, so
+                  ;; pretend we are.
+                  (let ((noninteractive nil))
+                    (font-lock-mode 1))
+                  (should (ert-equal-including-properties
+                           (ert-filter-string (buffer-string)
+                                              '("Started at:\\(.*\\)$" 1)
+                                              '("Finished at:\\(.*\\)$" 1))
+                           (expected-string t)))))
+            (when (get-buffer buffer-name)
+              (kill-buffer buffer-name)))))))))
+
+(ert-deftest ert-test-describe-test ()
+  "Tests `ert-describe-test'."
+  (save-window-excursion
+    (ert-with-buffer-renamed ("*Help*")
+      (if (< emacs-major-version 24)
+          (should (equal (should-error (ert-describe-test 'ert-describe-test))
+                         '(error "Requires Emacs 24")))
+        (ert-describe-test 'ert-test-describe-test)
+        (with-current-buffer "*Help*"
+          (let ((case-fold-search nil))
+            (should (string-match (concat
+                                   "\\`ert-test-describe-test is a test"
+                                   " defined in `ert-x-tests.elc?'\\.\n\n"
+                                   "Tests `ert-describe-test'\\.\n\\'")
+                                  (buffer-string)))))))))
+
+(ert-deftest ert-test-message-log-truncation ()
+  :tags '(:causes-redisplay)
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       ;; Emacs would combine messages if we
+                       ;; generate the same message multiple
+                       ;; times.
+                       (message "a")
+                       (message "b")
+                       (message "c")
+                       (message "d")))))
+    (let (result)
+      (ert-with-buffer-renamed ("*Messages*")
+        (let ((message-log-max 2))
+          (setq result (ert-run-test test)))
+        (should (equal (with-current-buffer "*Messages*"
+                         (buffer-string))
+                       "c\nd\n")))
+      (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
+
+(ert-deftest ert-test-builtin-message-log-flushing ()
+  "This test attempts to demonstrate that there is no way to
+force immediate truncation of the *Messages* buffer from Lisp
+\(and hence justifies the existence of
+`ert--force-message-log-buffer-truncation'\): The only way that
+came to my mind was \(message \"\"\), which doesn't have the
+desired effect."
+  :tags '(:causes-redisplay)
+  (ert-with-buffer-renamed ("*Messages*")
+    (with-current-buffer "*Messages*"
+      (should (equal (buffer-string) ""))
+      ;; We used to get sporadic failures in this test that involved
+      ;; a spurious newline at the beginning of the buffer, before
+      ;; the first message.  Below, we print a message and erase the
+      ;; buffer since this seems to eliminate the sporadic failures.
+      (message "foo")
+      (erase-buffer)
+      (should (equal (buffer-string) ""))
+      (let ((message-log-max 2))
+        (let ((message-log-max t))
+          (loop for i below 4 do
+                (message "%s" i))
+          (should (equal (buffer-string) "0\n1\n2\n3\n")))
+        (should (equal (buffer-string) "0\n1\n2\n3\n"))
+        (message "")
+        (should (equal (buffer-string) "0\n1\n2\n3\n"))
+        (message "Test message")
+        (should (equal (buffer-string) "3\nTest message\n"))))))
+
+(ert-deftest ert-test-force-message-log-buffer-truncation ()
+  :tags '(:causes-redisplay)
+  (labels ((body ()
+             (loop for i below 3 do
+                   (message "%s" i)))
+           ;; Uses the implicit messages buffer truncation implemented
+           ;; in Emacs' C core.
+           (c (x)
+             (ert-with-buffer-renamed ("*Messages*")
+               (let ((message-log-max x))
+                 (body))
+               (with-current-buffer "*Messages*"
+                 (buffer-string))))
+           ;; Uses our lisp reimplementation.
+           (lisp (x)
+             (ert-with-buffer-renamed ("*Messages*")
+               (let ((message-log-max t))
+                 (body))
+               (let ((message-log-max x))
+                 (ert--force-message-log-buffer-truncation))
+               (with-current-buffer "*Messages*"
+                 (buffer-string)))))
+    (loop for x in '(0 1 2 3 4 t) do
+          (should (equal (c x) (lisp x))))))
+
+
+(provide 'ert-x-tests)
+
+;;; ert-x-tests.el ends here