=== 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-20 13:55:50 +0000 *************** *** 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. --- 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', `should-error' and `skip-if' are useful ! for assertions in BODY. Use `ert' to run tests interactively. *************** *** 237,242 **** --- 237,243 ---- (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 **** --- 248,258 ---- 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 of the failure." + (signal 'ert-test-skipped (list data))) + ;;; The `should' macros. *************** *** 425,430 **** --- 431,446 ---- (list :fail-reason "did not signal an error"))))))))) + (cl-defmacro 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 **** --- 660,666 ---- (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 **** --- 745,751 ---- (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 **** --- 755,764 ---- (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,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. --- 884,890 ---- 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 **** --- 897,903 ---- ((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. --- 922,930 ---- (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 **** --- 1110,1116 ---- (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." --- 1129,1143 ---- (+ (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 **** --- 1169,1176 ---- (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 **** --- 1179,1186 ---- (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 **** --- 1275,1281 ---- (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 **** --- 1288,1294 ---- (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"))))) *************** *** 1317,1330 **** (ert--format-time-iso8601 (ert--stats-start-time stats))))) (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: ") (ert-stats-total stats) ! (ert-stats-completed-expected stats) (if (zerop unexpected) "" (format ", %s unexpected" unexpected)) --- 1354,1371 ---- (ert--format-time-iso8601 (ert--stats-start-time stats))))) (run-ended (cl-destructuring-bind (stats abortedp) event-args ! (let ((skipped (ert-stats-skipped stats)) ! (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)%s\n" (if (not abortedp) "" "Aborted: ") (ert-stats-total stats) ! (ert-stats-completed-expected stats) ! (if (zerop skipped) ! "" ! (format ", %s skipped" skipped)) (if (zerop unexpected) "" (format ", %s unexpected" unexpected)) *************** *** 1332,1337 **** --- 1373,1387 ---- (if (zerop expected-failures) "" (format "\n%s expected failures" expected-failures))) + (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" "")) (unless (zerop unexpected) (message "%s unexpected results:" unexpected) (cl-loop for test across (ert--stats-tests stats) *************** *** 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 --- 1612,1628 ---- (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