emacs-30 0a500193087: Indent ERT failure explanations rigidly

[F. Jason Park]

branch: emacs-30
commit 0a500193087efc96aa3791dc4c2084ef5f6c3c06
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Indent ERT failure explanations rigidly
    
    This also affects the listing of `should' forms produced by hitting
    the L key on a test button in an ERT buffer.
    
    * lisp/emacs-lisp/ert.el (ert--pp-with-indentation-and-newline):
    Indent the pretty-printed result to match the caller's current column
    as a reference indentation.
    * test/lisp/emacs-lisp/ert-tests.el
    (ert--pp-with-indentation-and-newline): New test.  (Bug#72561)
---
 lisp/emacs-lisp/ert.el            |  5 ++--
 test/lisp/emacs-lisp/ert-tests.el | 54 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 56 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2d96e5ce5a9..105c44d49aa 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1317,13 +1317,12 @@ empty string."
   "Pretty-print OBJECT, indenting it to the current column of point.
 Ensures a final newline is inserted."
   (let ((begin (point))
+        (cols (current-column))
         (pp-escape-newlines t)
         (print-escape-control-characters t))
     (pp object (current-buffer))
     (unless (bolp) (insert "\n"))
-    (save-excursion
-      (goto-char begin)
-      (indent-sexp))))
+    (indent-rigidly begin (point) cols)))
 
 (defun ert--insert-infos (result)
   "Insert `ert-info' infos from RESULT into current buffer.
diff --git a/test/lisp/emacs-lisp/ert-tests.el 
b/test/lisp/emacs-lisp/ert-tests.el
index 1aff73d66f6..9ca336697a6 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -876,6 +876,60 @@ This macro is used to test if macroexpansion in `should' 
works."
   (should (eq (ert--get-explainer 'string-equal) 'ert--explain-string-equal))
   (should (eq (ert--get-explainer 'string=) 'ert--explain-string-equal)))
 
+(ert-deftest ert--pp-with-indentation-and-newline ()
+  :tags '(:causes-redisplay)
+  (let ((failing-test (make-ert-test
+                       :name 'failing-test
+                       :body (lambda ()
+                               (should (equal '((:one "1" :three "3" :two "2"))
+                                              '((:one "1")))))))
+        (want-body "\
+Selector: <failing-test>
+Passed:  0
+Failed:  1 (1 unexpected)
+Skipped: 0
+Total:   1/1
+
+Started at:   @@TIMESTAMP@@
+Finished.
+Finished at:  @@TIMESTAMP@@
+
+F
+
+F failing-test
+    (ert-test-failed
+     ((should (equal '((:one \"1\" :three \"3\" :two \"2\")) '((:one \"1\"))))
+      :form (equal ((:one \"1\" :three \"3\" :two \"2\")) ((:one \"1\"))) 
:value
+      nil :explanation
+      (list-elt 0
+                (proper-lists-of-different-length 6 2
+                                                  (:one \"1\" :three \"3\"
+                                                        :two \"2\")
+                                                  (:one \"1\")
+                                                  first-mismatch-at 2))))
+\n\n")
+        (want-msg "Ran 1 tests, 0 results were as expected, 1 unexpected")
+        (buffer-name (generate-new-buffer-name " *ert-test-run-tests*")))
+    (cl-letf* ((ert-debug-on-error nil)
+               (ert--output-buffer-name buffer-name)
+               (messages nil)
+               ((symbol-function 'message)
+                (lambda (format-string &rest args)
+                  (push (apply #'format format-string args) messages)))
+               ((symbol-function 'ert--format-time-iso8601)
+                (lambda (_) "@@TIMESTAMP@@")))
+      (save-window-excursion
+        (unwind-protect
+            (let ((fill-column 70))
+              (ert-run-tests-interactively failing-test)
+              (should (equal (list want-msg) messages))
+              (should (equal (string-replace "\t" "        "
+                                             (with-current-buffer buffer-name
+                                               (buffer-string)))
+                             want-body)))
+          (when noninteractive
+            (kill-buffer buffer-name)))))))
+
 (provide 'ert-tests)
 
 ;;; ert-tests.el ends here