middleware.test: offer fail-fast functionality

Fixes #709

Author: vemv

CHANGELOG.md

@@ -7,7 +7,8 @@
 * [#773](https://github.com/clojure-emacs/cider-nrepl/pull/773) Add middleware to capture, debug, inspect and view log events emitted by Java logging frameworks.
 * [#755](https://github.com/clojure-emacs/cider-nrepl/pull/755) `middleware.test`: now timing information is returned at var and ns level under the `:ms`/`:humanized` keys. 
 * `middleware.test`: only include `:diff` data when the expected/actual mismatch is deemed diffable.
-  * i.e., maps and sequences are diffable, scalar values are not.
+  * i.e., maps, sets and sequences are diffable, scalar values are not.
+* [#709](https://github.com/clojure-emacs/cider-nrepl/pull/709) `middleware.test`: offer fail-fast functionality.
 
 ### Changes
 

doc/modules/ROOT/pages/nrepl-api/ops.adoc

@@ -971,6 +971,7 @@ Optional parameters::
 
 Returns::
 * `:elapsed-time` a report of the elapsed time spent running all the given namespaces. The structure is ``:elapsed-time {:ms <integer> :humanized <string>}``.
+* `:fail-fast` If true, the tests will be considered complete after the first test has failed or errored.
 * `:ns-elapsed-time` a report of the elapsed time spent running each namespace. The structure is ``:ns-elapsed-time {<ns as keyword> {:ms <integer> :humanized <string>}}``.
 * `:results` Misc information about the test result. The structure is ``:results {<ns as keyword> {<test var as keyword> [{,,, :elapsed-time {:ms <integer> :humanized <string>}}]}}``
 * `:status` Either done or indication of an error
@@ -1103,6 +1104,7 @@ Optional parameters::
 
 Returns::
 * `:elapsed-time` a report of the elapsed time spent running all the given namespaces. The structure is ``:elapsed-time {:ms <integer> :humanized <string>}``.
+* `:fail-fast` If true, the tests will be considered complete after the first test has failed or errored.
 * `:ns-elapsed-time` a report of the elapsed time spent running each namespace. The structure is ``:ns-elapsed-time {<ns as keyword> {:ms <integer> :humanized <string>}}``.
 * `:results` Misc information about the test result. The structure is ``:results {<ns as keyword> {<test var as keyword> [{,,, :elapsed-time {:ms <integer> :humanized <string>}}]}}``
 * `:status` Either done or indication of an error
@@ -1127,6 +1129,7 @@ Optional parameters::
 
 Returns::
 * `:elapsed-time` a report of the elapsed time spent running all the given namespaces. The structure is ``:elapsed-time {:ms <integer> :humanized <string>}``.
+* `:fail-fast` If true, the tests will be considered complete after the first test has failed or errored.
 * `:ns-elapsed-time` a report of the elapsed time spent running each namespace. The structure is ``:ns-elapsed-time {<ns as keyword> {:ms <integer> :humanized <string>}}``.
 * `:results` Misc information about the test result. The structure is ``:results {<ns as keyword> {<test var as keyword> [{,,, :elapsed-time {:ms <integer> :humanized <string>}}]}}``
 * `:status` Either done or indication of an error
@@ -1172,6 +1175,7 @@ Optional parameters::
 
 Returns::
 * `:elapsed-time` a report of the elapsed time spent running all the given namespaces. The structure is ``:elapsed-time {:ms <integer> :humanized <string>}``.
+* `:fail-fast` If true, the tests will be considered complete after the first test has failed or errored.
 * `:ns-elapsed-time` a report of the elapsed time spent running each namespace. The structure is ``:ns-elapsed-time {<ns as keyword> {:ms <integer> :humanized <string>}}``.
 * `:results` Misc information about the test result. The structure is ``:results {<ns as keyword> {<test var as keyword> [{,,, :elapsed-time {:ms <integer> :humanized <string>}}]}}``
 * `:status` Either done or indication of an error

src/cider/nrepl.clj

@@ -612,29 +612,31 @@ stack frame of the most recent exception. This op is deprecated, please use the
                              "ns-elapsed-time" "a report of the elapsed time spent running each namespace. The structure is `:ns-elapsed-time {<ns as keyword> {:ms <integer> :humanized <string>}}`."
                              "results" "Misc information about the test result. The structure is `:results {<ns as keyword> {<test var as keyword> [{,,, :elapsed-time {:ms <integer> :humanized <string>}}]}}`"})
 
+(def fail-fast-doc {"fail-fast" "If true, the tests will be considered complete after the first test has failed or errored."})
+
 (def-wrapper wrap-test cider.nrepl.middleware.test/handle-test
   {:doc "Middleware that handles testing requests."
    :requires #{#'session #'wrap-print}
    :handles {"test-var-query"
              {:doc "Run tests specified by the `var-query` and return results. Results are cached for exception retrieval and to enable re-running of failed/erring tests."
               :requires {"var-query" "A search query specifying the test vars to execute. See Orchard's var query documentation for more details."}
-              :optional wrap-print-optional-arguments
-              :returns timing-info-return-doc}
+              :optional (merge wrap-print-optional-arguments)
+              :returns (merge fail-fast-doc timing-info-return-doc)}
              "test"
              {:doc "[DEPRECATED - `use test-var-query` instead] Run tests in the specified namespace and return results. This accepts a set of `tests` to be run; if nil, runs all tests. Results are cached for exception retrieval and to enable re-running of failed/erring tests."
               :optional wrap-print-optional-arguments
-              :returns timing-info-return-doc}
+              :returns (merge fail-fast-doc timing-info-return-doc)}
              "test-all"
              {:doc "Return exception cause and stack frame info for an erring test via the `stacktrace` middleware. The error to be retrieved is referenced by namespace, var name, and assertion index within the var."
               :optional wrap-print-optional-arguments
-              :returns timing-info-return-doc}
+              :returns (merge fail-fast-doc timing-info-return-doc)}
              "test-stacktrace"
              {:doc "Rerun all tests that did not pass when last run. Results are cached for exception retrieval and to enable re-running of failed/erring tests."
               :optional wrap-print-optional-arguments}
              "retest"
              {:doc "[DEPRECATED - `use test-var-query` instead] Run all tests in the project. If `load?` is truthy, all project namespaces are loaded; otherwise, only tests in presently loaded namespaces are run. Results are cached for exception retrieval and to enable re-running of failed/erring tests."
               :optional wrap-print-optional-arguments
-              :returns timing-info-return-doc}}})
+              :returns (merge fail-fast-doc timing-info-return-doc)}}})
 
 (def-wrapper wrap-trace cider.nrepl.middleware.trace/handle-trace
   {:doc     "Toggle tracing of a given var."

src/cider/nrepl/middleware/test.clj

@@ -304,69 +304,99 @@
                       :message "Uncaught exception, not in assertion"})]
         (test/do-report (assoc report :var-elapsed-time @time-info))))))
 
