feat: pluggable test runner (#196)

Add pluggable test runner.

bases/poly-cli/deps.edn

@@ -1,4 +1,4 @@
 {:paths ["src"]
  :deps {}
- :aliases {:test {:extra-paths []
+ :aliases {:test {:extra-paths ["test"]
                   :extra-deps {}}}}

components/change/src/polylith/clj/core/change/bricks_to_test.clj

@@ -17,7 +17,7 @@
                                   (or (not is-dev)
                                       is-dev-user-input)))
         project-has-changed? (contains? (set changed-projects) name)
-        all-brick-names (set (concat (:test base-names) (:test component-names)))
+        all-brick-names (into #{} (mapcat :test) [base-names component-names])
         ;; If the :test key is given for a project in workspace.edn, then only include
         ;; the specified bricks, otherwise, run tests for all bricks that have tests.
         included-bricks (if-let [bricks (get-in settings [:projects name :test :include])]
@@ -33,10 +33,11 @@
                            included-bricks
                            (set/intersection included-bricks
                                              selected-bricks
-                                             (set (concat changed-components
-                                                          changed-bases
-                                                          (-> name project-to-indirect-changes :src)
-                                                          (-> name project-to-indirect-changes :test)))))
+                                             (into #{} cat
+                                                   [changed-components
+                                                    changed-bases
+                                                    (-> name project-to-indirect-changes :src)
+                                                    (-> name project-to-indirect-changes :test)])))
                          #{})
         ;; And finally, if brick:BRICK is given, also filter on that, which means that if we
         ;; pass in both brick:BRICK and :all, we will run the tests for all these bricks,
@@ -45,5 +46,6 @@
     [name (-> bricks-to-test sort vec)]))
 
 (defn project-to-bricks-to-test [changed-projects projects settings changed-components changed-bases project-to-indirect-changes selected-bricks selected-projects is-dev-user-input is-run-all-brick-tests]
-  (into (sorted-map) (map #(bricks-to-test-for-project % settings changed-projects changed-components changed-bases project-to-indirect-changes selected-bricks selected-projects is-dev-user-input is-run-all-brick-tests)
-                          projects)))
+  (into (sorted-map)
+        (map #(bricks-to-test-for-project % settings changed-projects changed-components changed-bases project-to-indirect-changes selected-bricks selected-projects is-dev-user-input is-run-all-brick-tests))
+        projects))

components/change/src/polylith/clj/core/change/projects_to_test.clj

@@ -22,14 +22,15 @@
 (defn projects-to-test [{:keys [is-dev alias name paths]} disk-paths affected-projects selected-projects is-dev-user-input is-run-project-tests is-all]
   (let [run-tests? (run-tests? alias name is-dev is-dev-user-input is-run-project-tests selected-projects)
         included-projects (included-projects paths disk-paths is-dev)]
-    (if run-tests?
-      (cond
-        is-all [name (vec (sort included-projects))]
-        is-run-project-tests [name (vec (sort (set/intersection (set affected-projects)
-                                                                (set included-projects))))]
-        :else [name []])
-      [name []])))
+    [name
+     (cond-> []
+       run-tests?
+       (into (cond
+               is-all (sort included-projects)
+               is-run-project-tests (sort (set/intersection (set affected-projects)
+                                                            (set included-projects))))))]))
 
 (defn project-to-projects-to-test [projects disk-paths affected-projects selected-projects is-dev-user-input is-run-project-tests is-all]
-  (into {} (map #(projects-to-test % disk-paths affected-projects selected-projects is-dev-user-input is-run-project-tests is-all)
-                projects)))
+  (into {}
+        (map #(projects-to-test % disk-paths affected-projects selected-projects is-dev-user-input is-run-project-tests is-all))
+        projects))

components/clojure-test-test-runner/src/polylith/clj/core/clojure_test_test_runner/core.clj

