Add :parallel-threads option to set thread pool size

CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## Added
 
+- You can now parallelize tests by enabling the `:parallel` key or
+    the `--parallel` flag. This is still a beta feature, but works on a variety
+    of code bases.
+
 ## Fixed
 
 ## Changed
@@ -888,4 +892,4 @@ namespace.
 - The configuration format has changed, you should now start with the `#kaocha
   {}` tagged reader literal in `tests.edn` to provide defaults. If you want more
   control then overwrite `tests.edn` with the output of `--print-config` and
-  tweak.
+  tweak.

deps.edn

@@ -5,6 +5,7 @@
   org.clojure/spec.alpha       {:mvn/version "0.3.218"}
   org.clojure/tools.cli        {:mvn/version "1.0.206"}
   lambdaisland/tools.namespace {:mvn/version "0.1.247"}
+  com.climate/claypoole        {:mvn/version "1.1.4"}
   lambdaisland/deep-diff       {:mvn/version "0.0-47"}
   org.tcrawley/dynapath        {:mvn/version "1.1.0"}
   slingshot/slingshot          {:mvn/version "0.12.2"}

doc/04_running_kaocha_cli.md

@@ -95,6 +95,32 @@ unhelpful output in a particular scenario, you can turn it off using the
 
 ![Terminal screenshot showing an expected value of "{:expected-key 1}" and an actual value. ":unexpected-key 1" is in green because it is an extra key not expected and "expected-key 1" is in red because it was expected but not present.](./deep-diff.png)
 
+## Parallelization
+
+Kaocha allows you to run tests in parallel using the `:parallel` key or
+`--parallel` flag. This is primarily useful for I/O heavy tests, but could also
+be useful for CPU-bound tests.
+
+Before enabling parallelization, strongly consider timing it to ensure it
+actually makes a difference. Consider using a tool like
+`bench` or `hyperfine`. While Kaocha's built-in profiling tools are great for
+identifying specific tests that take a disproportionate amount of time, they don't repeatedly measure your entire test suite
+to account for variation and noise. If you want to use parallelization to
+speed up continuous integration, try to use the CI service itself or similar hardware. CI runners are often lower powered than even a middle-of-the-road laptop.
+
+`test.check` tests consist of repeatedly testing a property against random data.
+In principle, these tests would be an excellent use case for parallelization.
+However, because this repeated testing happens within `test.check`, Kaocha sees each `defspec` as a
+single test. If you have many property-based tests that take a significant amount of
+time, parallelization is a great fit. However, if you have one or two
+property-based tests that take up the bulk of the runtme time, parallelization may not
+make a significant difference because the work cannot be split up.
+
+If you want to disable parallelization that's enabled in your configuration, you can
+pass `--no-parallel`. If you find yourself frequently reaching for this flag,
+it's probably worth reconsidering your configuration—having to frequently
+disable parallelization might be negating any time saved by parallelization.
+
 ## Debug information
 
 `--version` prints version information, whereas `--test-help` will print the

repl_sessions/benchmark.clj

