Make results details in ert-run-tests-batch configurable
* lisp/emacs-lisp/ert.el (ert-batch-print-length) (ert-batch-print-level,.ert-batch-backtrace-line-length) (ert-batch-test, ert-run-tests-interactively): Added the three variables, bound them to these settings when formatting batch test results including backtraces. Removed the optional parameters output-buffer & message-fn from ert-run-tests-interactively. * test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-interactively, ert-test-run-tests-batch): use cl-letf to capture output, new tests resp. * test/lisp/ert-x-tests.el (ert-test-run-tests-interactively-2): Changed to use cl-letf to capture output instead of using message-fn. * lisp/emacs-lisp/backtrace.el (backtrace--line-length-or-nil) (backtrace--print-func-and-args): Fixed a bug when setting backtrace-line-length to nil by adding a new function to check for that case & having backtrace--print-func-and-args use it. * doc/misc/ert.texi: document the new variables & their usage (bug#51037).
This commit is contained in:
Michael Herstine
Lars Ingebrigtsen
parent
331366395e
commit
977f102a49
6 changed files with 204 additions and 67 deletions
|
|
@ -390,12 +390,37 @@ summary as shown below:
|
|||
emacs -batch -l ert -f ert-summarize-tests-batch-and-exit output.log
|
||||
@end example
|
||||
|
||||
@vindex ert-batch-print-level
|
||||
@vindex ert-batch-print-length
|
||||
ERT attempts to limit the output size for failed tests by choosing
|
||||
conservative values for @code{print-level} and @code{print-length}
|
||||
when printing Lisp values. This can in some cases make it difficult
|
||||
to see which portions of those values are incorrect. Use
|
||||
@code{ert-batch-print-level} and @code{ert-batch-print-length}
|
||||
to customize that:
|
||||
|
||||
@example
|
||||
emacs -batch -l ert -l my-tests.el \
|
||||
--eval "(let ((ert-batch-print-level 10) \
|
||||
(ert-batch-print-length 120)) \
|
||||
(ert-run-tests-batch-and-exit))"
|
||||
@end example
|
||||
|
||||
@vindex ert-batch-backtrace-line-length
|
||||
Even modest settings for @code{print-level} and @code{print-length} can
|
||||
produce extremely long lines in backtraces, however, with attendant
|
||||
pauses in execution progress. Set
|
||||
@code{ert-batch-backtrace-line-length} to t to use the value of
|
||||
@code{backtrace-line-length}, @code{nil} to stop any limitations on backtrace
|
||||
line lengths (that is, to get full backtraces), or a positive integer to
|
||||
limit backtrace line length to that number.
|
||||
|
||||
@vindex ert-quiet
|
||||
By default, ERT in batch mode is quite verbose, printing a line with
|
||||
result after each test. This gives you progress information: how many
|
||||
tests have been executed and how many there are. However, in some
|
||||
cases this much output may be undesirable. In this case, set
|
||||
@code{ert-quiet} variable to a non-nil value:
|
||||
@code{ert-quiet} variable to a non-@code{nil} value:
|
||||
|
||||
@example
|
||||
emacs -batch -l ert -l my-tests.el \
|
||||
|
|
|
|||
7
etc/NEWS
7
etc/NEWS
|
|
@ -54,6 +54,13 @@ This is in addition to previously-supported ways of discovering 24-bit
|
|||
color support: either via the "RGB" or "setf24" capabilities, or if
|
||||
the 'COLORTERM' environment variable is set to the value "truecolor".
|
||||
|
||||
+++
|
||||
** New ERT variables 'ert-batch-print-length' and 'ert-batch-print-level'.
|
||||
These variables will override 'print-length' and 'print-level' when
|
||||
printing Lisp values in ERT batch test results.
|
||||
|
||||
** Emacs now supports Unicode Standard version 14.0.
|
||||
|
||||
** Emoji
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -55,9 +55,9 @@ order to debug the code that does fontification."
|
|||
(defcustom backtrace-line-length 5000
|
||||
"Target length for lines in Backtrace buffers.
|
||||
Backtrace mode will attempt to abbreviate printing of backtrace
|
||||
frames to make them shorter than this, but success is not
|
||||
guaranteed. If set to nil or zero, Backtrace mode will not
|
||||
abbreviate the forms it prints."
|
||||
frames by setting `print-level' and `print-length' to make them
|
||||
shorter than this, but success is not guaranteed. If set to nil
|
||||
or zero, backtrace mode will not abbreviate the forms it prints."
|
||||
:type 'integer
|
||||
:group 'backtrace
|
||||
:version "27.1")
|
||||
|
|
@ -751,6 +751,13 @@ property for use by navigation."
|
|||
(insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
|
||||
(put-text-property beg (point) 'backtrace-section 'func)))
|
||||
|
||||
(defun backtrace--line-length-or-nil ()
|
||||
"Return `backtrace-line-length' if valid, nil else."
|
||||
;; mirror the logic in `cl-print-to-string-with-limits'
|
||||
(and (natnump backtrace-line-length)
|
||||
(not (zerop backtrace-line-length))
|
||||
backtrace-line-length))
|
||||
|
||||
(defun backtrace--print-func-and-args (frame _view)
|
||||
"Print the function, arguments and buffer position of a backtrace FRAME.
|
||||
Format it according to VIEW."
|
||||
|
|
@ -769,11 +776,16 @@ Format it according to VIEW."
|
|||
(if (atom fun)
|
||||
(funcall backtrace-print-function fun)
|
||||
(insert
|
||||
(backtrace--print-to-string fun (when args (/ backtrace-line-length 2)))))
|
||||
(backtrace--print-to-string
|
||||
fun
|
||||
(when (and args (backtrace--line-length-or-nil))
|
||||
(/ backtrace-line-length 2)))))
|
||||
(if args
|
||||
(insert (backtrace--print-to-string
|
||||
args (max (truncate (/ backtrace-line-length 5))
|
||||
(- backtrace-line-length (- (point) beg)))))
|
||||
args
|
||||
(if (backtrace--line-length-or-nil)
|
||||
(max (truncate (/ backtrace-line-length 5))
|
||||
(- backtrace-line-length (- (point) beg))))))
|
||||
;; The backtrace-form property is so that backtrace-multi-line
|
||||
;; will find it. backtrace-multi-line doesn't do anything
|
||||
;; useful with it, just being consistent.
|
||||
|
|
|
|||
|
|
@ -77,6 +77,37 @@
|
|||
Use nil for no limit (caution: backtrace lines can be very long)."
|
||||
:type '(choice (const :tag "No truncation" nil) integer))
|
||||
|
||||
(defvar ert-batch-print-length 10
|
||||
"`print-length' setting used in `ert-run-tests-batch'.
|
||||
|
||||
When formatting lists in test conditions, `print-length' will be
|
||||
temporarily set to this value. See also
|
||||
`ert-batch-backtrace-line-length' for its effect on stack
|
||||
traces.")
|
||||
|
||||
(defvar ert-batch-print-level 5
|
||||
"`print-level' setting used in `ert-run-tests-batch'.
|
||||
|
||||
When formatting lists in test conditions, `print-level' will be
|
||||
temporarily set to this value. See also
|
||||
`ert-batch-backtrace-line-length' for its effect on stack
|
||||
traces.")
|
||||
|
||||
(defvar ert-batch-backtrace-line-length t
|
||||
"Target length for lines in ERT batch backtraces.
|
||||
|
||||
Even modest settings for `print-length' and `print-level' can
|
||||
produce extremely long lines in backtraces and lengthy delays in
|
||||
forming them. This variable governs the target maximum line
|
||||
length by manipulating these two variables while printing stack
|
||||
traces. Setting this variable to t will re-use the value of
|
||||
`backtrace-line-length' while print stack traces in ERT batch
|
||||
mode. A value of nil will short-circuit this mechanism; line
|
||||
lengths will be completely determined by `ert-batch-line-length'
|
||||
and `ert-batch-line-level'. Any other value will be temporarily
|
||||
bound to `backtrace-line-length' when producing stack traces
|
||||
in batch mode.")
|
||||
|
||||
(defface ert-test-result-expected '((((class color) (background light))
|
||||
:background "green1")
|
||||
(((class color) (background dark))
|
||||
|
|
@ -1402,8 +1433,7 @@ Returns the stats object."
|
|||
(ert-reason-for-test-result result)
|
||||
""))))
|
||||
(message "%s" "")))))
|
||||
(test-started
|
||||
)
|
||||
(test-started)
|
||||
(test-ended
|
||||
(cl-destructuring-bind (stats test result) event-args
|
||||
(unless (ert-test-result-expected-p test result)
|
||||
|
|
@ -1413,8 +1443,18 @@ Returns the stats object."
|
|||
(ert-test-result-with-condition
|
||||
(message "Test %S backtrace:" (ert-test-name test))
|
||||
(with-temp-buffer
|
||||
(insert (backtrace-to-string
|
||||
(ert-test-result-with-condition-backtrace result)))
|
||||
(let ((backtrace-line-length
|
||||
(cond
|
||||
((eq ert-batch-backtrace-line-length t)
|
||||
backtrace-line-length)
|
||||
((eq ert-batch-backtrace-line-length nil)
|
||||
nil)
|
||||
(t
|
||||
ert-batch-backtrace-line-length)))
|
||||
(print-level ert-batch-print-level)
|
||||
(print-length ert-batch-print-length))
|
||||
(insert (backtrace-to-string
|
||||
(ert-test-result-with-condition-backtrace result))))
|
||||
(if (not ert-batch-backtrace-right-margin)
|
||||
(message "%s"
|
||||
(buffer-substring-no-properties (point-min)
|
||||
|
|
@ -1433,8 +1473,8 @@ Returns the stats object."
|
|||
(ert--insert-infos result)
|
||||
(insert " ")
|
||||
(let ((print-escape-newlines t)
|
||||
(print-level 5)
|
||||
(print-length 10))
|
||||
(print-level ert-batch-print-level)
|
||||
(print-length ert-batch-print-length))
|
||||
(ert--pp-with-indentation-and-newline
|
||||
(ert-test-result-with-condition-condition result)))
|
||||
(goto-char (1- (point-max)))
|
||||
|
|
@ -1962,13 +2002,13 @@ otherwise."
|
|||
(ewoc-refresh ert--results-ewoc)
|
||||
(font-lock-default-function enabledp))
|
||||
|
||||
(defun ert--setup-results-buffer (stats listener buffer-name)
|
||||
(defvar ert--output-buffer-name "*ert*")
|
||||
|
||||
(defun ert--setup-results-buffer (stats listener)
|
||||
"Set up a test results buffer.
|
||||
|
||||
STATS is the stats object; LISTENER is the results listener;
|
||||
BUFFER-NAME, if non-nil, is the buffer name to use."
|
||||
(unless buffer-name (setq buffer-name "*ert*"))
|
||||
(let ((buffer (get-buffer-create buffer-name)))
|
||||
STATS is the stats object; LISTENER is the results listener."
|
||||
(let ((buffer (get-buffer-create ert--output-buffer-name)))
|
||||
(with-current-buffer buffer
|
||||
(let ((inhibit-read-only t))
|
||||
(buffer-disable-undo)
|
||||
|
|
@ -2000,18 +2040,11 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
|
|||
(defvar ert--selector-history nil
|
||||
"List of recent test selectors read from terminal.")
|
||||
|
||||
;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here?
|
||||
;; They are needed only for our automated self-tests at the moment.
|
||||
;; Or should there be some other mechanism?
|
||||
;;;###autoload
|
||||
(defun ert-run-tests-interactively (selector
|
||||
&optional output-buffer-name message-fn)
|
||||
(defun ert-run-tests-interactively (selector)
|
||||
"Run the tests specified by SELECTOR and display the results in a buffer.
|
||||
|
||||
SELECTOR works as described in `ert-select-tests'.
|
||||
OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they
|
||||
are used for automated self-tests and specify which buffer to use
|
||||
and how to display message."
|
||||
SELECTOR works as described in `ert-select-tests'."
|
||||
(interactive
|
||||
(list (let ((default (if ert--selector-history
|
||||
;; Can't use `first' here as this form is
|
||||
|
|
@ -2024,23 +2057,17 @@ and how to display message."
|
|||
obarray #'ert-test-boundp nil nil
|
||||
'ert--selector-history default nil)))
|
||||
nil))
|
||||
(unless message-fn (setq message-fn 'message))
|
||||
(let ((output-buffer-name output-buffer-name)
|
||||
buffer
|
||||
listener
|
||||
(message-fn message-fn))
|
||||
(let (buffer listener)
|
||||
(setq listener
|
||||
(lambda (event-type &rest event-args)
|
||||
(cl-ecase event-type
|
||||
(run-started
|
||||
(cl-destructuring-bind (stats) event-args
|
||||
(setq buffer (ert--setup-results-buffer stats
|
||||
listener
|
||||
output-buffer-name))
|
||||
(setq buffer (ert--setup-results-buffer stats listener))
|
||||
(pop-to-buffer buffer)))
|
||||
(run-ended
|
||||
(cl-destructuring-bind (stats abortedp) event-args
|
||||
(funcall message-fn
|
||||
(message
|
||||
"%sRan %s tests, %s results were as expected%s%s"
|
||||
(if (not abortedp)
|
||||
""
|
||||
|
|
@ -2394,7 +2421,7 @@ To be used in the ERT results buffer."
|
|||
(interactive nil ert-results-mode)
|
||||
(cl-assert (eql major-mode 'ert-results-mode))
|
||||
(let ((selector (ert--stats-selector ert--results-stats)))
|
||||
(ert-run-tests-interactively selector (buffer-name))))
|
||||
(ert-run-tests-interactively selector)))
|
||||
|
||||
(defun ert-results-rerun-test-at-point ()
|
||||
"Re-run the test at point.
|
||||
|
|
|
|||
|
|
@ -39,10 +39,11 @@
|
|||
(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))
|
||||
(let ((ert--test-body-was-run nil)
|
||||
(ert--output-buffer-name " *ert self-tests*"))
|
||||
;; 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*")))
|
||||
(let ((stats (ert-run-tests-interactively "^ert-")))
|
||||
(cl-assert ert--test-body-was-run)
|
||||
(if (zerop (ert-stats-completed-unexpected stats))
|
||||
;; Hide results window only when everything went well.
|
||||
|
|
@ -519,17 +520,18 @@ This macro is used to test if macroexpansion in `should' works."
|
|||
:body (lambda () (ert-skip
|
||||
"skip message")))))
|
||||
(let ((ert-debug-on-error nil))
|
||||
(let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
|
||||
(messages nil)
|
||||
(mock-message-fn
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(cl-letf* ((buffer-name (generate-new-buffer-name
|
||||
" *ert-test-run-tests*"))
|
||||
(ert--output-buffer-name buffer-name)
|
||||
(messages nil)
|
||||
((symbol-function 'message)
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(let ((case-fold-search nil))
|
||||
(ert-run-tests-interactively
|
||||
`(member ,passing-test ,failing-test, skipped-test) buffer-name
|
||||
mock-message-fn)
|
||||
`(member ,passing-test ,failing-test, skipped-test))
|
||||
(should (equal messages `(,(concat
|
||||
"Ran 3 tests, 1 results were "
|
||||
"as expected, 1 unexpected, "
|
||||
|
|
@ -551,6 +553,68 @@ This macro is used to test if macroexpansion in `should' works."
|
|||
(when (get-buffer buffer-name)
|
||||
(kill-buffer buffer-name))))))))
|
||||
|
||||
(ert-deftest ert-test-run-tests-batch ()
|
||||
(let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc"))))))))
|
||||
(long-list (make-list 11 1))
|
||||
(failing-test-1
|
||||
(make-ert-test :name 'failing-test-1
|
||||
:body (lambda () (should (equal complex-list 1)))))
|
||||
(failing-test-2
|
||||
(make-ert-test :name 'failing-test-2
|
||||
:body (lambda () (should (equal long-list 1))))))
|
||||
(let ((ert-debug-on-error nil)
|
||||
messages)
|
||||
(cl-letf* (((symbol-function 'message)
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-print-level 10)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1 ,failing-test-2))))))
|
||||
(let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$")
|
||||
(complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$")
|
||||
found-long
|
||||
found-complex)
|
||||
(cl-loop for msg in (reverse messages)
|
||||
do
|
||||
(unless found-long
|
||||
(setq found-long (string-match long-text msg)))
|
||||
(unless found-complex
|
||||
(setq found-complex (string-match complex-text msg))))
|
||||
(should found-long)
|
||||
(should found-complex)))))
|
||||
|
||||
(ert-deftest ert-test-run-tests-batch-expensive ()
|
||||
(let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc"))))))))
|
||||
(failing-test-1
|
||||
(make-ert-test :name 'failing-test-1
|
||||
:body (lambda () (should (equal complex-list 1))))))
|
||||
(let ((ert-debug-on-error nil)
|
||||
messages)
|
||||
(cl-letf* (((symbol-function 'message)
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages))))
|
||||
(save-window-excursion
|
||||
(unwind-protect
|
||||
(let ((case-fold-search nil)
|
||||
(ert-batch-backtrace-right-margin nil)
|
||||
(ert-batch-backtrace-line-length nil)
|
||||
(ert-batch-print-level 6)
|
||||
(ert-batch-print-length 11))
|
||||
(ert-run-tests-batch
|
||||
`(member ,failing-test-1))))))
|
||||
(let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))")
|
||||
found-frame)
|
||||
(cl-loop for msg in (reverse messages)
|
||||
do
|
||||
(unless found-frame
|
||||
(setq found-frame (cl-search frame msg :test 'equal))))
|
||||
(should found-frame)))))
|
||||
|
||||
(ert-deftest ert-test-special-operator-p ()
|
||||
(should (ert--special-operator-p 'if))
|
||||
(should-not (ert--special-operator-p 'car))
|
||||
|
|
|
|||
|
|
@ -103,23 +103,27 @@
|
|||
|
||||
(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")))))
|
||||
(skipped-test (make-ert-test :name 'skipped-test
|
||||
:body (lambda () (ert-skip
|
||||
"skip message"))))
|
||||
(ert-debug-on-error nil)
|
||||
(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))))
|
||||
(cl-letf* ((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")))))
|
||||
(skipped-test (make-ert-test
|
||||
:name 'skipped-test
|
||||
:body (lambda () (ert-skip
|
||||
"skip message"))))
|
||||
(ert-debug-on-error nil)
|
||||
(messages nil)
|
||||
(buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
|
||||
((symbol-function 'message)
|
||||
(lambda (format-string &rest args)
|
||||
(push (apply #'format format-string args) messages)))
|
||||
(ert--output-buffer-name buffer-name))
|
||||
(cl-flet ((expected-string (with-font-lock-p)
|
||||
(ert-propertized-string
|
||||
"Selector: (member <passing-test> <failing-test> "
|
||||
|
|
@ -152,14 +156,12 @@
|
|||
"failing-test"
|
||||
nil "\n Info: " '(a b) "foo\n"
|
||||
nil " " '(a b) "bar"
|
||||
nil "\n (ert-test-failed \"failure message\")\n\n\n"
|
||||
)))
|
||||
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 ,skipped-test) buffer-name
|
||||
mock-message-fn)
|
||||
`(member ,passing-test ,failing-test ,skipped-test))
|
||||
(should (equal messages `(,(concat
|
||||
"Ran 3 tests, 1 results were "
|
||||
"as expected, 1 unexpected, "
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue