* 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.

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