@@ -0,0 +1,99 @@
+(ns polylith.clj.core.clojure-test-test-runner.core
+  (:require [clojure.string :as str]
+            [polylith.clj.core.test-runner-contract.interface :as test-runner-contract]
+            [polylith.clj.core.util.interface.color :as color]
+            [polylith.clj.core.util.interface.str :as str-util]))
+
+(defn ->test-statement [ns-name]
+  (let [ns-symbol (symbol ns-name)]
+    `(do (use 'clojure.test)
+         (require '~ns-symbol)
+         (clojure.test/run-tests '~ns-symbol))))
+
+(defn brick-test-namespaces [bricks test-brick-names]
+  (let [brick-name->namespaces (into {} (map (juxt :name #(-> % :namespaces :test))) bricks)]
+    (into []
+          (comp (mapcat brick-name->namespaces)
+                (map :namespace))
+          test-brick-names)))
+
+(defn project-test-namespaces [project-name projects-to-test namespaces]
+  (when (contains? (set projects-to-test) project-name)
+    (mapv :namespace (:test namespaces))))
+
+(defn components-msg [component-names color-mode]
+  (when (seq component-names)
+    [(color/component (str/join ", " component-names) color-mode)]))
+
+(defn bases-msg [base-names color-mode]
+  (when (seq base-names)
+    [(color/base (str/join ", " base-names) color-mode)]))
+
+(defn run-message [project-name components bases bricks-to-test projects-to-test color-mode]
+  (let [component-names (into #{} (map :name) components)
+        base-names (into #{} (map :name) bases)
+        bases-to-test (filterv #(contains? base-names %) bricks-to-test)
+        bases-to-test-msg (bases-msg bases-to-test color-mode)
+        components-to-test (filterv #(contains? component-names %) bricks-to-test)
+        components-to-test-msg (components-msg components-to-test color-mode)
+        projects-to-test-msg (when (seq projects-to-test)
+                               [(color/project (str/join ", " projects-to-test) color-mode)])
+        entities-msg (str/join ", " (into [] cat [components-to-test-msg
+                                                  bases-to-test-msg
+                                                  projects-to-test-msg]))
+        project-cnt (count projects-to-test)
+        bricks-cnt (count bricks-to-test)
+        project-msg (if (zero? project-cnt)
+                      ""
+                      (str " and " (str-util/count-things "project" project-cnt)))]
+    (str "Running tests from the " (color/project project-name color-mode) " project, including "
+         (str-util/count-things "brick" bricks-cnt) project-msg ": " entities-msg)))
+
+(defn run-test-statements [project-name eval-in-project test-statements run-message is-verbose color-mode]
+  (println (str run-message))
+  (when is-verbose (println (str "# test-statements:\n" test-statements) "\n"))
+
+  (doseq [statement test-statements]
+    (let [{:keys [error fail pass]}
+          (try
+            (eval-in-project statement)
+            (catch Exception e
+              (.printStackTrace e)
+              (println (str (color/error color-mode "Couldn't run test statement") " for the " (color/project project-name color-mode) " project: " statement " " (color/error color-mode e)))))
+          result-str (str "Test results: " pass " passes, " fail " failures, " error " errors.")]
+      (when (or (nil? error)
+                (< 0 error)
+                (< 0 fail))
+        (throw (Exception. (str "\n" (color/error color-mode result-str)))))
+      (println (str "\n" (color/ok color-mode result-str))))))
+
+(defn create
+  [{:keys [workspace project changes #_test-settings]}]
+  (let [{:keys [bases components]} workspace
+        {:keys [name namespaces paths]} project
+        {:keys [project-to-bricks-to-test project-to-projects-to-test]} changes
+
+        ;; TODO: if the project tests aren't to be run, we might further narrow this down
+        test-sources-present* (delay (-> paths :test seq))
+        bricks-to-test* (delay (project-to-bricks-to-test name))
+        projects-to-test* (delay (project-to-projects-to-test name))
+        test-statements* (->> [(brick-test-namespaces (into components bases) @bricks-to-test*)
+                               (project-test-namespaces name @projects-to-test* namespaces)]
+                              (into [] (comp cat (map ->test-statement)))
+                              (delay))]
+
+    (reify test-runner-contract/TestRunner
+      (test-runner-name [_] "Polylith built-in clojure.test runner")
+
+      (test-sources-present? [_] @test-sources-present*)
+
+      (tests-present? [this {_eval-in-project :eval-in-project :as _opts}]
+        (and (test-runner-contract/test-sources-present? this)
+             (seq @test-statements*)))
+
+      (run-tests [this {:keys [color-mode eval-in-project is-verbose] :as opts}]
+        (when (test-runner-contract/tests-present? this opts)
+          (let [run-message (run-message name components bases @bricks-to-test*
+                                         @projects-to-test* color-mode)]
+            (run-test-statements
+             name eval-in-project @test-statements* run-message is-verbose color-mode)))))))

components/clojure-test-test-runner/src/polylith/clj/core/clojure_test_test_runner/interface.clj

@@ -0,0 +1,5 @@
+(ns polylith.clj.core.clojure-test-test-runner.interface
+  (:require [polylith.clj.core.clojure-test-test-runner.core :as core]))
+
+(defn create [opts]
+  (core/create opts))

components/clojure-test-test-runner/test/polylith/clj/core/clojure_test_test_runner/interface_test.clj

@@ -0,0 +1,13 @@
+(ns polylith.clj.core.clojure-test-test-runner.interface-test
+  (:require
+   [clojure.test :refer :all]
+   [polylith.clj.core.clojure-test-test-runner.interface :as sut]
+   [polylith.clj.core.test-runner-contract.interface.initializers :as test-runner-initializers]
+   [polylith.clj.core.test-runner-contract.interface.verifiers :as test-runner-verifiers]))
+
+(deftest clojure-test-test-runner-is-valid
+  (let [constructor (test-runner-initializers/->constructor-var `sut/create)]
+    (is (test-runner-verifiers/valid-constructor-var? constructor))
+    (let [test-runner (constructor {})]
+      (is (test-runner-verifiers/valid-test-runner? test-runner))
+      (is (test-runner-verifiers/ensure-valid-test-runner test-runner)))))

