Subject: bug#9803: [PATCH] Add ERT option to skip test

From: Michael Albinus <[email-masked]>
Date: Sun, 20 Oct 2013 16:09:07 +0200

Glenn Morris <[email-masked]> writes:

Hi Glenn,

> I think `skip-if' should have an ert- prefix. (I know `should' doesn't,
> but I think it, err, should as well. But too late for that one now.)

I've tried to change it as proposed by Stefan, but I'm too stupid to
manage all this sophisticated cl-* stuff :-(

> Also, ert-run-tests-batch-and-exit seems to need updating:
>
>   Running 1 tests (2013-10-18 17:49:11-0700)
>     skipped  1/1  foo-test
>
>   Ran 1 tests, 0 results as expected (2013-10-18 17:49:11-0700)
>
> I don't think "0 results as expected" is appropriate.
>
> Eg automake uses a summary like this:
> http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11745

Such a verbose summary is returned when you run the tests
interactively. I've reworked the patch in order to give also valid
statistics in batch mode.

Best regards, Michael.

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