From: Michael Albinus <michael.albinus@gmx.de>
To: Glenn Morris <rgm@gnu.org>
Cc: 9803@debbugs.gnu.org
Subject: bug#9803: [PATCH] Add ERT option to skip test
Date: Mon, 21 Oct 2013 17:08:31 +0200 [thread overview]
Message-ID: <87ppqywtjk.fsf@gmx.de> (raw)
In-Reply-To: <87txgcyqyk.fsf@gmx.de> (Michael Albinus's message of "Sun, 20 Oct 2013 16:09:07 +0200")
[-- Attachment #1: Type: text/plain, Size: 719 bytes --]
Michael Albinus <michael.albinus@gmx.de> writes:
Hi Glenn,
>> I think `skip-if' should have an ert- prefix. (I know `should' doesn't,
>> but I think it, err, should as well. But too late for that one now.)
>
> I've tried to change it as proposed by Stefan, but I'm too stupid to
> manage all this sophisticated cl-* stuff :-(
Well, I've made a change to call (fset 'skip-if 'ert--skip-if) in
ert--run-test-internal. After running the test, it is reverted by
(unintern 'skip-if nil).
Therefore, `skip-if' is visible only inside tests defined with
`ert-deftest'. If this is acceptable, I could apply this change also for
`should', `should-not' and `should-error'.
Do you (and Stefan) agree?
Best regards, Michael.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 123.patch --]
[-- Type: text/x-diff, Size: 14279 bytes --]
=== modified file 'lisp/emacs-lisp/ert.el'
*** lisp/emacs-lisp/ert.el 2013-09-17 07:39:54 +0000
--- lisp/emacs-lisp/ert.el 2013-10-21 15:04:51 +0000
***************
*** 34,47 ****
;; `ert-run-tests-batch-and-exit' for non-interactive use.
;;
;; The body of `ert-deftest' forms resembles a function body, but the
! ;; additional operators `should', `should-not' and `should-error' are
! ;; available. `should' is similar to cl's `assert', but signals a
! ;; different error when its condition is violated that is caught and
! ;; processed by ERT. In addition, it analyzes its argument form and
! ;; records information that helps debugging (`assert' tries to do
! ;; something similar when its second argument SHOW-ARGS is true, but
! ;; `should' is more sophisticated). For information on `should-not'
! ;; and `should-error', see their docstrings.
;;
;; See ERT's info manual as well as the docstrings for more details.
;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
--- 34,50 ----
;; `ert-run-tests-batch-and-exit' for non-interactive use.
;;
;; The body of `ert-deftest' forms resembles a function body, but the
! ;; additional operators `should', `should-not', `should-error' and
! ;; `skip-if' are available. `should' is similar to cl's `assert', but
! ;; signals a different error when its condition is violated that is
! ;; caught and processed by ERT. In addition, it analyzes its argument
! ;; form and records information that helps debugging (`assert' tries
! ;; to do something similar when its second argument SHOW-ARGS is true,
! ;; but `should' is more sophisticated). For information on
! ;; `should-not' and `should-error', see their docstrings. `skip-if'
! ;; skips the test without checking the result, this is useful for
! ;; checking the test environmont (like availability of external
! ;; binaries, etc).
;;
;; See ERT's info manual as well as the docstrings for more details.
;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
***************
*** 174,181 ****
BODY is evaluated as a `progn' when the test is run. It should
signal a condition on failure or just return if the test passes.
! `should', `should-not' and `should-error' are useful for
! assertions in BODY.
Use `ert' to run tests interactively.
--- 177,184 ----
BODY is evaluated as a `progn' when the test is run. It should
signal a condition on failure or just return if the test passes.
! `should', `should-not', `should-error' and `skip-if' are useful
! for assertions in BODY.
Use `ert' to run tests interactively.
***************
*** 237,242 ****
--- 240,246 ----
(define-error 'ert-test-failed "Test failed")
+ (define-error 'ert-test-skipped "Test skipped")
(defun ert-pass ()
"Terminate the current test and mark it passed. Does not return."
***************
*** 247,252 ****
--- 251,261 ----
DATA is displayed to the user and should state the reason of the failure."
(signal 'ert-test-failed (list data)))
+ (defun ert-skip (data)
+ "Terminate the current test and mark it skipped. Does not return.
+ DATA is displayed to the user and should state the reason for skipping."
+ (signal 'ert-test-skipped (list data)))
+
;;; The `should' macros.
***************
*** 425,430 ****
--- 434,449 ----
(list
:fail-reason "did not signal an error")))))))))
+ (cl-defmacro ert--skip-if (form)
+ "Evaluate FORM. If it returns non-nil, skip the current test.
+
+ Returns nil."
+ (declare (debug t))
+ (ert--expand-should `(skip-if ,form) form
+ (lambda (inner-form form-description-form _value-var)
+ `(unless (not ,inner-form)
+ (ert-skip ,form-description-form)))))
+
;;; Explanation of `should' failures.
***************
*** 644,649 ****
--- 663,669 ----
(infos (cl-assert nil)))
(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition)))
(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+ (cl-defstruct (ert-test-skipped (:include ert-test-result-with-condition)))
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
***************
*** 728,733 ****
--- 748,754 ----
(let* ((condition (car more-debugger-args))
(type (cl-case (car condition)
((quit) 'quit)
+ ((ert-test-skipped) 'skipped)
(otherwise 'failed)))
(backtrace (ert--record-backtrace))
(infos (reverse ert--infos)))
***************
*** 737,742 ****
--- 758,767 ----
(make-ert-test-quit :condition condition
:backtrace backtrace
:infos infos))
+ (skipped
+ (make-ert-test-skipped :condition condition
+ :backtrace backtrace
+ :infos infos))
(failed
(make-ert-test-failed :condition condition
:backtrace backtrace
***************
*** 774,781 ****
;; and consider it in `ert--run-test-debugger'?
(debug-ignored-errors nil)
(ert--infos '()))
(funcall (ert-test-body (ert--test-execution-info-test
! test-execution-info))))))
(ert-pass))
(setf (ert--test-execution-info-result test-execution-info)
(make-ert-test-passed))
--- 799,808 ----
;; and consider it in `ert--run-test-debugger'?
(debug-ignored-errors nil)
(ert--infos '()))
+ (fset 'skip-if 'ert--skip-if)
(funcall (ert-test-body (ert--test-execution-info-test
! test-execution-info)))
! (unintern 'skip-if nil))))
(ert-pass))
(setf (ert--test-execution-info-result test-execution-info)
(make-ert-test-passed))
***************
*** 862,868 ****
nil -- Never matches.
t -- Always matches.
! :failed, :passed -- Matches corresponding results.
\(and TYPES...\) -- Matches if all TYPES match.
\(or TYPES...\) -- Matches if some TYPES match.
\(not TYPE\) -- Matches if TYPE does not match.
--- 889,895 ----
nil -- Never matches.
t -- Always matches.
! :failed, :passed, :skipped -- Matches corresponding results.
\(and TYPES...\) -- Matches if all TYPES match.
\(or TYPES...\) -- Matches if some TYPES match.
\(not TYPE\) -- Matches if TYPE does not match.
***************
*** 875,880 ****
--- 902,908 ----
((member t) t)
((member :failed) (ert-test-failed-p result))
((member :passed) (ert-test-passed-p result))
+ ((member :skipped) (ert-test-skipped-p result))
(cons
(cl-destructuring-bind (operator &rest operands) result-type
(cl-ecase operator
***************
*** 899,905 ****
(defun ert-test-result-expected-p (test result)
"Return non-nil if TEST's expected result type matches RESULT."
! (ert-test-result-type-p result (ert-test-expected-result-type test)))
(defun ert-select-tests (selector universe)
"Return a list of tests that match SELECTOR.
--- 927,935 ----
(defun ert-test-result-expected-p (test result)
"Return non-nil if TEST's expected result type matches RESULT."
! (or
! (ert-test-result-type-p result :skipped)
! (ert-test-result-type-p result (ert-test-expected-result-type test))))
(defun ert-select-tests (selector universe)
"Return a list of tests that match SELECTOR.
***************
*** 1085,1090 ****
--- 1115,1121 ----
(passed-unexpected 0)
(failed-expected 0)
(failed-unexpected 0)
+ (skipped 0)
(start-time nil)
(end-time nil)
(aborted-p nil)
***************
*** 1103,1112 ****
(+ (ert--stats-passed-unexpected stats)
(ert--stats-failed-unexpected stats)))
(defun ert-stats-completed (stats)
"Number of tests in STATS that have run so far."
(+ (ert-stats-completed-expected stats)
! (ert-stats-completed-unexpected stats)))
(defun ert-stats-total (stats)
"Number of tests in STATS, regardless of whether they have run yet."
--- 1134,1148 ----
(+ (ert--stats-passed-unexpected stats)
(ert--stats-failed-unexpected stats)))
+ (defun ert-stats-skipped (stats)
+ "Number of tests in STATS that have skipped."
+ (ert--stats-skipped stats))
+
(defun ert-stats-completed (stats)
"Number of tests in STATS that have run so far."
(+ (ert-stats-completed-expected stats)
! (ert-stats-completed-unexpected stats)
! (ert-stats-skipped stats)))
(defun ert-stats-total (stats)
"Number of tests in STATS, regardless of whether they have run yet."
***************
*** 1138,1143 ****
--- 1174,1181 ----
(cl-incf (ert--stats-passed-expected stats) d))
(ert-test-failed
(cl-incf (ert--stats-failed-expected stats) d))
+ (ert-test-skipped
+ (cl-incf (ert--stats-skipped stats) d))
(null)
(ert-test-aborted-with-non-local-exit)
(ert-test-quit))
***************
*** 1146,1151 ****
--- 1184,1191 ----
(cl-incf (ert--stats-passed-unexpected stats) d))
(ert-test-failed
(cl-incf (ert--stats-failed-unexpected stats) d))
+ (ert-test-skipped
+ (cl-incf (ert--stats-skipped stats) d))
(null)
(ert-test-aborted-with-non-local-exit)
(ert-test-quit)))))
***************
*** 1240,1245 ****
--- 1280,1286 ----
(let ((s (cl-etypecase result
(ert-test-passed ".P")
(ert-test-failed "fF")
+ (ert-test-skipped "sS")
(null "--")
(ert-test-aborted-with-non-local-exit "aA")
(ert-test-quit "qQ"))))
***************
*** 1252,1257 ****
--- 1293,1299 ----
(let ((s (cl-etypecase result
(ert-test-passed '("passed" "PASSED"))
(ert-test-failed '("failed" "FAILED"))
+ (ert-test-skipped '("skipped" "SKIPPED"))
(null '("unknown" "UNKNOWN"))
(ert-test-aborted-with-non-local-exit '("aborted" "ABORTED"))
(ert-test-quit '("quit" "QUIT")))))
***************
*** 1318,1325 ****
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
(let ((unexpected (ert-stats-completed-unexpected stats))
! (expected-failures (ert--stats-failed-expected stats)))
! (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
(if (not abortedp)
""
"Aborted: ")
--- 1360,1368 ----
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
(let ((unexpected (ert-stats-completed-unexpected stats))
! (skipped (ert-stats-skipped stats))
! (expected-failures (ert--stats-failed-expected stats)))
! (message "\n%sRan %s tests, %s results as expected%s%s (%s)%s\n"
(if (not abortedp)
""
"Aborted: ")
***************
*** 1328,1333 ****
--- 1371,1379 ----
(if (zerop unexpected)
""
(format ", %s unexpected" unexpected))
+ (if (zerop skipped)
+ ""
+ (format ", %s skipped" skipped))
(ert--format-time-iso8601 (ert--stats-end-time stats))
(if (zerop expected-failures)
""
***************
*** 1340,1345 ****
--- 1386,1400 ----
(message "%9s %S"
(ert-string-for-test-result result nil)
(ert-test-name test))))
+ (message "%s" ""))
+ (unless (zerop skipped)
+ (message "%s skipped results:" skipped)
+ (cl-loop for test across (ert--stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (when (ert-test-result-type-p result :skipped)
+ (message "%9s %S"
+ (ert-string-for-test-result result nil)
+ (ert-test-name test))))
(message "%s" "")))))
(test-started
)
***************
*** 1562,1576 ****
(ert--insert-human-readable-selector (ert--stats-selector stats))
(insert "\n")
(insert
! (format (concat "Passed: %s\n"
! "Failed: %s\n"
! "Total: %s/%s\n\n")
(ert--results-format-expected-unexpected
(ert--stats-passed-expected stats)
(ert--stats-passed-unexpected stats))
(ert--results-format-expected-unexpected
(ert--stats-failed-expected stats)
(ert--stats-failed-unexpected stats))
run-count
(ert-stats-total stats)))
(insert
--- 1617,1633 ----
(ert--insert-human-readable-selector (ert--stats-selector stats))
(insert "\n")
(insert
! (format (concat "Passed: %s\n"
! "Failed: %s\n"
! "Skipped: %s\n"
! "Total: %s/%s\n\n")
(ert--results-format-expected-unexpected
(ert--stats-passed-expected stats)
(ert--stats-passed-unexpected stats))
(ert--results-format-expected-unexpected
(ert--stats-failed-expected stats)
(ert--stats-failed-unexpected stats))
+ (ert-stats-skipped stats)
run-count
(ert-stats-total stats)))
(insert
next prev parent reply other threads:[~2013-10-21 15:08 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-10-20 3:42 bug#9803: Add ERT option to skip test Glenn Morris
2013-07-04 18:40 ` Michael Albinus
2013-10-18 13:37 ` bug#9803: [PATCH] " Michael Albinus
2013-10-19 1:02 ` Glenn Morris
2013-10-19 2:12 ` Stefan Monnier
2013-10-19 6:44 ` Michael Albinus
2013-10-19 6:44 ` Michael Albinus
2013-10-20 2:02 ` Glenn Morris
2013-10-20 14:09 ` Michael Albinus
2013-10-21 15:08 ` Michael Albinus [this message]
2013-10-21 16:53 ` Stefan Monnier
2013-10-21 17:02 ` Michael Albinus
2013-10-21 19:23 ` Stefan Monnier
2013-10-22 8:23 ` Michael Albinus
2013-10-23 12:21 ` Michael Albinus
2013-10-24 7:46 ` Michael Albinus
2013-10-24 8:00 ` Glenn Morris
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87ppqywtjk.fsf@gmx.de \
--to=michael.albinus@gmx.de \
--cc=9803@debbugs.gnu.org \
--cc=rgm@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).