components/command/src/polylith/clj/core/command/test.clj

@@ -1,12 +1,12 @@
 (ns polylith.clj.core.command.test
-  (:require [polylith.clj.core.test-runner.interface :as test-runner]
-            [polylith.clj.core.common.interface :as common]))
+  (:require [polylith.clj.core.common.interface :as common]
+            [polylith.clj.core.test-runner-orchestrator.interface :as test-runner-orchestrator]))
 
 (defn run
   "Return true if the tests could be executed correctly."
   [workspace unnamed-args test-result is-verbose color-mode]
   (let [{:keys [ok? message]} (common/validate-args unnamed-args "test project:dev")]
     (if ok?
       (reset! test-result
-              (test-runner/run workspace is-verbose color-mode))
+              (test-runner-orchestrator/run workspace is-verbose color-mode))
       (println message))))

components/common/src/polylith/clj/core/common/core.clj

@@ -29,10 +29,11 @@
            (subs path 1))
       path)))
 
-(defn absolute-path [path entity-root-path]
+(defn absolute-path
   "entity-root-path will be passed in as e.g. 'components/invoicer' if a brick,
    or 'projects/invocing' if a project, and nil if the development project
    (dev lives at the root, so keep that path as it is)."
+  [path entity-root-path]
   (when path
     (if (or (nil? entity-root-path)
             (str/starts-with? path "/"))

components/help/src/polylith/clj/core/help/check.clj

@@ -49,6 +49,13 @@
        "    and define the paths for each component in separate profiles\n"
        "    (including test paths).\n"
        "\n"
+       "  " (color/error cm "Error 109") " - Invalid test runner configuration for some projects.\n"
+       "    The value of the optional :create-test-runner key under [:test] or\n"
+       "    [:projects \"some-project-name\" :test] in workspace.edn must be either\n"
+       "    nil, :default, or a fully qualified symbol referring to a function on\n"
+       "    the poly tool's classpath, which can take a single argument and must return\n"
+       "    an instance of polylith.clj.core.test-runner-contract.interface/TestRunner.\n"
+       "\n"
        "  " (color/warning cm "Warning 201") " - Mismatching parameter lists in function or macro.\n"
        "    Triggered if a function or macro is defined in the interface for a component\n"
        "    but also defined in the same interface for another component but with a\n"

components/help/src/polylith/clj/core/help/test.clj

@@ -59,7 +59,41 @@
        "    poly test :dev\n"
        "    poly test :project :dev\n"
        "    poly test :all-bricks :dev\n"
-       "    poly test :all :dev"))
+       "    poly test :all :dev\n"
+       "\n"
+       ;; TODO: update once issue #206 is addressed
+       "  The poly tool's default test runner will discover clojure.test tests from the \"/test\"\n"
+       "  directories of bricks and projects, and execute them using clojure.test/run-tests.\n"
+       "\n"
+       "  Alternative test runners can also be used by referring to their constructors\n"
+       "  in workspace.edn:\n"
+       "\n"
+       "  {;; To use it as the default test runner for the workspace\n"
+       "   :test {:create-test-runner my.test-runner/create}\n"
+       "\n"
+       "   :projects\n"
+       "   {\n"
+       "    ;; To only use it for specific projects\n"
+       "    \"foo\" {:test {:create-test-runner my.test-runner/create}}\n"
+       "\n"
+       "    ;; To revert to poly's built-in default test runner only for specific projects\n"
+       "    \"bar\" {:test {:create-test-runner :default}}\n"
+       "\n"
+       "    ;; To use multiple test runners invoked the specified order\n"
+       "    \"baz\" {:test {:create-test-runner [my.linter/create :default my.extra/create]}}\n"
+       "    }\n"
+       "   }\n"
+       "\n"
+       "  This requires that my.test-runner/create is available on the classpath of the\n"
+       "  poly tool, which is easiest to achieve by running poly as a dependency.\n"
+       "\n"
+       "  The docstring of polylith.clj.core.test-runner-contract.interface/TestRunner\n"
+       "  contains details on how to implement a custom test runner and a constructor.\n"
+       "\n"
+       "  The poly tool's default test runner is also implemented this way and can be referred to\n"
+       "  as an example; see polylith.clj.core.clojure-test-test-runner.interface/create.\n"
+       "\n"
+       "  Refer to the Polylith documentation for more information about custom test runners."))
 
 (defn print-help [color-mode]
   (println (help-text color-mode)))

