Konrad Mrożek
2023-12-12 12798cfe937a915b23f0be0c95545f5ebad6b7d1
commit | author | age
12798c 1 (ns test-runner
KM 2   (:require
3    [clojure.string :as string]
4    [clojure.test :as t]))
919581 5
b9eb2d 6 (def class-cache-dir ".cache/classes")
KM 7 (.mkdirs (java.io.File. class-cache-dir))
919581 8
b9eb2d 9 (defmacro with-class-cache [& body]
KM 10   `(binding [*compile-path*  class-cache-dir
11              *compile-files* true]
12      ~@body))
13
14 (with-class-cache
8b8f76 15   (require '[clojure.test :as t]
KM 16            '[lambdaisland.deep-diff2 :as ddiff]))
919581 17
8b8f76 18 (def no-colors-printer (ddiff/printer {:print-color false}))
55439f 19 (defmulti vim-report :type)
919581 20
55439f 21 (defmethod vim-report :begin-test-ns [m]
KM 22   (println "\nTesting" (ns-name (:ns m))))
23
2f0051 24 (defmethod vim-report :begin-test-var [m]
KM 25   (println "\nExecuting" (:name (meta (:var m)))))
26
55439f 27 (defmethod vim-report :fail
919581 28   [m]
2f8117 29   (t/inc-report-counter :fail)
KM 30   (when-let [source-file (some-> t/*testing-vars*
31                                  first
32                                  meta
33                                  :file)]
34     (println (str "FAIL:" source-file ":" (:line m) ":" (t/testing-vars-str m) ":" (t/testing-contexts-str) ":" (:message m "FAIL")))
35     (println (str "FAIL-CONTINUE:EXPECTED:" (pr-str (:expected m))))
36     (println (str "FAIL-CONTINUE:ACTUAL:" (pr-str (:actual m))))))
04e874 37
8b8f76 38 (defmethod t/assert-expr '= [msg form]
KM 39   (let [args (rest form)
40         pred (first form)]
41     `(let [values# (list ~@args)
42            result# (apply ~pred values#)]
43        (if result#
44          (t/do-report {:type :pass, :message ~msg,
45                        :expected '~form, :actual (cons '~pred values#)})
46          (do
47            (t/do-report {:type :fail, :message ~msg,
48                          :expected '~form, :actual (list '~'not (cons '~pred values#))})
49            (-> (apply ddiff/diff values#)
50                (ddiff/pretty-print no-colors-printer))))
51        result#)))
52
22b826 53 (defn- find-line-number [source-file m]
KM 54   (if (instance? Throwable (:actual m))
55     (let [fname (-> source-file (java.io.File.) (.getName))]
56       (->> m
57            :actual
58            Throwable->map
59            :trace
60            (some (fn [[_ _ e-file e-line]]
61                    (when (= e-file fname)
62                      e-line)))))
63     (:line m)))
64
55439f 65 (defmethod vim-report :error
04e874 66   [m]
2f8117 67   (t/inc-report-counter :error)
04e874 68   (when-let [source-file (some-> t/*testing-vars*
KM 69                                  first
70                                  meta
71                                  :file)]
22b826 72     (let [line (find-line-number source-file m)]
KM 73       (println (str "ERROR:" source-file ":" line ":" (t/testing-vars-str m) ":" (t/testing-contexts-str) ":" (:message m "FAIL")))
74       (println (str "ERROR-CONTINUE:EXPECTED:" (pr-str (:expected m))))
75       (println (str "ERROR-CONTINUE:ACTUAL:"
76                     (if (instance? Throwable (:actual m))
77                       (ex-message (:actual m))
745363 78                       (pr-str (:actual m)))))
KM 79       (when (instance? Throwable (:actual m))
80         (.printStackTrace (:actual m))))))
04e874 81
55439f 82 (defmethod vim-report :default
04e874 83   [_])
919581 84
9ae31a 85 (defn- clj-file? [f]
KM 86   (re-matches #"^.*\.cljs?$" (.getName f)))
87
3dde4c 88 (defn find-closest-test [test-file test-line]
KM 89   (->> (all-ns)
90        (mapcat ns-publics)
91        (map second)
92        (filter (comp :test meta))
93        (filter (comp #{test-file} :file meta))
94        (map #(vector % (- test-line (-> % meta :line))))
95        (filterv (comp pos? second))
96        (sort-by second)
97        first
98        first))
99
100 (defn -main [& {:strs [-test-file -test-line] :or {-test-file "test"}}]
b9eb2d 101   (with-class-cache
919581 102     (compile 'test-runner)
9ae31a 103     (println "Detecting test files in" -test-file)
KM 104     (let [test-files (->> -test-file
f5c518 105                           (java.io.File.)
KM 106                           (file-seq)
107                           (filter (memfn isFile))
9ae31a 108                           (filter clj-file?)
f5c518 109                           (map (memfn getAbsolutePath))
KM 110                           (set))]
111       (println "Loading test files...")
112       (run! load-file test-files)
55439f 113       (when (find-ns 'malli.core)
KM 114         (println "Malli detected. Instrument functions...")
115         (require 'malli.dev)
88cddc 116         (require 'malli.dev.pretty)
KM 117         ((find-var 'malli.dev/start!) {:report ((find-var 'malli.dev.pretty/thrower))}))
f5c518 118       (let [test-namespaces (->> (all-ns)
KM 119                                  (mapcat ns-publics)
120                                  (map (comp meta second))
121                                  (filter :test)
122                                  (filter (comp test-files :file))
123                                  (map :ns)
124                                  (set))]
12798c 125
KM 126         (set-validator! #'t/*testing-contexts*
127                         (let [validator (get-validator #'t/*testing-contexts*)]
128                           (fn [v]
129                             (println "Testing:" (string/join " " v))
130                             (println)
131                             (if validator
132                               (validator v)
133                               true))))
134
3dde4c 135         (with-redefs [t/report vim-report]
KM 136           (System/exit
137            (if (pos? (if (and -test-file -test-line)
2f8117 138
d93754 139                        (if-let [test-var (find-closest-test (.. (java.io.File. -test-file) getAbsolutePath)
KM 140                                                             (parse-long -test-line))]
141                          (->> (t/run-test-var test-var)
142                               ((juxt :fail :error))
143                               (apply +))
144                          (do
145                            (println "No test found")
146                            0))
3dde4c 147                        (reduce (fn [total-fails n]
KM 148                                  (let [results (t/run-tests n)]
149                                    (+ total-fails
150                                       (:fail results 0)
151                                       (:error results 0))))
152                                0
153                                test-namespaces)))
154              1
155              0)))))))