[nongnu] elpa/buttercup 392b99c 310/340: Extend batch reporters to optionally print sparse reports

[ELPA Syncer]

branch: elpa/buttercup
commit 392b99cb8e3b14cb629862cb08cd1583edebd39c
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Extend batch reporters to optionally print sparse reports
    
    By adding any of the statuses `passed', `pending', `skipped' or
    `failed' to the variable buttercup-reporter-batch-quiet-statuses, any
    specs with that status will not be listed by the batch reporter.
    
    Any suite that only contains such quieted spec will not be printed
    either.  Suites containing no specs also wont be printed if any status
    is listed in buttercup-reporter-batch-quiet-statuses.
    
    Add new options --silent-skipping and --quiet to bin/buttercup for two
    common combinations of silenced statuses.
    
    Fixes #161.
---
 bin/buttercup           |  13 ++++-
 buttercup.el            |  71 ++++++++++++++++++++++++----
 docs/running-tests.md   |   5 +-
 tests/test-buttercup.el | 123 +++++++++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 198 insertions(+), 14 deletions(-)

diff --git a/bin/buttercup b/bin/buttercup
index db5dee7..92a94fc 100755
--- a/bin/buttercup
+++ b/bin/buttercup
@@ -34,6 +34,14 @@ Buttercup options:
                           description (the concatenation of the test
                           and all paremt suites descriptions).
 
+--no-skip               Do not print the descriptions for tests that
+                          are filtered out with "--pattern" or disabled
+                          with "xit". Tests skipped wiath "assume" will
+                          still be priuted,
+
+--only-error            Only print failed tests and their containing suites.
+                          Implies "--no-skip".
+
 --no-color, -c          Do not colorize test output.
 
 --traceback STYLE       When printing backtraces for errors that occur
@@ -73,7 +81,7 @@ do
             shift
             shift
             ;;
-        "-c"|"--no-color")
+        "-c"|"--no-color"|"--no-skip"|"--only-error")
             BUTTERCUP_ARGS+=("$1")
             shift
             ;;
@@ -90,4 +98,5 @@ do
     esac
 done
 
-exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f 
buttercup-run-discover "${BUTTERCUP_ARGS[@]}"
+# `--' is needed so that Buttercup options don't get parsed by Emacs itself.
+exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f 
buttercup-run-discover -- "${BUTTERCUP_ARGS[@]}"
diff --git a/buttercup.el b/buttercup.el
index 4d9e22b..5c7aab0 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -1357,6 +1357,8 @@ current directory."
         (args command-line-args-left))
     (while args
       (cond
+       ((equal (car args) "--")
+        (setq args (cdr args)))
        ((member (car args) '("--traceback"))
         (when (not (cdr args))
           (error "Option requires argument: %s" (car args)))
@@ -1373,6 +1375,14 @@ current directory."
        ((member (car args) '("-c" "--no-color"))
         (setq buttercup-color nil)
         (setq args (cdr args)))
+       ((equal (car args) "--no-skip")
+        (push 'skipped buttercup-reporter-batch-quiet-statuses)
+        (push 'disabled buttercup-reporter-batch-quiet-statuses)
+        (setq args (cdr args)))
+       ((equal (car args) "--only-error")
+        (push 'pending buttercup-reporter-batch-quiet-statuses)
+        (push 'passed buttercup-reporter-batch-quiet-statuses)
+        (setq args (cdr args)))
        (t
         (push (car args) dirs)
         (setq args (cdr args)))))
@@ -1595,6 +1605,34 @@ EVENT and ARG are described in `buttercup-reporter'."
 (defvar buttercup-reporter-batch--failures nil
   "List of failed specs of the current batch report.")
 
+(defvar buttercup-reporter-batch-quiet-statuses nil
+  "Do not print results for any spec with any of the listed statuses.")
+
+(defvar buttercup-reporter-batch--suite-stack nil
+  "Stack of unprinted suites.")
+
+(defun buttercup-reporter-batch--quiet-spec-p (spec)
+  "Return non-nil if the status of SPEC is any of the quiet statuses.
+SPEC is considered quiet if its status is listed in
+`buttercup-reporter-batch-quiet-statuses'.
+
+Two special statuses can be listed in
+`buttercup-reporter-batch-quiet-statuses';
+ `skipped': Real spec status `pending' and failure description \"SKIPPED\".
+            This matches specs filtered out with `buttercup-mark-skipped'.
+ `disabled': Real spec status `pending' and failure description \"PENDING\".
+             This matches specs disabled with `xit' or equivalent."
+  (or (memq (buttercup-spec-status spec) 
buttercup-reporter-batch-quiet-statuses)
+      ;; check for the virtual status `skipped'
+      (and (memq 'skipped buttercup-reporter-batch-quiet-statuses)
+           (eq (buttercup-spec-status spec) 'pending)
+           (string= (buttercup-spec-failure-description spec) "SKIPPED"))
+      ;; check for the virtual status `disabled'
+      (and (memq 'disabled buttercup-reporter-batch-quiet-statuses)
+           (eq (buttercup-spec-status spec) 'pending)
+           (string= (buttercup-spec-failure-description spec) "PENDING"))
+      ))
+
 (defun buttercup-reporter-batch (event arg)
   "A reporter that handles batch sessions.
 
@@ -1604,7 +1642,8 @@ EVENT and ARG are described in `buttercup-reporter'."
     (pcase event
       (`buttercup-started
        (setq buttercup-reporter-batch--start-time (current-time)
-             buttercup-reporter-batch--failures nil)
+             buttercup-reporter-batch--failures nil
+             buttercup-reporter-batch--suite-stack nil)
        (let ((defined (buttercup-suites-total-specs-defined arg))
              (pending (buttercup-suites-total-specs-pending arg)))
          (if (> pending 0)
@@ -1614,21 +1653,37 @@ EVENT and ARG are described in `buttercup-reporter'."
            (buttercup--print "Running %s specs.\n\n" defined))))
 
       (`suite-started
-         (buttercup--print "%s\n" (buttercup--indented-description arg)))
+       (if buttercup-reporter-batch-quiet-statuses
+           (push arg buttercup-reporter-batch--suite-stack)
+         (buttercup--print "%s\n" (buttercup--indented-description arg))))
       (`spec-started
-       (unless (and buttercup-color
-                    (string-match-p "[\n\v\f]" (buttercup-spec-description 
arg)))
-         (buttercup--print "%s" (buttercup--indented-description arg))))
+       (or buttercup-reporter-batch-quiet-statuses
+           (and buttercup-color
+                (string-match-p "[\n\v\f]" (buttercup-spec-description arg)))
+           (buttercup--print "%s" (buttercup--indented-description arg))))
       (`spec-done
+       (when (and buttercup-reporter-batch-quiet-statuses
+                  (not (buttercup-reporter-batch--quiet-spec-p arg)))
+         (dolist (suite (nreverse buttercup-reporter-batch--suite-stack))
+           (buttercup--print "%s\n" (buttercup--indented-description suite)))
+         (setq buttercup-reporter-batch--suite-stack nil)
+         (buttercup--print "%s" (buttercup--indented-description arg)))
+
+       (unless (buttercup-reporter-batch--quiet-spec-p arg)
+         (buttercup-reporter-batch--print-spec-done-line arg buttercup-color))
+
        (when (eq (buttercup-spec-status arg) 'failed)
          (setq buttercup-reporter-batch--failures
                (append buttercup-reporter-batch--failures
-                       (list arg))))
-       (buttercup-reporter-batch--print-spec-done-line arg buttercup-color))
+                       (list arg)))))
 
       (`suite-done
        (when (= 0 (length (buttercup-suite-or-spec-parents arg)))
-         (buttercup--print "\n")))
+         (if buttercup-reporter-batch-quiet-statuses
+             (unless buttercup-reporter-batch--suite-stack
+               (buttercup--print "\n"))
+           (buttercup--print "\n")))
+       (pop buttercup-reporter-batch--suite-stack))
 
       (`buttercup-done
        (dolist (failed buttercup-reporter-batch--failures)
diff --git a/docs/running-tests.md b/docs/running-tests.md
index 8bebdec..2280241 100644
--- a/docs/running-tests.md
+++ b/docs/running-tests.md
@@ -30,7 +30,7 @@ feature/feature.el
 
 **feature.el**
 
-```Lisp
+```Emacs-Lisp
 (defun featurize (bug feature)
   (format "It's not a %s, it's a %s" bug feature))
 
@@ -100,7 +100,8 @@ named `test-*.el`, `*-test.el` or `*-tests.el`.
 Use the `--pattern PATTERN` option to only Only run tests with names
 matching PATTERN. The `--pattern` option can be used multiple times,
 in which case tests will be run if they match any of the given
-patterns.
+patterns. Combine with the `--no-skip` option to filter out the
+skipped tests.
 
 You can run this command whichever way you like. Common choices
 include a makefile or shell scripts.
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index d044d3a..9136015 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -37,11 +37,19 @@
 
 (defmacro with-local-buttercup (&rest body)
   "Execute BODY with local buttercup state variables.
-Keyword arguments kan be used to override the values of `buttercup-KEY'.
+Keyword arguments kan be used to override the values of certain
+variables:
+ :color    -> `buttercup-color'
+ :reporter -> `buttercup-reporter'
+ :suites   -> `buttercup-suites'
+ :quiet    -> `buttercup-reporter-batch-quiet-statuses'
 \n(fn &keys COLOR SUITES REPORTER &rest BODY)"
   (declare (debug t) (indent defun))
   ;; extract keyword arguments
-  (let ((keys '(:color buttercup-color :suites buttercup-suites :reporter 
buttercup-reporter))
+  (let ((keys '(:color buttercup-color
+                       :reporter buttercup-reporter
+                       :suites buttercup-suites
+                       :quiet buttercup-reporter-batch-quiet-statuses))
         extra-vars)
     (while (plist-member keys (car body))
       (push (list (plist-get keys (pop body)) (pop body)) extra-vars))
@@ -53,6 +61,8 @@ Keyword arguments kan be used to override the values of 
`buttercup-KEY'.
          buttercup--current-suite
          (buttercup-reporter #'ignore)
          buttercup-suites
+         buttercup-reporter-batch-quiet-statuses
+         buttercup-reporter-batch--suite-stack
          buttercup-reporter-batch--failures
          (buttercup-warning-buffer-name " *ignored buttercup warnings*")
          ,@(nreverse extra-vars))
@@ -1341,6 +1351,115 @@ text properties using `ansi-color-apply'."
         (expect (buttercup-reporter-batch 'unknown-event nil)
                 :to-throw)))))
 
+(describe "When using quiet specs in the batch reporter"
+  :var (print-buffer)
+  (before-each
+    (setq print-buffer (generate-new-buffer "*btrcp-reporter-test*"))
+    (spy-on 'send-string-to-terminal :and-call-fake
+            (apply-partially #'send-string-to-ansi-buffer print-buffer))
+    ;; Convenience function
+    (spy-on 'buttercup-output :and-call-fake
+            (lambda ()
+              "Return the text of `print-buffer'."
+              (with-current-buffer print-buffer
+                (buffer-string)))))
+  (after-each
+    (kill-buffer print-buffer)
+    (setq print-buffer nil))
+
+  (it "should print nothing if all specs are quiet"
+    (with-local-buttercup :color nil :quiet '(pending) :reporter 
#'buttercup-reporter-batch
+      (describe "top"
+        (it "spec 1")
+        (describe "second"
+          (it "spec 2")
+          (it "spec 3")))
+      (describe "empty")
+      (buttercup-run))
+    (expect (buttercup-output) :to-match
+            "^Running 0 out of 3 specs\\.\n\nRan 0 out of 3 specs, 0 failed, 
in [0-9.]+ms\\.$"))
+
+  (it "should print the containing suites for non-quiet specs"
+    (with-local-buttercup :color nil :quiet '(pending) :reporter 
#'buttercup-reporter-batch
+      (describe "top"
+        (it "spec 1" (ignore))
+        (describe "second"
+          (it "spec 2")
+          (it "spec 3" (ignore))
+          (describe "third"
+            (it "spec 4"))))
+      (describe "empty")
+      (buttercup-run))
+    (expect (buttercup-output) :to-match
+            (concat "^Running 2 out of 4 specs\\.\n\n"
+                    "top\n"
+                    "  spec 1 ([0-9.]+ms)\n"
+                    "  second\n"
+                    "    spec 3 ([0-9.]+ms)\n\n"
+                    "Ran 2 out of 4 specs, 0 failed, in [0-9.]+ms\\.$")))
+
+  (it "should quiet all of the given spec statuses"
+    ;; suppress stacktraces printed at buttercup-done
+    (spy-on 'buttercup-reporter-batch--print-failed-spec-report)
+    (with-local-buttercup
+      :color nil :quiet '(pending passed failed) :reporter 
#'buttercup-reporter-batch
+      (describe "passed"
+        (it "passed" (ignore)))
+      (describe "failed"
+        (it "failed" (buttercup-fail "because")))
+      (describe "pending"
+        (it "pending"))
+      (buttercup-run t))
+    (expect (buttercup-output) :to-match
+            "^Running 2 out of 3 specs\\.\n\nRan 2 out of 3 specs, 1 failed, 
in [0-9.]+ms\\.$"))
+
+  (it "should handle `skipped' virtual status in quiet list"
+    ;; suppress stacktraces printed at buttercup-done
+    (spy-on 'buttercup-reporter-batch--print-failed-spec-report)
+    (with-local-buttercup
+      :color nil :quiet '(skipped) :reporter #'buttercup-reporter-batch
+      (describe "passed"
+        (it "passed" (ignore)))
+      (describe "failed"
+        (it "failed" (buttercup-fail "because")))
+      (describe "pending"
+        (it "pending"))
+      (describe "skipped"
+        (it "skipped" (ignore)))
+      (buttercup-mark-skipped "skipped")
+      (buttercup-run t))
+    (expect (buttercup-output) :to-match
+            (concat "^Running 2 out of 4 specs\\.\n\n"
+                    "passed\n  passed ([0-9.]+ms)\n\n"
+                    "failed\n  failed  because ([0-9.]+ms)\n\n"
+                    "pending\n  pending  PENDING ([0-9.]+ms)\n\n"
+                    "Ran 2 out of 4 specs, 1 failed, in [0-9.]+ms\\.\n$")))
+
+    (it "should handle `disabled' virtual status in quiet list"
+      ;; suppress stacktraces printed at buttercup-done
+      (spy-on 'buttercup-reporter-batch--print-failed-spec-report)
+      (with-local-buttercup
+        :color nil :quiet '(disabled) :reporter #'buttercup-reporter-batch
+        (describe "passed"
+          (it "passed" (ignore)))
+        (describe "failed"
+          (it "failed" (buttercup-fail "because")))
+        (describe "pending"
+          (it "pending"))
+        (describe "skipped"
+          (it "skipped" (ignore)))
+        (buttercup-mark-skipped "skipped")
+        (buttercup-run t))
+      (expect (buttercup-output) :to-match
+              (concat "^Running 2 out of 4 specs\\.\n\n"
+                      "passed\n  passed ([0-9.]+ms)\n\n"
+                      "failed\n  failed  because ([0-9.]+ms)\n\n"
+                      "skipped\n  skipped  SKIPPED ([0-9.]+ms)\n\n"
+                      "Ran 2 out of 4 specs, 1 failed, in [0-9.]+ms\\.\n$"))))
+
+;;;;;;;;;;;;;;;;;;;;;
+;;; buttercup-run
+
 (describe "The `buttercup-run' function"
   :var (parent-suite child-suite spec)
   (before-each