From 50b5b857412f310d69cac74ffe906837da6757c6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 24 Oct 2013 09:34:41 +0200 Subject: [PATCH] * emacs-lisp/ert.el (ert-deftest): Bind macro `skip-unless'. (ert-test-skipped): New error. (ert-skip, ert-stats-skipped): New defuns. (ert--skip-unless): New macro. (ert-test-skipped): New struct. (ert--run-test-debugger, ert-test-result-type-p) (ert-test-result-expected-p, ert--stats, ert-stats-completed) (ert--stats-set-test-and-result, ert-char-for-test-result) (ert-string-for-test-result, ert-run-tests-batch) (ert--results-update-ewoc-hf, ert-run-tests-interactively): Handle skipped tests. --- lisp/ChangeLog | 14 +++++++ lisp/emacs-lisp/ert.el | 101 +++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 94 insertions(+), 21 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f69ec89b48d..587535e328e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2013-10-24 Michael Albinus + + * emacs-lisp/ert.el (ert-deftest): Bind macro `skip-unless'. + (ert-test-skipped): New error. + (ert-skip, ert-stats-skipped): New defuns. + (ert--skip-unless): New macro. + (ert-test-skipped): New struct. + (ert--run-test-debugger, ert-test-result-type-p) + (ert-test-result-expected-p, ert--stats, ert-stats-completed) + (ert--stats-set-test-and-result, ert-char-for-test-result) + (ert-string-for-test-result, ert-run-tests-batch) + (ert--results-update-ewoc-hf, ert-run-tests-interactively): Handle + skipped tests. + 2013-10-24 Glenn Morris * Makefile.in (check-declare): Remove unnecessary path in -l argument. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 409e4faf4d5..c63c5324c9f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -34,14 +34,17 @@ ;; `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. +;; additional operators `should', `should-not', `should-error' and +;; `skip-unless' 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-unless' skips the test immediately without +;; processing further, this is useful for checking the test +;; environment (like availability of features, 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,8 +177,8 @@ and the body." 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. +`should', `should-not', `should-error' and `skip-unless' are +useful for assertions in BODY. Use `ert' to run tests interactively. @@ -200,7 +203,7 @@ description of valid values for RESULT-TYPE. (tags nil tags-supplied-p)) body) (ert--parse-keys-and-body docstring-keys-and-body) - `(progn + `(cl-macrolet ((skip-unless (form) `(ert--skip-unless ,form))) (ert-set-test ',name (make-ert-test :name ',name @@ -237,6 +240,7 @@ description of valid values for RESULT-TYPE. (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,6 +251,11 @@ description of valid values for RESULT-TYPE. 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,6 +434,15 @@ failed." (list :fail-reason "did not signal an error"))))))))) +(cl-defmacro ert--skip-unless (form) + "Evaluate FORM. If it returns nil, skip the current test. +Errors during evaluation are catched and handled like nil." + (declare (debug t)) + (ert--expand-should `(skip-unless ,form) form + (lambda (inner-form form-description-form _value-var) + `(unless (ignore-errors ,inner-form) + (ert-skip ,form-description-form))))) + ;;; Explanation of `should' failures. @@ -644,6 +662,7 @@ and is displayed in front of the value of MESSAGE-FORM." (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,6 +747,7 @@ run. ARGS are the arguments to `debugger'." (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,6 +757,10 @@ run. ARGS are the arguments to `debugger'." (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 @@ -862,7 +886,7 @@ Valid result types: nil -- Never matches. t -- Always matches. -:failed, :passed -- Matches corresponding results. +: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,6 +899,7 @@ t -- Always matches. ((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,7 +924,9 @@ t -- Always matches. (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))) + (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,6 +1112,7 @@ contained in UNIVERSE." (passed-unexpected 0) (failed-expected 0) (failed-unexpected 0) + (skipped 0) (start-time nil) (end-time nil) (aborted-p nil) @@ -1103,10 +1131,15 @@ contained in UNIVERSE." (+ (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-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,6 +1171,8 @@ Also changes the counters in STATS to match." (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,6 +1181,8 @@ Also changes the counters in STATS to match." (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,6 +1277,7 @@ EXPECTEDP specifies whether the result was expected." (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,6 +1290,7 @@ EXPECTEDP specifies whether the result was expected." (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,8 +1357,9 @@ Returns the stats object." (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" + (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,6 +1368,9 @@ Returns the stats object." (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,6 +1383,15 @@ Returns the stats object." (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,15 +1614,17 @@ Also sets `ert--results-progress-bar-button-begin'." (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") + (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 @@ -1850,7 +1904,7 @@ and how to display message." (run-ended (cl-destructuring-bind (stats abortedp) event-args (funcall message-fn - "%sRan %s tests, %s results were as expected%s" + "%sRan %s tests, %s results were as expected%s%s" (if (not abortedp) "" "Aborted: ") @@ -1860,7 +1914,12 @@ and how to display message." (ert-stats-completed-unexpected stats))) (if (zerop unexpected) "" - (format ", %s unexpected" unexpected)))) + (format ", %s unexpected" unexpected))) + (let ((skipped + (ert-stats-skipped stats))) + (if (zerop skipped) + "" + (format ", %s skipped" skipped)))) (ert--results-update-stats-display (with-current-buffer buffer ert--results-ewoc) stats))) -- 2.11.4.GIT