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