From 55439f8b3d9636ab73c32f40d7aa0827481159ed Mon Sep 17 00:00:00 2001
From: Konrad Mrożek <konrad.mrozek@shareablee.com>
Date: Fri, 14 Jul 2023 08:35:34 +0000
Subject: [PATCH] Add malli instrumentation support

---
 clojure/src/test_runner.clj |   89 ++++++++++++++++++++++++++++++++++++++------
 1 files changed, 76 insertions(+), 13 deletions(-)

diff --git a/clojure/src/test_runner.clj b/clojure/src/test_runner.clj
index 2868c26..c15ce04 100644
--- a/clojure/src/test_runner.clj
+++ b/clojure/src/test_runner.clj
@@ -7,22 +7,85 @@
 (when-not (.exists (java.io.File. "classes"))
   (.. (java.io.File. "classes") mkdir))
 
-(defmulti emacs-report :type)
+(defmulti vim-report :type)
 
-(defmethod emacs-report :pass
+(defmethod vim-report :begin-test-ns [m]
+  (println "\nTesting" (ns-name (:ns m))))
+
+(defmethod vim-report :fail
   [m]
   (t/with-test-out
-    (println "PASS:")))
+    (when-let [source-file (some-> t/*testing-vars*
+                                   first
+                                   meta
+                                   :file)]
+      (println (str "FAIL:" source-file ":" (:line m) ":" (t/testing-vars-str m) ":" (t/testing-contexts-str) ":" (:message m "FAIL")))
+      (println (str "FAIL-CONTINUE:EXPECTED:" (pr-str (:expected m))))
+      (println (str "FAIL-CONTINUE:ACTUAL:" (pr-str (:actual m)))))))
 
-(defn -main  [& [test-file]]
+(defn- find-line-number [source-file m]
+  (if (instance? Throwable (:actual m))
+    (let [fname (-> source-file (java.io.File.) (.getName))]
+      (->> m
+           :actual
+           Throwable->map
+           :trace
+           (some (fn [[_ _ e-file e-line]]
+                   (when (= e-file fname)
+                     e-line)))))
+    (:line m)))
+
+(defmethod vim-report :error
+  [m]
+  (when-let [source-file (some-> t/*testing-vars*
+                                 first
+                                 meta
+                                 :file)]
+    (let [line (find-line-number source-file m)]
+      (println (str "ERROR:" source-file ":" line ":" (t/testing-vars-str m) ":" (t/testing-contexts-str) ":" (:message m "FAIL")))
+      (println (str "ERROR-CONTINUE:EXPECTED:" (pr-str (:expected m))))
+      (println (str "ERROR-CONTINUE:ACTUAL:"
+                    (if (instance? Throwable (:actual m))
+                      (ex-message (:actual m))
+                      (pr-str (:actual m))))))))
+
+(defmethod vim-report :default
+  [_])
+
+(defn- clj-file? [f]
+  (re-matches #"^.*\.cljs?$" (.getName f)))
+
+(defn -main  [& {:strs [-test-file] :or {-test-file "test"}}]
   (binding  [*compile-files* true]
     (compile 'test-runner)
-    (let  [test-namespaces (->> (or test-file  "test")
-                                (java.io.File.)
-                                (file-seq)
-                                (filter (memfn isFile))
-                                (map (memfn getPath))
-                                (map load-file)
-                                (map (comp :ns meta))
-                                (into #{}))]
-      (run! (fn [n] (t/run-tests n)) test-namespaces))))
+    (println "Detecting test files in" -test-file)
+    (let [test-files (->> -test-file
+                          (java.io.File.)
+                          (file-seq)
+                          (filter (memfn isFile))
+                          (filter clj-file?)
+                          (map (memfn getAbsolutePath))
+                          (set))]
+      (println "Loading test files...")
+      (run! load-file test-files)
+      (when (find-ns 'malli.core)
+        (println "Malli detected. Instrument functions...")
+        (require 'malli.dev)
+        ((find-var 'malli.dev/start!)))
+      (let [test-namespaces (->> (all-ns)
+                                 (mapcat ns-publics)
+                                 (map (comp meta second))
+                                 (filter :test)
+                                 (filter (comp test-files :file))
+                                 (map :ns)
+                                 (set))]
+        (System/exit (if (pos? (reduce (fn [total-fails n]
+                                         (with-redefs [t/report vim-report]
+                                           (let [results (t/run-tests n)]
+                                             (+ total-fails
+                                                (:fail results 0)
+                                                (:error results 0)))))
+                                       0
+                                       test-namespaces))
+                       1
+                       0))))))

--
Gitblit v1.9.3