procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* emacs-lisp/ert.el (ert-deftest): Bind macro `skip-unless'.

Browse source 
(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.
This commit is contained in:
Michael Albinus 2013-10-24 09:34:41 +02:00
parent 9698f11c57
commit 50b5b85741
2 changed files with 94 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lisp/ChangeLog
View file

@ -1,3 +1,17 @@
2013-10-24 Michael Albinus <michael.albinus@gmx.de>
* 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 <rgm@gnu.org>
* Makefile.in (check-declare): Remove unnecessary path in -l argument.

101
lisp/emacs-lisp/ert.el
View file

@ -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)))