Subject: [PATCH] Make `print-level` & `print-length` customizable in ERT batch tests

From: Michael <[email-masked]>
Date: Tue, 05 Oct 2021 07:28:38 -0700

Hello,

When running ERT tests in batch mode, the conservative values
chosen for `print-level` and `print-length` sometimes make it
difficult to see what exactly is wrong.  This patch introduces
two new variables (`ert-batch-print-level` &
`ert-batch-print-length`) that one can use to customize them;
e.g.

    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))"

Please let me know what should be changed.

>From da7eff94f23f4798df36be2c2bd072038ba01e2d Mon Sep 17 00:00:00 2001
From: Michael Herstine <[email-masked]>
Date: Tue, 5 Oct 2021 06:53:02 -0700
Subject: [PATCH] Make print-length & print-level in ert-run-tests-batch
 configurable

This commit introduces two new ert variables (ert-batch-print-length
and ert-batch-print-level) that make these settings configurable.  It
also adds an optional message-fn parameter to ert-batch-test (in the
style of of ert-run-tests-interactively) to facilitate testing.

* lisp/emacs-lisp/ert.el (ert-batch-print-length, ert-batch-print-level,
ert-batch-test): Added the two variables, added optional message-fn
parameter, set print-level & print-length to these settings when
formatting test results.
* test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-batch): new
tests
* doc/misc/ert.texi: document the new variables & their usage
---
 doc/misc/ert.texi                 | 16 ++++++++
 etc/NEWS                          |  5 +++
 lisp/emacs-lisp/ert.el            | 61 +++++++++++++++++++------------
 test/lisp/emacs-lisp/ert-tests.el | 34 +++++++++++++++++
 4 files changed, 93 insertions(+), 23 deletions(-)

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index fafdb8c4eb4..12f1df75fcc 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -323,6 +323,22 @@ Running Tests in Batch Mode
 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} & @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-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
diff --git a/etc/NEWS b/etc/NEWS
index 17c42ce104d..be102dbc501 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -128,6 +128,11 @@ of files visited via 'C-x C-f' and other commands.
 
 * Changes in Emacs 28.1
 
++++
+** New ERT batch variables 'ert-batch-print-length' & 'ert-batch-print-level'
+These variables will override 'print-length' & 'print-level' when
+printing Lisp values in ERT batch test results.
+
 ---
 ** Emacs now supports Unicode Standard version 14.0.
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 92acfe7246f..2f0b5536d7e 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -76,6 +76,18 @@ ert-batch-backtrace-right-margin
 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 results, `print-length' will be
+temporarily set to this value.")
+
+(defvar ert-batch-print-level 5
+  "`print-level' setting used in `ert-run-tests-batch'.
+
+When formatting lists in test results, `print-level' will be
+temporarily set to this value.")
+
 (defface ert-test-result-expected '((((class color) (background light))
                                      :background "green1")
                                     (((class color) (background dark))
@@ -1338,7 +1350,7 @@ ert-quiet
   "Non-nil makes ERT only print important information in batch mode.")
 
 ;;;###autoload
-(defun ert-run-tests-batch (&optional selector)
+(defun ert-run-tests-batch (&optional selector message-fn)
   "Run the tests specified by SELECTOR, printing results to the terminal.
 
 SELECTOR works as described in `ert-select-tests', except if
@@ -1346,8 +1358,12 @@ ert-run-tests-batch
 run; this makes the command line \"emacs -batch -l my-tests.el -f
 ert-run-tests-batch-and-exit\" useful.
 