+(defn- current-test-run-failed? []
+  (or (some-> @current-report :summary :fail pos?)
+      (some-> @current-report :summary :error pos?)))
+
 (defn test-vars
   "Call `test-var` on each var, with the fixtures defined for namespace object
   `ns`."
-  [ns vars]
-  (let [once-fixture-fn (test/join-fixtures (::test/once-fixtures (meta ns)))
-        each-fixture-fn (test/join-fixtures (::test/each-fixtures (meta ns)))]
-    (try (once-fixture-fn
-          (fn []
-            (doseq [v vars]
-              (each-fixture-fn (fn [] (test-var v))))))
-         (catch Throwable e
-           (when (System/getProperty "cider.internal.testing")
-             ;; print stacktrace, in case it didn't have anything to do with fixtures
-             ;; (in which case, things would become very confusing)
-             (.printStackTrace e))
-           (report-fixture-error ns e)))))
+  ([ns vars]
+   (test-vars ns vars false))
+
+  ([ns vars fail-fast?]
+   (let [once-fixture-fn (test/join-fixtures (::test/once-fixtures (meta ns)))
+         each-fixture-fn (test/join-fixtures (::test/each-fixtures (meta ns)))]
+     (try
+       (once-fixture-fn
+        (fn []
+          (reduce (fn [_ v]
+                    (cond-> (each-fixture-fn (fn []
+                                               (test-var v)))
+                      (and fail-fast? (current-test-run-failed?))
+                      reduced))
+                  nil
+                  vars)))
+       (catch Throwable e
+         (when (System/getProperty "cider.internal.testing")
+           ;; print stacktrace, in case it didn't have anything to do with fixtures
+           ;; (in which case, things would become very confusing)
+           (.printStackTrace e))
+         (report-fixture-error ns e))))))
 
 (defn test-ns
   "If the namespace object defines a function named `test-ns-hook`, call that.
   Otherwise, test the specified vars. On completion, return a map of test
   results."
-  [ns vars]
-  (binding [test/report report]
-    (test/do-report {:type :begin-test-ns, :ns ns})
-    (let [time-info (atom nil)]
-      (timing time-info
-        (if-let [test-hook (ns-resolve ns 'test-ns-hook)]
-          (test-hook)
-          (test-vars ns vars)))
-      (test/do-report {:type :end-test-ns
-                       :ns ns
-                       :ns-elapsed-time @time-info})
-      @current-report)))
+  ([ns vars]
+   (test-ns ns vars false))
+
+  ([ns vars fail-fast?]
+   (binding [test/report report]
+     (test/do-report {:type :begin-test-ns, :ns ns})
+     (let [time-info (atom nil)]
+       (timing time-info
+         (if-let [test-hook (ns-resolve ns 'test-ns-hook)]
+           (test-hook)
+           (test-vars ns vars fail-fast?)))
+       (test/do-report {:type :end-test-ns
+                        :ns ns
+                        :ns-elapsed-time @time-info})
+       @current-report))))
 
 (defn test-var-query
   "Call `test-ns` for each var found via var-query."
-  [var-query]
-  (report-reset!)
-  (let [elapsed-time (atom nil)
-        corpus (group-by
-                (comp :ns meta)
-                (query/vars var-query))]
-    (timing elapsed-time
-      (doseq [[ns vars] corpus]
-        (test-ns ns vars)))
-    (assoc @current-report :elapsed-time @elapsed-time)))
+  ([var-query]
+   (test-var-query var-query false))
+
+  ([var-query fail-fast?]
+   (report-reset!)
+   (let [elapsed-time (atom nil)
+         corpus (group-by
+                 (comp :ns meta)
+                 (query/vars var-query))]
+     (timing elapsed-time
+       (reduce (fn [_ [ns vars]]
+                 (cond-> (test-ns ns vars fail-fast?)
+                   (and fail-fast? (current-test-run-failed?))
+                   reduced))
+               nil
+               corpus))
+     (assoc @current-report :elapsed-time @elapsed-time))))
 
 (defn test-nss
   "Call `test-ns` for each entry in map `m`, in which keys are namespace
   symbols and values are var symbols to be tested in that namespace (or `nil`
   to test all vars). Symbols are first resolved to their corresponding
   objects."
-  [m]
-  (report-reset!)
-  (let [elapsed-time (atom nil)
-        corpus (mapv (fn [[ns vars]]
-                       [(the-ns ns)
-                        (keep (partial ns-resolve ns) vars)])
-                     m)]
-    (timing elapsed-time
-      (doseq [[ns vars] corpus]
-        (test-ns ns vars)))
-    (assoc @current-report :elapsed-time @elapsed-time)))
+  ([m]
+   (test-nss m false))
+
+  ([m fail-fast?]
+   (report-reset!)
+   (let [elapsed-time (atom nil)
+         corpus (mapv (fn [[ns vars]]
+                        [(the-ns ns)
+                         (keep (partial ns-resolve ns) vars)])
+                      m)]
+     (timing elapsed-time
+       (reduce (fn [_ [ns vars]]
+                 (cond-> (test-ns ns vars fail-fast?)
+                   (and fail-fast? (current-test-run-failed?))
+                   reduced))
+               nil
+               corpus))
+     (assoc @current-report :elapsed-time @elapsed-time))))
 
 ;;; ## Middleware
 
@@ -378,8 +408,9 @@
   (atom {}))
 
 (defn handle-test-var-query-op
-  [{:keys [var-query transport session id] :as msg}]
-  (let [{:keys [exec]} (meta session)]
+  [{:keys [fail-fast var-query transport session id] :as msg}]
+  (let [fail-fast? (#{true "true"} fail-fast)
+        {:keys [exec]} (meta session)]
     (exec id
           (fn []
             (with-bindings (assoc @session #'ie/*msg* msg)
@@ -394,7 +425,7 @@
                                  (assoc-in [:ns-query :has-tests?] true)
                                  (assoc :test? true)
                                  (util.coerce/var-query)
-                                 test-var-query
+                                 (test-var-query fail-fast?)
                                  stringify-msg)]
                   (reset! results (:results report))
                   (t/send transport (response-for msg (util/transform-value report))))
@@ -424,7 +455,7 @@
                            :exclude-meta-key exclude}})))
 
 (defn handle-retest-op
-  [{:keys [transport session id] :as msg}]
+  [{:keys [transport session id fail-fast] :as msg}]
   (let [{:keys [exec]} (meta session)]
     (exec id
           (fn []
@@ -433,9 +464,11 @@
                                   (let [problems (filter (comp #{:fail :error} :type)
                                                          (mapcat val tests))
                                         vars (distinct (map :var problems))]
-                                    (if (seq vars) (assoc ret ns vars) ret)))
+                                    (if (seq vars)
+                                      (assoc ret ns vars)
+                                      ret)))
                                 {} @results)
-                    report (test-nss nss)]
+                    report (test-nss nss (#{true "true"} fail-fast))]
                 (reset! results (:results report))
                 (t/send transport (response-for msg (util/transform-value report))))))
           (fn []

test/clj/cider/nrepl/middleware/test_test.clj

@@ -203,6 +203,30 @@ The `988` value reflects that it times things correctly for a slow test.")
     (is (-> test-result :results :failing-test-ns :fast-failing-test (get 0) :elapsed-time :humanized string?)
         "Timing also works for the `retest` op (var level)")))
 
+(deftest fail-fast-test
+  (require 'failing-test-ns)
+  (let [test-result (session/message {:op "test-var-query"
+                                      :var-query {:ns-query {:exactly ["failing-test-ns"]}}
+                                      :fail-fast "true"})]
+    (is (= 1
+           (count (:failing-test-ns (:results test-result))))))
+
+  (let [test-result (session/message {:op "test-var-query"
+                                      :var-query {:ns-query {:exactly ["failing-test-ns"]}}
+                                      :fail-fast "false"})]
+    (is (= 2
+           (count (:failing-test-ns (:results test-result))))))
+
+  (let [test-result (session/message {:op "retest"
+                                      :fail-fast "false"})]
+    (is (= 2
+           (count (:failing-test-ns (:results test-result))))))
+
+  (let [test-result (session/message {:op "retest"
+                                      :fail-fast "true"})]
+    (is (= 1
+           (count (:failing-test-ns (:results test-result)))))))
+
 (deftest print-object-test
   (testing "uses println for matcher-combinators results, otherwise invokes pprint"
     (is (= "{no quotes}\n"