=== 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