unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Michael Albinus <michael.albinus@gmx.de>
To: Glenn Morris <rgm@gnu.org>
Cc: 9803@debbugs.gnu.org
Subject: bug#9803: [PATCH] Add ERT option to skip test
Date: Fri, 18 Oct 2013 15:37:52 +0200	[thread overview]
Message-ID: <87vc0usnrj.fsf@gmx.de> (raw)
In-Reply-To: <rqr528fhvu.fsf@fencepost.gnu.org> (Glenn Morris's message of "Wed, 19 Oct 2011 23:42:45 -0400")

[-- Attachment #1: Type: text/plain, Size: 744 bytes --]

Glenn Morris <rgm@gnu.org> writes:

Hi Glenn,

> I think it would be nice if ert had the ability to skip tests.
> Eg, a :skip argument that works the same way as :expected-result.
> This would be useful eg when a test relies on external executable that
> might not be installed on the system running the tests. You can get the
> same result by using :expected-result, but :skip might be nicer in such
> cases.

I have written a new macro, which should do the job. It is called
`skip-if' and works like `should' and companions. You pass a form as
argument, and when it returns non-nil the test is skipped.

Test summary is showing skipped tests.

Could you, please, check the appended patch, whether it fits your needs?

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ert.el.patch --]
[-- Type: text/x-diff, Size: 9284 bytes --]

=== 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-18 13:07:57 +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")))))
***************
*** 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
--- 1599,1615 ----
         (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

  parent reply	other threads:[~2013-10-18 13:37 UTC|newest]

Thread overview: 17+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-10-20  3:42 bug#9803: Add ERT option to skip test Glenn Morris
2013-07-04 18:40 ` Michael Albinus
2013-10-18 13:37 ` Michael Albinus [this message]
2013-10-19  1:02   ` bug#9803: [PATCH] " Glenn Morris
2013-10-19  2:12     ` Stefan Monnier
2013-10-19  6:44       ` Michael Albinus
2013-10-19  6:44     ` Michael Albinus
2013-10-20  2:02       ` Glenn Morris
2013-10-20 14:09     ` Michael Albinus
2013-10-21 15:08       ` Michael Albinus
2013-10-21 16:53         ` Stefan Monnier
2013-10-21 17:02           ` Michael Albinus
2013-10-21 19:23             ` Stefan Monnier
2013-10-22  8:23               ` Michael Albinus
2013-10-23 12:21                 ` Michael Albinus
2013-10-24  7:46                   ` Michael Albinus
2013-10-24  8:00                     ` Glenn Morris

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87vc0usnrj.fsf@gmx.de \
    --to=michael.albinus@gmx.de \
    --cc=9803@debbugs.gnu.org \
    --cc=rgm@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).