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: Sun, 20 Oct 2013 16:09:07 +0200	[thread overview]
Message-ID: <87txgcyqyk.fsf@gmx.de> (raw)
In-Reply-To: <sw1u3ihy2y.fsf@fencepost.gnu.org> (Glenn Morris's message of "Fri, 18 Oct 2013 21:02:45 -0400")

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

Glenn Morris <rgm@gnu.org> 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 123.patch --]
[-- Type: text/x-patch, Size: 11887 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-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

  parent reply	other threads:[~2013-10-20 14:09 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 ` bug#9803: [PATCH] " Michael Albinus
2013-10-19  1:02   ` 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 [this message]
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=87txgcyqyk.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).