From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Michael Albinus Newsgroups: gmane.emacs.bugs Subject: bug#9803: [PATCH] Add ERT option to skip test Date: Mon, 21 Oct 2013 17:08:31 +0200 Message-ID: <87ppqywtjk.fsf@gmx.de> References: <87vc0usnrj.fsf@gmx.de> <87txgcyqyk.fsf@gmx.de> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1382368160 23747 80.91.229.3 (21 Oct 2013 15:09:20 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2013 15:09:20 +0000 (UTC) Cc: 9803@debbugs.gnu.org To: Glenn Morris Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Oct 21 17:09:19 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VYH6d-0001d4-4I for geb-bug-gnu-emacs@m.gmane.org; Mon, 21 Oct 2013 17:09:19 +0200 Original-Received: from localhost ([::1]:40379 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYH6c-0007Nl-Jv for geb-bug-gnu-emacs@m.gmane.org; Mon, 21 Oct 2013 11:09:18 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48275) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYH6T-0007NL-9j for bug-gnu-emacs@gnu.org; Mon, 21 Oct 2013 11:09:15 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VYH6N-0001cN-7g for bug-gnu-emacs@gnu.org; Mon, 21 Oct 2013 11:09:09 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:46824) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYH6N-0001cJ-4r for bug-gnu-emacs@gnu.org; Mon, 21 Oct 2013 11:09:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1VYH6M-0007r9-OZ for bug-gnu-emacs@gnu.org; Mon, 21 Oct 2013 11:09:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Michael Albinus Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 21 Oct 2013 15:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 9803 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 9803-submit@debbugs.gnu.org id=B9803.138236812630166 (code B ref 9803); Mon, 21 Oct 2013 15:09:02 +0000 Original-Received: (at 9803) by debbugs.gnu.org; 21 Oct 2013 15:08:46 +0000 Original-Received: from localhost ([127.0.0.1]:60843 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYH65-0007qQ-GN for submit@debbugs.gnu.org; Mon, 21 Oct 2013 11:08:46 -0400 Original-Received: from mout.gmx.net ([212.227.17.20]:54922) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYH62-0007q4-1u for 9803@debbugs.gnu.org; Mon, 21 Oct 2013 11:08:44 -0400 Original-Received: from detlef.gmx.de ([93.202.58.207]) by mail.gmx.com (mrgmx101) with ESMTPS (Nemesis) id 0M2XkX-1VoZSW2ENB-00sJRl for <9803@debbugs.gnu.org>; Mon, 21 Oct 2013 17:08:36 +0200 In-Reply-To: <87txgcyqyk.fsf@gmx.de> (Michael Albinus's message of "Sun, 20 Oct 2013 16:09:07 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-Provags-ID: V03:K0:oVIUQwUiyt/0Hd8a3r2s1SKC6znEAy977hnkksCNkhJlLnJaApi uq2VKAMHGBXq83WUMhs2KNFGL7LrpAvaZ7Ew51oHmG0/gJ0hE2hQuasVnf5PGqeWQUNgUN4 1JxMmYRNzpfkR13VKeSlvBNgZUWclW77T1199jjGlrFR21yA2asbiA0K3Zi1GZGlCyvhPQb KGNQn3MV2P2lDagf81dVQ== X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 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.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:79455 Archived-At: --=-=-= Content-Type: text/plain Michael Albinus 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. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=123.patch === 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 --=-=-=--