From 22b826b7d0f82a3cfe99b43cd4819ad920fd8e41 Mon Sep 17 00:00:00 2001
From: Konrad Mrożek <konrad.mrozek@shareablee.com>
Date: Thu, 13 Jul 2023 13:13:05 +0000
Subject: [PATCH] Fix invalid line numbers in case of tail fail

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

diff --git a/clojure/src/test_runner.clj b/clojure/src/test_runner.clj
index d7c5118..82ba123 100644
--- a/clojure/src/test_runner.clj
+++ b/clojure/src/test_runner.clj
@@ -20,40 +20,66 @@
       (println (str "FAIL-CONTINUE:EXPECTED:" (pr-str (:expected m))))
       (println (str "FAIL-CONTINUE:ACTUAL:" (pr-str (:actual m)))))))
 
+(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 emacs-report :error
   [m]
   (when-let [source-file (some-> t/*testing-vars*
                                  first
                                  meta
                                  :file)]
-    (println (str "ERROR:" source-file ":" (:line m) ":" (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)))))))
+    (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 emacs-report :default
   [_])
 
-(defn -main  [& [test-file]]
+(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 #{}))]
-      (System/exit (if (pos? (reduce (fn [total-fails n]
-                                       (with-redefs [t/report emacs-report]
-                                         (let [results  (t/run-tests n)]
-                                           (+ total-fails
-                                              (:fail results 0)
-                                              (:error results 0)))))
-                                     0
-                                     test-namespaces))
-                     1
-                     0)))))
+    (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)
+      (let [test-namespaces (->> (all-ns)
+                                 (mapcat ns-publics)
+                                 (map (comp meta second))
+                                 (filter :test)
+                                 (filter (comp test-files :file))
+                                 (map :ns)
+                                 (set))]
+        (println "Running tests on:" (map ns-name test-namespaces))
+        (System/exit (if (pos? (reduce (fn [total-fails n]
+                                         (with-redefs [t/report emacs-report]
+                                           (let [results (t/run-tests n)]
+                                             (+ total-fails
+                                                (:fail results 0)
+                                                (:error results 0)))))
+                                       0
+                                       test-namespaces))
+                       1
+                       0))))))

--
Gitblit v1.9.3