@@ -0,0 +1,97 @@
+
+(ns benchmark
+  (:require [criterium.core :as c])
+  (:import [java.util.concurrent Executors ])
+  )
+
+(def thread-pool (Executors/newFixedThreadPool 10))
+
+(defn math-direct []
+  (+ 1 1))
+
+(defn math-future []
+  (deref 
+    (future (+ 1 1))))
+
+(defn math-thread []
+  (let [result (atom nil)]
+    (doto (Thread. (fn [] (reset! result (+ 1 1))))
+      (.start)
+      (.join))
+    @result))
+
+(defn math-threadpool []
+  (let [result (atom nil)]
+    (.get (.submit thread-pool (fn [] (reset! result (+ 1 1))) ))
+    @result))
+
+(defn math-threadpool-no-atom []
+  (.get (.submit thread-pool (fn [] (+ 1 1)) )))
+
+
+(c/bench (math-direct) )
+; (out) Evaluation count : 6215391600 in 60 samples of 103589860 calls.
+; (out)              Execution time mean : 2,015262 ns
+; (out)     Execution time std-deviation : 0,497743 ns
+; (out)    Execution time lower quantile : 1,442374 ns ( 2,5%)
+; (out)    Execution time upper quantile : 3,392990 ns (97,5%)
+; (out)                    Overhead used : 7,915626 ns
+; (out) 
+; (out) Found 5 outliers in 60 samples (8,3333 %)
+; (out) 	low-severe	 3 (5,0000 %)
+; (out) 	low-mild	 2 (3,3333 %)
+; (out)  Variance from outliers : 94,6147 % Variance is severely inflated by outliers
+
+(c/bench (math-future) )
+; (out) Evaluation count : 3735420 in 60 samples of 62257 calls.
+; (out)              Execution time mean : 16,635809 µs
+; (out)     Execution time std-deviation : 1,104338 µs
+; (out)    Execution time lower quantile : 15,397518 µs ( 2,5%)
+; (out)    Execution time upper quantile : 19,751883 µs (97,5%)
+; (out)                    Overhead used : 7,915626 ns
+; (out) 
+; (out) Found 6 outliers in 60 samples (10,0000 %)
+; (out) 	low-severe	 3 (5,0000 %)
+; (out) 	low-mild	 3 (5,0000 %)
+; (out)  Variance from outliers : 50,0892 % Variance is severely inflated by outliers
+
+(c/bench (math-thread))
+
+; (out) Evaluation count : 774420 in 60 samples of 12907 calls.
+; (out)              Execution time mean : 82,513236 µs
+; (out)     Execution time std-deviation : 5,706987 µs
+; (out)    Execution time lower quantile : 75,772237 µs ( 2,5%)
+; (out)    Execution time upper quantile : 91,971212 µs (97,5%)
+; (out)                    Overhead used : 7,915626 ns
+; (out) 
+; (out) Found 1 outliers in 60 samples (1,6667 %)
+; (out) 	low-severe	 1 (1,6667 %)
+; (out)  Variance from outliers : 51,7849 % Variance is severely inflated by outliers
+
+(c/bench (math-threadpool))
+; (out) Evaluation count : 3815100 in 60 samples of 63585 calls.
+; (out)              Execution time mean : 16,910124 µs
+; (out)     Execution time std-deviation : 2,443261 µs
+; (out)    Execution time lower quantile : 14,670118 µs ( 2,5%)
+; (out)    Execution time upper quantile : 23,743868 µs (97,5%)
+; (out)                    Overhead used : 7,915626 ns
+; (out) 
+; (out) Found 3 outliers in 60 samples (5,0000 %)
+; (out) 	low-severe	 2 (3,3333 %)
+; (out) 	low-mild	 1 (1,6667 %)
+; (out)  Variance from outliers : 82,4670 % Variance is severely inflated by outliers
+
+
+(c/bench (math-threadpool-no-atom))
+
+; (out) Evaluation count : 3794940 in 60 samples of 63249 calls.
+; (out)              Execution time mean : 16,182655 µs
+; (out)     Execution time std-deviation : 1,215451 µs
+; (out)    Execution time lower quantile : 14,729393 µs ( 2,5%)
+; (out)    Execution time upper quantile : 18,549902 µs (97,5%)
+; (out)                    Overhead used : 7,915626 ns
+; (out) 
+; (out) Found 3 outliers in 60 samples (5,0000 %)
+; (out) 	low-severe	 2 (3,3333 %)
+; (out) 	low-mild	 1 (1,6667 %)
+; (out)  Variance from outliers : 56,7625 % Variance is severely inflated by outliers

src/kaocha/api.clj

@@ -110,8 +110,13 @@
                                          (count (testable/test-seq-with-skipped test-plan))))
                     (output/warn (str "No tests were found. This may be an issue in your Kaocha test configuration."
                                       " To investigate, check the :test-paths and :ns-patterns keys in tests.edn.")))
-                  (throw+ {:kaocha/early-exit 0 }))
+                  (throw+ {:kaocha/early-exit 0}))
 
