]> git.eshelyaron.com Git - emacs.git/commitdiff
Allow ERT tests to output the failure reasons, too
authorJulian Scheid <jscheid@protonmail.com>
Tue, 15 Jun 2021 15:01:49 +0000 (17:01 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Tue, 15 Jun 2021 15:01:57 +0000 (17:01 +0200)
* lisp/emacs-lisp/ert.el (ert-reason-for-test-result): New function.
(ert-run-tests-batch): Output failure or skip reason  (bug#47071).

doc/misc/ert.texi
etc/NEWS
lisp/emacs-lisp/ert.el

index a4e2cb506a31a9d47022a908483c7c6522b77ece..fafdb8c4eb41db4b567e35265a8600f66b2f2cf9 100644 (file)
@@ -347,6 +347,10 @@ emacs -batch -l ert -l my-tests.el \
       -eval '(ert-run-tests-batch-and-exit "to-match")'
 @end example
 
+By default, ERT test failure summaries are quite brief in batch
+mode--only the names of the failed tests are listed.  If the
+EMACS_TEST_VERBOSE environment variable is set, the failure summaries
+will also include the data from the failing test.
 
 @node Test Selectors
 @section Test Selectors
index 60f3172041aee71eb4d326a5361282cff5ad5991..30114cab2fdabb6a6da4c9b48d14f8fb699f005f 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2090,6 +2090,13 @@ This allows mode-specific alterations to how 'thing-at-point' works.
 This is so 'C-a' works as in other modes, and in particular holding
 Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
 
+** ERT
+
++++
+*** ERT can now output more verbose test failure reports.
+If the EMACS_TEST_VERBOSE environment variable is set, failure
+summaries will include the failing condition.
+
 ** Miscellaneous
 
 +++
index e91ec0af4434b067702f895371ba85ad5d63c31a..6793b374eeabdf0a4e63321d9898635a955416c1 100644 (file)
@@ -1279,6 +1279,23 @@ EXPECTEDP specifies whether the result was expected."
              (ert-test-quit '("quit" "QUIT")))))
     (elt s (if expectedp 0 1))))
 
+(defun ert-reason-for-test-result (result)
+  "Return the reason given for RESULT, as a string.
+
+The reason is the argument given when invoking `ert-fail' or `ert-skip'.
+It is output using `prin1' prefixed by two spaces.
+
+If no reason was given, or for a successful RESULT, return the
+empty string."
+  (let ((reason
+         (and
+          (ert-test-result-with-condition-p result)
+          (cadr (ert-test-result-with-condition-condition result))))
+        (print-escape-newlines t)
+        (print-level 6)
+        (print-length 10))
+    (if reason (format "  %S" reason) "")))
+
 (defun ert--pp-with-indentation-and-newline (object)
   "Pretty-print OBJECT, indenting it to the current column of point.
 Ensures a final newline is inserted."
@@ -1369,18 +1386,24 @@ Returns the stats object."
               (cl-loop for test across (ert--stats-tests stats)
                        for result = (ert-test-most-recent-result test) do
                        (when (not (ert-test-result-expected-p test result))
-                         (message "%9s  %S"
+                         (message "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
-                                  (ert-test-name test))))
+                                  (ert-test-name test)
+                                  (if (getenv "EMACS_TEST_VERBOSE")
+                                      (ert-reason-for-test-result result)
+                                    ""))))
               (message "%s" ""))
             (unless (zerop skipped)
               (message "%s skipped results:" skipped)
               (cl-loop for test across (ert--stats-tests stats)
                        for result = (ert-test-most-recent-result test) do
                        (when (ert-test-result-type-p result :skipped)
-                         (message "%9s  %S"
+                         (message "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
-                                  (ert-test-name test))))
+                                  (ert-test-name test)
+                                  (if (getenv "EMACS_TEST_VERBOSE")
+                                      (ert-reason-for-test-result result)
+                                    ""))))
               (message "%s" "")))))
        (test-started
         )