Commit 977f102a authored by Michael Herstine's avatar Michael Herstine Committed by Lars Ingebrigtsen
Browse files

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).
parent 33136639
Pipeline #13950 failed with stages
in 605 minutes and 31 seconds
......@@ -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 \
......
......@@ -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, "
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment