mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
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)
This commit is contained in:
parent
713069dd7a
commit
0a50019308
@ -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.
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user