+                (when (:parallel config)
+                  (output/warn (str "Parallelization enabled. This feature is in "
+                                    "beta If you encounter errors, try "
+                                    "running with the feature disabled and "
+                                    "consider filing an issue.")))
                 (when (find-ns 'matcher-combinators.core)
                   (require 'kaocha.matcher-combinators))
 

src/kaocha/config.clj

@@ -27,8 +27,8 @@
               (symbol? v))
         (update config k vary-meta assoc :replace true)
         (do
-         (output/error "Test suite configuration value with key " k " should be a collection or symbol, but got '" v "' of type " (type v))
-         (throw+ {:kaocha/early-exit 252}))))
+          (output/error "Test suite configuration value with key " k " should be a collection or symbol, but got '" v "' of type " (type v))
+          (throw+ {:kaocha/early-exit 252}))))
     config))
 
 (defn merge-config [c1 c2]
@@ -198,6 +198,7 @@
     (some? (:color options))      (assoc :kaocha/color? (:color options))
     (some? (:diff-style options)) (assoc :kaocha/diff-style (:diff-style options))
     (:plugin options)             (update :kaocha/plugins #(distinct (concat % (:plugin options))))
+    (some? (:parallel options))   (assoc :parallel (:parallel options))
     true                          (assoc :kaocha/cli-options options)))
 
 (defn apply-cli-args [config args]

src/kaocha/runner.clj

@@ -8,6 +8,7 @@
             [clojure.spec.alpha :as spec]
             [clojure.string :as str]
             [clojure.tools.cli :as cli]
+            [clojure.pprint :as pp]
             [expound.alpha :as expound]
             [kaocha.api :as api]
             [kaocha.config :as config]
@@ -34,6 +35,7 @@
    [nil  "--[no-]fail-fast"     "Stop testing after the first failure."]
    [nil  "--[no-]color"         "Enable/disable ANSI color codes in output. Defaults to true."]
    [nil  "--[no-]watch"         "Watch filesystem for changes and re-run tests."]
+   [nil  "--[no-]parallel"           "Run tests in parallel. Warning: This feature is beta."]
    [nil  "--reporter SYMBOL"    "Change the test reporter, can be specified multiple times."
     :parse-fn (fn [s]
                 (let [sym (symbol s)]
@@ -42,8 +44,7 @@
                     (symbol "kaocha.report" s))))
     :assoc-fn accumulate]
    [nil "--diff-style STYLE"    "The style of diff to print on failing tests, either :none or :deep"
-    :parse-fn parse-kw
-    ]
+    :parse-fn parse-kw]
    [nil "--plugin KEYWORD"      "Load the given plugin."
     :parse-fn (fn [s]
                 (let [kw (parse-kw s)]
@@ -186,6 +187,7 @@
   (try+
    (System/exit (apply -main* args))
    (catch :kaocha/early-exit {exit-code :kaocha/early-exit}
+     (shutdown-agents)
      (System/exit exit-code))))
 
 (defn exec-fn

src/kaocha/test_suite.clj

@@ -4,10 +4,10 @@
 
 (defn run [testable test-plan]
   (t/do-report {:type :begin-test-suite})
-  (let [results (testable/run-testables (:kaocha.test-plan/tests testable) test-plan)
+  (let [results (testable/run-testables (:kaocha.test-plan/tests testable) test-plan) 
         testable (-> testable
                      (dissoc :kaocha.test-plan/tests)
                      (assoc :kaocha.result/tests results))]
     (t/do-report {:type :end-test-suite
                   :kaocha/testable testable})
-    testable))
+   testable))

src/kaocha/testable.clj

@@ -1,18 +1,17 @@
 (ns kaocha.testable
   (:refer-clojure :exclude [load])
   (:require [clojure.java.io :as io]
-            [clojure.pprint :as pprint]
             [clojure.spec.alpha :as s]
             [clojure.test :as t]
+            [com.climate.claypoole :as cp]
             [kaocha.classpath :as classpath]
             [kaocha.hierarchy :as hierarchy]
             [kaocha.history :as history]
             [kaocha.output :as output]
             [kaocha.plugin :as plugin]
             [kaocha.result :as result]
             [kaocha.specs :refer [assert-spec]]
-            [kaocha.util :as util])
-  (:import [clojure.lang Compiler$CompilerException]))
+            [kaocha.util :as util]))
 
 (def ^:dynamic *fail-fast?*
   "Should testing terminate immediately upon failure or error?"
@@ -28,13 +27,16 @@
   and `:line`."
   nil)
 
+(def REQUIRE_LOCK (Object.))
+
 (defn add-desc [testable description]
   (assoc testable ::desc
          (str (name (::id testable)) " (" description ")")))
 
 (defn- try-require [n]
   (try
-    (require n)
+    (locking REQUIRE_LOCK
+      (require n))
     true
     (catch java.io.FileNotFoundException e
       false)))
@@ -45,6 +47,12 @@
       (try-require (symbol (namespace type))))
     (try-require (symbol (name type)))))
 
