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

From: Stefan Kangas <[email-masked]>
Date: Fri, 28 Feb 2025 17:43:53 -0800

tags 71988 + patch
thanks

Pip Cet <[email-masked]> writes:

> On Monday, July 8th, 2024 at 04:49, Pip Cet <[email-masked]> wrote:
>> This bug report is mostly to get a bug number to put in the patch :-).
>
> Which I'm now attaching. Sorry about that.

Makes sense to me.  How about installing it?

>
> Pip
>
> From 8f7e9b50f0edd33f601fab0842c5b4a7e4398490 Mon Sep 17 00:00:00 2001
> From: Pip Cet <[email-masked]>
> 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))