mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
Merge from mainline.
This commit is contained in:
Paul Eggert
commit
193770eec9
11
ChangeLog
11
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
|
||||
|
||||
@ -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
|
||||
|
||||
3
configure
vendored
3
configure
vendored
@ -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;;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
830
doc/misc/ert.texi
Normal file
830
doc/misc/ert.texi
Normal file
@ -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
|
||||
@ -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* \
|
||||
|
||||
@ -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.
|
||||
|
||||
9
etc/NEWS
9
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
|
||||
|
||||
@ -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"))))
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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" "\
|
||||
|
||||
290
lisp/emacs-lisp/ert-x.el
Normal file
290
lisp/emacs-lisp/ert-x.el
Normal file
@ -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
|
||||
2544
lisp/emacs-lisp/ert.el
Normal file
2544
lisp/emacs-lisp/ert.el
Normal file
File diff suppressed because it is too large
Load Diff
@ -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 ()
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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."
|
||||
|
||||
12
lisp/ido.el
12
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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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'.
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
158
test/automated/Makefile.in
Normal file
158
test/automated/Makefile.in
Normal file
@ -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.
|
||||
949
test/automated/ert-tests.el
Normal file
949
test/automated/ert-tests.el
Normal file
@ -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
|
||||
273
test/automated/ert-x-tests.el
Normal file
273
test/automated/ert-x-tests.el
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user