components/path-finder/src/polylith/clj/core/path_finder/interface/criterias.clj

@@ -57,7 +57,7 @@
 (defn filter-entries [path-entries criterias]
   (if (empty? criterias)
     (vec path-entries)
-    (vec (filter #(match? % criterias) path-entries))))
+    (filterv #(match? % criterias) path-entries)))
 
 (defn has-entry? [path-entries criterias]
-  (-> (filter-entries path-entries criterias) empty? not))
+  (seq (filter-entries path-entries criterias)))

components/path-finder/src/polylith/clj/core/path_finder/path_extractor.clj

@@ -53,16 +53,19 @@
 
 (defn single-path-entries [missing-paths paths profile? test?]
   (when paths
-    (filterv :name
-             (map #(path-entry missing-paths % profile? test?)
-                  paths))))
+    (into []
+          (comp
+           (map #(path-entry missing-paths % profile? test?))
+           (filter :name))
+          paths)))
 
 (defn path-entries [src-paths test-paths profile-src-paths profile-test-paths disk-paths]
   (let [missing-paths (some-> disk-paths :missing set)]
-    (vec (concat (single-path-entries missing-paths src-paths false false)
-                 (single-path-entries missing-paths test-paths false true)
-                 (single-path-entries missing-paths profile-src-paths true false)
-                 (single-path-entries missing-paths profile-test-paths true true)))))
+    (into [] cat
+          [(single-path-entries missing-paths src-paths false false)
+           (single-path-entries missing-paths test-paths false true)
+           (single-path-entries missing-paths profile-src-paths true false)
+           (single-path-entries missing-paths profile-test-paths true true)])))
 
 (defn from-paths [paths disk-paths]
   (path-entries (:src paths) (:test paths) nil nil disk-paths))

components/path-finder/src/polylith/clj/core/path_finder/paths.clj

@@ -6,13 +6,16 @@
 (defn project-paths [{:keys [paths profile-src-paths profile-test-paths]}]
   (concat (:src paths) (:test paths) profile-src-paths profile-test-paths))
 
+(def extract-project-paths-xf (mapcat project-paths))
+(def extract-profile-paths-xf (mapcat #(-> % second :paths)))
+
 (defn paths [ws-dir projects profile-to-settings]
-  (let [project-paths (mapcat project-paths projects)
-        profile-paths (mapcat #(-> % second :paths) profile-to-settings)
-        paths (set (concat project-paths profile-paths))
-        existing-paths (vec (sort (set (filter #(file/exists (str ws-dir "/" %)) paths))))
+  (let [paths (-> #{}
+                  (into extract-project-paths-xf projects)
+                  (into extract-profile-paths-xf profile-to-settings))
+        existing-paths (into (sorted-set) (filter #(file/exists (str ws-dir "/" %))) paths)
         missing-paths (vec (sort (set/difference paths existing-paths)))
         on-disk (sources/source-paths ws-dir)]
-    {:existing existing-paths
+    {:existing (vec existing-paths)
      :missing missing-paths
      :on-disk on-disk}))

components/path-finder/src/polylith/clj/core/path_finder/selector.clj

@@ -5,13 +5,13 @@
   (criterias/filter-entries path-entries criterias))
 
 (defn exists? [path-entries criterias]
-  (-> (criterias/filter-entries path-entries criterias) empty? not))
+  (criterias/has-entry? path-entries criterias))
 
 (defn lib-deps [dep-entries criterias]
-  (into {} (map :lib-dep (criterias/filter-entries dep-entries criterias))))
+  (into {} (map :lib-dep) (criterias/filter-entries dep-entries criterias)))
 
 (defn paths [path-entries criterias]
-  (vec (sort (set (map :path (criterias/filter-entries path-entries criterias))))))
+  (vec (into (sorted-set) (map :path) (criterias/filter-entries path-entries criterias))))
 
 (defn names [path-entries criterias]
-  (vec (sort (set (map :name (criterias/filter-entries path-entries criterias))))))
+  (vec (into (sorted-set) (map :name) (criterias/filter-entries path-entries criterias))))

components/test-helper/src/polylith/clj/core/test_helper/core.clj

@@ -1,10 +1,9 @@
 (ns polylith.clj.core.test-helper.core
-  (:require [clojure.pprint :as pp]
-            [clojure.string :as str]
-            [polylith.clj.core.file.interface :as file]
+  (:require [clojure.string :as str]
             [polylith.clj.core.command.interface :as command]
-            [polylith.clj.core.user-input.interface :as user-input]
-            [polylith.clj.core.user-config.interface :as user-config]))
+            [polylith.clj.core.file.interface :as file]
+            [polylith.clj.core.user-config.interface :as user-config]
+            [polylith.clj.core.user-input.interface :as user-input]))
 
 (def user-home "USER-HOME")
 

components/test-runner-contract/deps.edn

@@ -0,0 +1,4 @@
+{:paths ["src"]
+ :deps {}
+ :aliases {:test {:extra-paths ["test"]
+                  :extra-deps {}}}}

components/test-runner-contract/src/polylith/clj/core/test_runner_contract/initializers.clj

@@ -0,0 +1,10 @@
+(ns polylith.clj.core.test-runner-contract.initializers)
+
+(defn ensure-var [candidate sym]
+  (when-not (var? candidate)
+    (throw
+     (ex-info (str "Unable to resolve symbol " sym " to a var.") {:symbol sym}))))
+
+(defn ->constructor-var [create-test-runner-sym]
+  (doto (requiring-resolve create-test-runner-sym)
+    (ensure-var create-test-runner-sym)))