unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#51037: [PATCH] Make `print-level` & `print-length` customizable in ERT batch tests
@ 2021-10-05 14:28 Michael
  2021-10-06  9:30 ` Lars Ingebrigtsen
  0 siblings, 1 reply; 45+ messages in thread
From: Michael @ 2021-10-05 14:28 UTC (permalink / raw)
  To: 51037

[-- Attachment #1: Type: text/plain, Size: 556 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-print-length-print-level-in-ert-run-tests-batch.patch --]
[-- Type: text/x-patch, Size: 12702 bytes --]

From da7eff94f23f4798df36be2c2bd072038ba01e2d Mon Sep 17 00:00:00 2001
From: Michael Herstine <sp1ff@pobox.com>
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.
 \f
 * 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


[-- Attachment #3: Type: text/plain, Size: 32 bytes --]


-- 
Michael <sp1ff@runbox.com>

^ permalink raw reply related	[flat|nested] 45+ messages in thread

end of thread, other threads:[~2021-11-29 16:16 UTC | newest]

Thread overview: 45+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-10-05 14:28 bug#51037: [PATCH] Make `print-level` & `print-length` customizable in ERT batch tests Michael
2021-10-06  9:30 ` Lars Ingebrigtsen
2021-10-06 12:52   ` Eli Zaretskii
2021-10-07  7:59     ` Lars Ingebrigtsen
2021-10-07  8:25       ` Eli Zaretskii
2021-10-07 19:03         ` Lars Ingebrigtsen
2021-10-12 13:52           ` Michael
2021-10-13 11:07             ` Lars Ingebrigtsen
2021-10-13 13:41               ` Michael
2021-10-13 14:06                 ` Lars Ingebrigtsen
2021-10-24 19:50                   ` Michael
2021-10-25 13:03                     ` Gemini Lasswell
2021-10-26 21:02                       ` Michael
2021-10-27 13:13                         ` Lars Ingebrigtsen
2021-10-25 13:05                     ` Lars Ingebrigtsen
2021-10-26 21:10                       ` Michael
2021-10-27 13:15                         ` Lars Ingebrigtsen
2021-11-14  2:55                           ` Michael
2021-11-14  7:05                             ` Eli Zaretskii
2021-11-14 15:42                               ` Michael
2021-11-14 18:04                                 ` Eli Zaretskii
2021-11-15 23:11                                   ` Michael
2021-11-14 14:39                             ` Lars Ingebrigtsen
2021-11-14 14:42                               ` Lars Ingebrigtsen
2021-11-14 17:45                                 ` Michael
2021-11-14 17:50                                   ` Lars Ingebrigtsen
2021-11-15 23:32                                 ` Michael
2021-11-16  7:48                                   ` Lars Ingebrigtsen
2021-11-17 16:22                                     ` Filipp Gunbin
2021-11-18  9:27                                       ` Lars Ingebrigtsen
2021-11-18 13:51                                         ` Filipp Gunbin
2021-11-19 15:24                                         ` Michael
2021-11-19 18:46                                           ` Filipp Gunbin
2021-11-20 16:49                                             ` Michael
2021-11-20 22:19                                               ` Filipp Gunbin
2021-11-22 14:07                                                 ` Michael
2021-11-22 17:29                                                   ` Filipp Gunbin
2021-11-24 16:29                                                     ` Michael
2021-11-24 19:53                                                       ` Filipp Gunbin
2021-11-29 16:16                                                         ` Michael
2021-10-07 21:04       ` Andy Moreton
2021-10-07 22:04         ` Lars Ingebrigtsen
2021-10-08 13:49           ` Andy Moreton
2021-10-08 15:24   ` Michael
2021-10-09 11:19     ` Lars Ingebrigtsen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).