From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Michael Newsgroups: gmane.emacs.bugs Subject: bug#51037: [PATCH] Make `print-level` & `print-length` customizable in ERT batch tests Date: Mon, 15 Nov 2021 15:32:57 -0800 Message-ID: <86zgq5kn9y.fsf@runbox.com> References: <86tuhvmtpl.fsf@runbox.com> <877deqec10.fsf@gnus.org> <83fste2u4i.fsf@gnu.org> <87ily94662.fsf@gnus.org> <83fstd1bth.fsf@gnu.org> <87czogslm4.fsf@gnus.org> <86ily2mjtq.fsf@runbox.com> <87r1cp89o4.fsf@gnus.org> <86fst5m48v.fsf@runbox.com> <87a6jd5891.fsf@gnus.org> <86mtmykxro.fsf@runbox.com> <87y26hz24c.fsf@gnus.org> <86bl3blcgm.fsf@runbox.com> <87wnlya9sj.fsf@gnus.org> <86wnlbmooj.fsf@runbox.com> <87fsry7qdy.fsf@gnus.org> <87bl2m7q9g.fsf@gnus.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="23130"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.4.15; emacs 28.0.50 Cc: gazally@runbox.com, 51037@debbugs.gnu.org To: Lars Ingebrigtsen , Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Nov 16 00:34:14 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mmlUL-0005nj-NK for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 16 Nov 2021 00:34:14 +0100 Original-Received: from localhost ([::1]:54234 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmlUJ-0003Na-U3 for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 15 Nov 2021 18:34:11 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:36862) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmlU9-0003Kh-R8 for bug-gnu-emacs@gnu.org; Mon, 15 Nov 2021 18:34:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:44989) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mmlU9-0001GZ-Ip for bug-gnu-emacs@gnu.org; Mon, 15 Nov 2021 18:34:01 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mmlU9-0005Ze-Gu for bug-gnu-emacs@gnu.org; Mon, 15 Nov 2021 18:34:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Michael Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 15 Nov 2021 23:34:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51037 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 51037-submit@debbugs.gnu.org id=B51037.163701920621373 (code B ref 51037); Mon, 15 Nov 2021 23:34:01 +0000 Original-Received: (at 51037) by debbugs.gnu.org; 15 Nov 2021 23:33:26 +0000 Original-Received: from localhost ([127.0.0.1]:56535 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mmlTZ-0005Ye-Mk for submit@debbugs.gnu.org; Mon, 15 Nov 2021 18:33:26 -0500 Original-Received: from transit01.runbox.com ([91.220.196.211]:48240) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mmlTR-0005YG-D1 for 51037@debbugs.gnu.org; Mon, 15 Nov 2021 18:33:24 -0500 Original-Received: from aibo.runbox.com ([185.226.149.25]) by transit01.runbox.com with esmtps (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 (Exim 4.93) (envelope-from ) id 1mmlTK-00ALOA-FM; Tue, 16 Nov 2021 00:33:10 +0100 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=runbox.com; s=selector1; h=Content-Type:MIME-Version:Date:Message-ID:In-reply-to:Subject :Cc:To:From:References; bh=i/fuKqKTW4EIog46iPoCX0MFvNg6CcNigFViGTgOUMM=; b=MD GAkA4i2XCvjKUaqJXBBhFzOIuQSYFoUWonMx3sog+iQAe3VCc6uc5I+zxHI51TM8G74zqj6kGZGxe j+FKRzsOPhanNfT+YunVv6cOM7HdGamKz/jZVZ5axlpJ990943pXfFvli7h2lT4dttKVvoTj8HfSz zOXpu8L8JjrdlbtyviXC4el00Zq6C3G7zRf0oj7KLaFNXhVOyDpNcBdUuSdsbVOvIVCIRRiT3Gl7Q f3zjIVzdOvWaNeu+OT/JisJZ+RwcQAy66d1tBUwgyoyM0qSWjVLGG8pLfvwxW9u/1r5G5vLXUpJ0R xDeDZERqgRykwNquK7O87RSdtD5T73Jg==; Original-Received: from [10.9.9.74] (helo=submission03.runbox) by mailtransmit02.runbox with esmtp (Exim 4.86_2) (envelope-from ) id 1mmlTI-0006yI-Jf; Tue, 16 Nov 2021 00:33:08 +0100 Original-Received: by submission03.runbox with esmtpsa [Authenticated ID (942723)] (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) id 1mmlTB-0002wS-Cx; Tue, 16 Nov 2021 00:33:01 +0100 In-reply-to: <87bl2m7q9g.fsf@gnus.org> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:220088 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: quoted-printable > Lars Ingebrigtsen writes: > >> Michael writes: >> >>> OK-- here's the revised patch. >> >> Thanks; applied to Emacs 29 (with some whitespace changes to=20 >> make the >> lines less wide). > > I spoke to soon -- we don't seem to have copyright assignment=20 > papers on > file? Is that in the process of happening? > > So here's the patch again with the whitespace tweaks while we=20 > wait for > that. =F0=9F=A4=A8 > > diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi [snip] New patch attached. Incorporates (I hope) these changes, as well as addresses Eli's issues. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-results-details-in-ert-run-tests-batch-configur.patch Content-Description: bug#51037 >From ccc3a72949f8298c2b8194d3b302d019f934af43 Mon Sep 17 00:00:00 2001 From: Michael Herstine Date: Tue, 5 Oct 2021 06:53:02 -0700 Subject: [PATCH] Make results details in ert-run-tests-batch configurable. This commit introduces three new ert variables: ert-batch-print-length, ert-batch-print-level & ert-batch-backtrace-length. The first two control print-length and print-level, resp., when printing test results. Since even modest values of print-level & print-length can produce extremely long lines in backtraces along with correspondingly long processing times to format them, this commit also introduces the variable ert-backtrace-line-length which can, optionally, override backtrace-line-length during ert batch test stack traces. Finally, it also removes the optional message-fn & output-buffer arguments to ert-run-test-interactively (since they were only used for testing purposes) and re-implements its tests in terms of cl-letf. * lisp/emacs-lisp/ert.el (ert-batch-print-length, ert-batch-print-level,.ert-batch-backtrace-line-length, ert-batch-test, ert-run-tests-interactively): Added the three variables, bound them to these settings when formatting batch test results including backtraces. Removed the optional parameters output-buffer & message-fn from ert-run-tests-interactively. * test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-interactively, ert-test-run-tests-batch): use cl-letf to capture output, new tests resp. * test/lisp/ert-x-tests.el (ert-test-run-tests-interactively-2): Changed to use cl-letf to capture output instead of using message-fn. * lisp/emacs-lisp/backtrace.el (backtrace--line-length-or-nil, backtrace--print-func-and-args): Fixed a bug when setting backtrace-line-length to nil by adding a new function to check for that case & having backtrace--print-func-and-args use it. * doc/misc/ert.texi: document the new variables & their usage --- doc/misc/ert.texi | 25 +++++++++ etc/NEWS | 7 +++ lisp/emacs-lisp/backtrace.el | 21 +++++-- lisp/emacs-lisp/ert.el | 87 +++++++++++++++++++---------- test/lisp/emacs-lisp/ert-tests.el | 82 ++++++++++++++++++++++++--- test/lisp/emacs-lisp/ert-x-tests.el | 44 ++++++++------- 6 files changed, 200 insertions(+), 66 deletions(-) diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 440c61add8e..2de3946db1e 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -390,6 +390,31 @@ 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-batch-backtrace-line-length +Even modest settings for @code{print-level} & @code{print-length} can +produce extremely long lines in backtraces, however, with attendant +pauses in execution progress. Set +@code{ert-batch-backtrace-line-length} to t to use the value of +@code{backtrace-line-length}, nil to stop any limitations on backtrace +line lengths (i.e.@: to get full backtraces), or a positive integer to +limit backtrace line length to that number. + @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 3cad0995ac5..2fccea2a2eb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,13 @@ time. * Changes in Emacs 29.1 ++++ +** New ERT variables 'ert-batch-print-length' and 'ert-batch-print-level'. +These variables will override 'print-length' and 'print-level' when +printing Lisp values in ERT batch test results. + +** Emacs now supports Unicode Standard version 14.0. + ** Emoji +++ diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index a5721aa3193..0e5f85d7b8b 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -55,9 +55,9 @@ backtrace-fontify (defcustom backtrace-line-length 5000 "Target length for lines in Backtrace buffers. Backtrace mode will attempt to abbreviate printing of backtrace -frames to make them shorter than this, but success is not -guaranteed. If set to nil or zero, Backtrace mode will not -abbreviate the forms it prints." +frames by setting `print-level' and `print-length' to make them +shorter than this, but success is not guaranteed. If set to nil +or zero, backtrace mode will not abbreviate the forms it prints." :type 'integer :group 'backtrace :version "27.1") @@ -751,6 +751,13 @@ backtrace--print-flags (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s)) (put-text-property beg (point) 'backtrace-section 'func))) +(defun backtrace--line-length-or-nil () + "Return `backtrace-line-length' if valid, nil else." + ;; mirror the logic in `cl-print-to-string-with-limits' + (and (natnump backtrace-line-length) + (not (zerop backtrace-line-length)) + backtrace-line-length)) + (defun backtrace--print-func-and-args (frame _view) "Print the function, arguments and buffer position of a backtrace FRAME. Format it according to VIEW." @@ -769,11 +776,13 @@ backtrace--print-func-and-args (if (atom fun) (funcall backtrace-print-function fun) (insert - (backtrace--print-to-string fun (when args (/ backtrace-line-length 2))))) + (backtrace--print-to-string fun (when (and args (backtrace--line-length-or-nil)) (/ backtrace-line-length 2))))) (if args (insert (backtrace--print-to-string - args (max (truncate (/ backtrace-line-length 5)) - (- backtrace-line-length (- (point) beg))))) + args + (if (backtrace--line-length-or-nil) + (max (truncate (/ backtrace-line-length 5)) + (- backtrace-line-length (- (point) beg)))))) ;; The backtrace-form property is so that backtrace-multi-line ;; will find it. backtrace-multi-line doesn't do anything ;; useful with it, just being consistent. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 8ebc81fd418..36b4408dc8e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -77,6 +77,37 @@ 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 conditions, `print-length' will be +temporarily set to this value. See also +`ert-batch-backtrace-line-length' for its effect on stack +traces.") + +(defvar ert-batch-print-level 5 + "`print-level' setting used in `ert-run-tests-batch'. + +When formatting lists in test conditions, `print-level' will be +temporarily set to this value. See also +`ert-batch-backtrace-line-length' for its effect on stack +traces.") + +(defvar ert-batch-backtrace-line-length t + "Target length for lines in ERT batch backtraces. + +Even modest settings for `print-length' and `print-level' can +produce extremely long lines in backtraces and lengthy delays in +forming them. This variable governs the target maximum line +length by manipulating these two variables while printing stack +traces. Setting this variable to t will re-use the value of +`backtrace-line-length' while print stack traces in ERT batch +mode. A value of nil will short-circuit this mechanism; line +lengths will be completely determined by `ert-batch-line-length' +and `ert-batch-line-level'. Any other value will be temporarily +bound to `backtrace-line-length' when producing stack traces +in batch mode.") + (defface ert-test-result-expected '((((class color) (background light)) :background "green1") (((class color) (background dark)) @@ -1402,8 +1433,7 @@ ert-run-tests-batch (ert-reason-for-test-result result) "")))) (message "%s" ""))))) - (test-started - ) + (test-started) (test-ended (cl-destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) @@ -1413,8 +1443,18 @@ ert-run-tests-batch (ert-test-result-with-condition (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer - (insert (backtrace-to-string - (ert-test-result-with-condition-backtrace result))) + (let ((backtrace-line-length + (cond + ((eq ert-batch-backtrace-line-length t) + backtrace-line-length) + ((eq ert-batch-backtrace-line-length nil) + nil) + (t + ert-batch-backtrace-line-length))) + (print-level ert-batch-print-level) + (print-length ert-batch-print-length)) + (insert (backtrace-to-string + (ert-test-result-with-condition-backtrace result)))) (if (not ert-batch-backtrace-right-margin) (message "%s" (buffer-substring-no-properties (point-min) @@ -1433,8 +1473,8 @@ ert-run-tests-batch (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))) @@ -1962,13 +2002,13 @@ ert--results-font-lock-function (ewoc-refresh ert--results-ewoc) (font-lock-default-function enabledp)) -(defun ert--setup-results-buffer (stats listener buffer-name) +(defvar ert--output-buffer-name "*ert*") + +(defun ert--setup-results-buffer (stats listener) "Set up a test results buffer. -STATS is the stats object; LISTENER is the results listener; -BUFFER-NAME, if non-nil, is the buffer name to use." - (unless buffer-name (setq buffer-name "*ert*")) - (let ((buffer (get-buffer-create buffer-name))) +STATS is the stats object; LISTENER is the results listener." + (let ((buffer (get-buffer-create ert--output-buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (buffer-disable-undo) @@ -2000,18 +2040,11 @@ ert--setup-results-buffer (defvar ert--selector-history nil "List of recent test selectors read from terminal.") -;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here? -;; They are needed only for our automated self-tests at the moment. -;; Or should there be some other mechanism? ;;;###autoload -(defun ert-run-tests-interactively (selector - &optional output-buffer-name message-fn) +(defun ert-run-tests-interactively (selector) "Run the tests specified by SELECTOR and display the results in a buffer. -SELECTOR works as described in `ert-select-tests'. -OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they -are used for automated self-tests and specify which buffer to use -and how to display message." +SELECTOR works as described in `ert-select-tests'." (interactive (list (let ((default (if ert--selector-history ;; Can't use `first' here as this form is @@ -2024,23 +2057,17 @@ ert-run-tests-interactively obarray #'ert-test-boundp nil nil 'ert--selector-history default nil))) nil)) - (unless message-fn (setq message-fn 'message)) - (let ((output-buffer-name output-buffer-name) - buffer - listener - (message-fn message-fn)) + (let (buffer listener) (setq listener (lambda (event-type &rest event-args) (cl-ecase event-type (run-started (cl-destructuring-bind (stats) event-args - (setq buffer (ert--setup-results-buffer stats - listener - output-buffer-name)) + (setq buffer (ert--setup-results-buffer stats listener)) (pop-to-buffer buffer))) (run-ended (cl-destructuring-bind (stats abortedp) event-args - (funcall message-fn + (message "%sRan %s tests, %s results were as expected%s%s" (if (not abortedp) "" @@ -2394,7 +2421,7 @@ ert-results-rerun-all-tests (interactive nil ert-results-mode) (cl-assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) - (ert-run-tests-interactively selector (buffer-name)))) + (ert-run-tests-interactively selector))) (defun ert-results-rerun-test-at-point () "Re-run the test at point. diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 79576d24032..1a8c9bf4f08 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -39,10 +39,11 @@ ert-test-body-runs (defun ert-self-test () "Run ERT's self-tests and make sure they actually ran." (let ((window-configuration (current-window-configuration))) - (let ((ert--test-body-was-run nil)) + (let ((ert--test-body-was-run nil) + (ert--output-buffer-name " *ert self-tests*")) ;; The buffer name chosen here should not compete with the default ;; results buffer name for completion in `switch-to-buffer'. - (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) + (let ((stats (ert-run-tests-interactively "^ert-"))) (cl-assert ert--test-body-was-run) (if (zerop (ert-stats-completed-unexpected stats)) ;; Hide results window only when everything went well. @@ -519,17 +520,18 @@ ert-test-run-tests-interactively :body (lambda () (ert-skip "skip message"))))) (let ((ert-debug-on-error nil)) - (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*")) - (messages nil) - (mock-message-fn - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) + (cl-letf* ((buffer-name (generate-new-buffer-name + " *ert-test-run-tests*")) + (ert--output-buffer-name buffer-name) + (messages nil) + ((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) (save-window-excursion (unwind-protect (let ((case-fold-search nil)) (ert-run-tests-interactively - `(member ,passing-test ,failing-test, skipped-test) buffer-name - mock-message-fn) + `(member ,passing-test ,failing-test, skipped-test)) (should (equal messages `(,(concat "Ran 3 tests, 1 results were " "as expected, 1 unexpected, " @@ -551,6 +553,68 @@ 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 11 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) + messages) + (cl-letf* (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-print-level 10) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1 ,failing-test-2)))))) + (let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$") + (complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$") + found-long + found-complex) + (cl-loop for msg in (reverse messages) + do + (unless found-long + (setq found-long (string-match long-text msg))) + (unless found-complex + (setq found-complex (string-match complex-text msg)))) + (should found-long) + (should found-complex))))) + +(ert-deftest ert-test-run-tests-batch-expensive () + (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc")))))))) + (failing-test-1 + (make-ert-test :name 'failing-test-1 + :body (lambda () (should (equal complex-list 1)))))) + (let ((ert-debug-on-error nil) + messages) + (cl-letf* (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (save-window-excursion + (unwind-protect + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-backtrace-line-length nil) + (ert-batch-print-level 6) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1)))))) + (let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))") + found-frame) + (cl-loop for msg in (reverse messages) + do + (unless found-frame + (setq found-frame (cl-search frame msg :test 'equal)))) + (should found-frame))))) + (ert-deftest ert-test-special-operator-p () (should (ert--special-operator-p 'if)) (should-not (ert--special-operator-p 'car)) diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9baa9941586..7106b7abc0c 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -103,23 +103,27 @@ ert-propertized-string (ert-deftest ert-test-run-tests-interactively-2 () :tags '(:causes-redisplay) - (let* ((passing-test (make-ert-test :name 'passing-test - :body (lambda () (ert-pass)))) - (failing-test (make-ert-test :name 'failing-test - :body (lambda () - (ert-info ((propertize "foo\nbar" - 'a 'b)) - (ert-fail - "failure message"))))) - (skipped-test (make-ert-test :name 'skipped-test - :body (lambda () (ert-skip - "skip message")))) - (ert-debug-on-error nil) - (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) - (messages nil) - (mock-message-fn - (lambda (format-string &rest args) - (push (apply #'format format-string args) messages)))) + (cl-letf* ((passing-test (make-ert-test + :name 'passing-test + :body (lambda () (ert-pass)))) + (failing-test (make-ert-test + :name 'failing-test + :body (lambda () + (ert-info ((propertize "foo\nbar" + 'a 'b)) + (ert-fail + "failure message"))))) + (skipped-test (make-ert-test + :name 'skipped-test + :body (lambda () (ert-skip + "skip message")))) + (ert-debug-on-error nil) + (messages nil) + (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) + ((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages))) + (ert--output-buffer-name buffer-name)) (cl-flet ((expected-string (with-font-lock-p) (ert-propertized-string "Selector: (member " @@ -152,14 +156,12 @@ ert-test-run-tests-interactively-2 "failing-test" nil "\n Info: " '(a b) "foo\n" nil " " '(a b) "bar" - nil "\n (ert-test-failed \"failure message\")\n\n\n" - ))) + nil "\n (ert-test-failed \"failure message\")\n\n\n"))) (save-window-excursion (unwind-protect (let ((case-fold-search nil)) (ert-run-tests-interactively - `(member ,passing-test ,failing-test ,skipped-test) buffer-name - mock-message-fn) + `(member ,passing-test ,failing-test ,skipped-test)) (should (equal messages `(,(concat "Ran 3 tests, 1 results were " "as expected, 1 unexpected, " -- 2.33.1 --=-=-= Content-Type: text/plain; format=flowed -- Michael --=-=-=--