+(defn- retry-assert-spec [type testable n]
+  (let [result (try (assert-spec type testable) (catch Exception _e false))]
+    (if (or result (<= n 1)) result
+        (retry-assert-spec type testable (dec n))) ;otherwise, retry
+))
+
 (defn- load-type+validate
   "Try to load a testable type, and validate it both to be a valid generic testable, and a valid instance given the type.
 
@@ -57,7 +65,10 @@
   (assert-spec :kaocha/testable testable)
   (let [type (::type testable)]
     (try-load-third-party-lib type)
-    (assert-spec type testable)))
+    (try
+      (assert-spec type testable)
+      (catch Exception e
+        (output/warn  (format "Could not load %s. This is a known bug in parallelization.\n%s" type e))))))
 
 (defmulti -load
   "Given a testable, load the specified tests, producing a test-plan."
@@ -100,8 +111,8 @@
         (throw t)))))
 
 (s/fdef load
-  :args (s/cat :testable :kaocha/testable)
-  :ret :kaocha.test-plan/testable)
+        :args (s/cat :testable :kaocha/testable)
+        :ret :kaocha.test-plan/testable)
 
 (defmulti -run
   "Given a test-plan, perform the tests, returning the test results."
@@ -163,6 +174,7 @@
             [file line] (util/compiler-exception-file-and-line error)
             file (::load-error-file test file)
             line (::load-error-line test line)
+            thread (.getName (Thread/currentThread))
             m (if-let [message (::load-error-message test)]
                 {:type :error
                  :message message
@@ -174,7 +186,8 @@
                  :kaocha/testable test})
             m (cond-> m
                 file (assoc :file file)
-                line (assoc :line line))]
+                line (assoc :line line)
+                thread (assoc :thread thread))]
         (t/do-report (assoc m :type :kaocha/begin-suite))
         (binding [*fail-fast?* false]
           (t/do-report m))
@@ -211,11 +224,22 @@
         (run % test-plan)
         (plugin/run-hook :kaocha.hooks/post-test % test-plan)))))
 
-(defn run-testables
+(defn try-run-testable [test test-plan n]
+  (let [result (try (run-testable test test-plan) (catch Exception _e false))]
+    (if (or result (> n 1)) result ;success or last try, return
+        (try-run-testable test test-plan (dec n))) ;otherwise retry
+))
+
+
+(defn run-testables-serial
   "Run a collection of testables, returning a result collection."
   [testables test-plan]
+  (doall testables)
+  #_(print "run-testables got a collection of size" (count testables)
+           " the first of which is "
+           (:kaocha.testable/type (first testables)))
   (let [load-error? (some ::load-error testables)]
-    (loop [result []
+    (loop [result  []
            [test & testables] testables]
       (if test
         (let [test (cond-> test
@@ -227,6 +251,33 @@
             (recur (conj result r) testables)))
         result))))
 
+(defn run-testables-parallel
+  "Run a collection of testables, returning a result collection."
+  [testables test-plan]
+  (let [num-threads (or (:parallel-threads *config*) (* 2 (inc (cp/ncpus))))
+        pred #(= :kaocha.type/ns (:kaocha.testable/type %))
+        nses (seq (filter pred testables))
+        others (seq (remove pred testables))]
+    (concat
+     (when others (run-testables-serial others test-plan))
+     (when nses
+       (cp/with-shutdown! [pool (cp/threadpool num-threads :name "kaocha-test-runner")]
+         (doall
+          (cp/pmap
+            pool
+            #(binding [*config*
+                       (-> *config*
+                           (dissoc :parallel)
+                           (update :levels (fnil inc 0)))]
+               (run-testable % test-plan))
+            nses)))))))
+
+(defn run-testables 
+  [testables test-plan]
+  (if (:parallel *config*)
+    (run-testables-parallel testables test-plan)
+    (run-testables-serial testables test-plan)))
+
 (defn test-seq [testable]
   (cond->> (mapcat test-seq (remove ::skip (or (:kaocha/tests testable)
                                                (:kaocha.test-plan/tests testable)