bug#71988: 31.0.50; ert-test-run-tests-batch-expensive runs out of memory if previous tests failed

[Pip Cet via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

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

On Monday, July 8th, 2024 at 04:49, Pip Cet <pipcet@protonmail.com> wrote:
> This bug report is mostly to get a bug number to put in the patch :-).

Which I'm now attaching. Sorry about that.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Bug-71988-Avoid-excessively-large-backtraces-in-ert-.patch --]
[-- Type: text/x-patch; name=0001-Bug-71988-Avoid-excessively-large-backtraces-in-ert-.patch, Size: 1902 bytes --]

From 8f7e9b50f0edd33f601fab0842c5b4a7e4398490 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@protonmail.com>
Date: Mon, 8 Jul 2024 19:50:16 +0000
Subject: [PATCH] (Bug#71988) Avoid excessively large backtraces in ert-tests

* test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-batch-expensive):
Temporarily make `cl-print-object' not print out vectors while running
the test.
---
 test/lisp/emacs-lisp/ert-tests.el | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 1aff73d66f6..4237d354f38 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -594,9 +594,13 @@ ert-test-run-tests-batch-expensive
 			 :body (lambda () (should (equal complex-list 1))))))
     (let ((ert-debug-on-error nil)
           messages)
-      (cl-letf* (((symbol-function 'message)
+      (cl-letf* (((symbol-function 'cl-print-object) (symbol-function 'cl-print-object))
+                 ((symbol-function 'message)
                   (lambda (format-string &rest args)
                     (push (apply #'format format-string args) messages))))
+        ;; don't print the ert--stats-tests vector, which would run out of
+        ;; memory if previous tests have failed.
+        (cl-defmethod cl-print-object ((object vector) stream))
         (save-window-excursion
           (let ((case-fold-search nil)
                 (ert-batch-backtrace-right-margin nil)
@@ -611,7 +615,9 @@ ert-test-run-tests-batch-expensive
 		 do
 		 (unless found-frame
 		   (setq found-frame (cl-search frame msg :test 'equal))))
-        (should found-frame)))))
+        (should found-frame))))
+  ;; ensure our temporary binding was undone.
+  (should (equal (cl-prin1-to-string [a]) "[a]")))
 
 (ert-deftest ert-test-special-operator-p ()
   (should (ert--special-operator-p 'if))
-- 
2.45.2