-Returns the stats object."
+Returns the stats object.
+
+MESSAGE-FN should normally be nil; it is used for automated
+self-tests and specify how to display messages."
   (unless selector (setq selector 't))
+  (unless message-fn (setq message-fn #'message))
   (ert-run-tests
    selector
    (lambda (event-type &rest event-args)
@@ -1355,7 +1371,7 @@ ert-run-tests-batch
        (run-started
         (unless ert-quiet
           (cl-destructuring-bind (stats) event-args
-            (message "Running %s tests (%s, selector `%S')"
+            (funcall message-fn "Running %s tests (%s, selector `%S')"
                      (length (ert--stats-tests stats))
                      (ert--format-time-iso8601 (ert--stats-start-time stats))
                      selector))))
@@ -1364,7 +1380,7 @@ ert-run-tests-batch
           (let ((unexpected (ert-stats-completed-unexpected stats))
                 (skipped (ert-stats-skipped stats))
 		(expected-failures (ert--stats-failed-expected stats)))
-            (message "\n%sRan %s tests, %s results as expected, %s unexpected%s (%s, %f sec)%s\n"
+            (funcall message-fn "\n%sRan %s tests, %s results as expected, %s unexpected%s (%s, %f sec)%s\n"
                      (if (not abortedp)
                          ""
                        "Aborted: ")
@@ -1383,44 +1399,43 @@ ert-run-tests-batch
                          ""
                        (format "\n%s expected failures" expected-failures)))
             (unless (zerop unexpected)
-              (message "%s unexpected results:" unexpected)
+              (funcall message-fn "%s unexpected results:" unexpected)
               (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%s"
+                         (funcall message-fn "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
                                   (ert-test-name test)
                                   (if (getenv "EMACS_TEST_VERBOSE")
                                       (ert-reason-for-test-result result)
                                     ""))))
-              (message "%s" ""))
+              (funcall message-fn "%s" ""))
             (unless (zerop skipped)
-              (message "%s skipped results:" skipped)
+              (funcall message-fn "%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%s"
+                         (funcall message-fn "%9s  %S%s"
                                   (ert-string-for-test-result result nil)
                                   (ert-test-name test)
                                   (if (getenv "EMACS_TEST_VERBOSE")
                                       (ert-reason-for-test-result result)
                                     ""))))
-              (message "%s" "")))))
-       (test-started
-        )
+              (funcall message-fn "%s" "")))))
+       (test-started)
        (test-ended
         (cl-destructuring-bind (stats test result) event-args
           (unless (ert-test-result-expected-p test result)
             (cl-etypecase result
               (ert-test-passed
-               (message "Test %S passed unexpectedly" (ert-test-name test)))
+               (funcall message-fn "Test %S passed unexpectedly" (ert-test-name test)))
               (ert-test-result-with-condition
-               (message "Test %S backtrace:" (ert-test-name test))
+               (funcall message-fn "Test %S backtrace:" (ert-test-name test))
                (with-temp-buffer
                  (insert (backtrace-to-string
                           (ert-test-result-with-condition-backtrace result)))
                  (if (not ert-batch-backtrace-right-margin)
-                     (message "%s"
+                     (funcall message-fn "%s"
                               (buffer-substring-no-properties (point-min)
                                                               (point-max)))
                    (goto-char (point-min))
@@ -1430,33 +1445,33 @@ ert-run-tests-batch
                        (setq end (min end
                                       (+ start
                                          ert-batch-backtrace-right-margin)))
-                       (message "%s" (buffer-substring-no-properties
+                       (funcall message-fn "%s" (buffer-substring-no-properties
                                       start end)))
                      (forward-line 1))))
                (with-temp-buffer
                  (ert--insert-infos result)
                  (insert "    ")
                  (let ((print-escape-newlines t)
-                       (print-level 5)
-                       (print-length 10))
+                       (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)))
                  (cl-assert (looking-at "\n"))
                  (delete-char 1)
-                 (message "Test %S condition:" (ert-test-name test))
-                 (message "%s" (buffer-string))))
+                 (funcall message-fn "Test %S condition:" (ert-test-name test))
+                 (funcall message-fn "%s" (buffer-string))))
               (ert-test-aborted-with-non-local-exit
-               (message "Test %S aborted with non-local exit"
+               (funcall message-fn "Test %S aborted with non-local exit"
                         (ert-test-name test)))
               (ert-test-quit
-               (message "Quit during %S" (ert-test-name test)))))
+               (funcall message-fn "Quit during %S" (ert-test-name test)))))
           (unless ert-quiet
             (let* ((max (prin1-to-string (length (ert--stats-tests stats))))
                    (format-string (concat "%9s  %"
                                           (prin1-to-string (length max))
                                           "s/" max "  %S (%f sec)")))
-              (message format-string
+              (funcall message-fn format-string
                        (ert-string-for-test-result result
                                                    (ert-test-result-expected-p
                                                     test result))
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 5c9696105e9..d4872e0bab7 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -551,6 +551,40 @@ ert-test-run-tests-interactively
             (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 121 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))
+      (let* ((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-batch-print-level nil)
+		    (ert-batch-print-length nil))
+                (ert-run-tests-batch
+                 `(member ,failing-test-1 ,failing-test-2)
+                 mock-message-fn))))
+	(let ((long-text (mapconcat #'identity (make-list 121 "1") " "))
+	      (complex-text "(:6 \"abc\")")
+	      found-complex found-long)
+	  (cl-loop for msg in messages
+		   do
+		   (unless found-long
+		     (setq found-long (cl-search long-text msg :test 'equal)))
+		   (unless found-complex
+		     (setq found-complex (cl-search complex-text msg :test 'equal))))
+	  (should found-complex)
+	  (should found-long))))))
+
 (ert-deftest ert-test-special-operator-p ()
   (should (ert--special-operator-p 'if))
   (should-not (ert--special-operator-p 'car))
-- 
2.33.0

-- 
Michael <[email-masked]>