From f632d74d9f426fbe38149a97fbc114de618bfbeb Mon Sep 17 00:00:00 2001 From: Paulus Esterhazy Date: Sat, 11 Mar 2023 20:26:42 +0100 Subject: [PATCH] clojure.test: print sci stacktraces --- src/babashka/impl/clojure/stacktrace.clj | 56 +++++++++++++++++++++++- src/babashka/impl/clojure/test.clj | 37 ++++------------ test/babashka/test_test.clj | 16 ++++++- 3 files changed, 78 insertions(+), 31 deletions(-) diff --git a/src/babashka/impl/clojure/stacktrace.clj b/src/babashka/impl/clojure/stacktrace.clj index f6d5c06ac..29e48a3f5 100644 --- a/src/babashka/impl/clojure/stacktrace.clj +++ b/src/babashka/impl/clojure/stacktrace.clj @@ -1,6 +1,7 @@ (ns babashka.impl.clojure.stacktrace {:no-doc true} (:require [clojure.stacktrace :as stacktrace] + [clojure.string :as str] [sci.core :as sci])) (def sns (sci/create-ns 'clojure.stacktrace nil)) @@ -13,9 +14,62 @@ (defn new-var [var-sym f] (sci/new-var var-sym f {:ns sns})) +(defn right-pad [s n] + (let [n (- n (count s))] + (str s (str/join (repeat n " "))))) + +(defn format-stacktrace [st] + (let [st (force st) + data (keep (fn [{:keys [:file :ns :line :column :sci/built-in + :local] + nom :name}] + (when (or line built-in) + {:name (str (if nom + (str ns "/" nom) + ns) + (when local + (str "#" local))) + :loc (str (or file + (if built-in + "" + "")) + (when line + (str ":" line ":" column)))})) + st) + max-name (reduce max 0 (map (comp count :name) data))] + (mapv (fn [{:keys [:name :loc]}] + (str (right-pad name max-name) " - " loc)) + data))) + +(defn print-throwable + [^Throwable tr] + (when tr + (printf "%s: %s" (.getName (class tr)) (.getMessage tr)) + (when-let [info (ex-data tr)] + (newline) + (pr info)))) + +(defn print-stack-trace [e] + (print-throwable (.getCause e)) + (newline) + (->> e + (sci/stacktrace) + (format-stacktrace) + (run! println))) + +(defn print-cause-trace + ([tr] (print-cause-trace tr nil)) + ([^Throwable tr n] + (print-stack-trace tr) + (when-let [cause (.getCause tr)] + (print "Caused by: ") + (recur cause n)))) + (def stacktrace-namespace {'root-cause (sci/copy-var stacktrace/root-cause sns) 'print-trace-element (new-var 'print-trace-element (wrap-out stacktrace/print-trace-element)) 'print-throwable (new-var 'print-throwable (wrap-out stacktrace/print-throwable)) + ;; FIXME: expose print-stack-trace as well 'print-stack-trace (new-var 'print-stack-trace (wrap-out stacktrace/print-stack-trace)) - 'print-cause-trace (new-var 'print-cause-trace (wrap-out stacktrace/print-cause-trace))}) + ;; FIXME: should we make both regular and sci-aware stack printers available? + 'print-cause-trace (new-var 'print-cause-trace (wrap-out print-cause-trace))}) diff --git a/src/babashka/impl/clojure/test.clj b/src/babashka/impl/clojure/test.clj index 9767aef33..ac8be0d14 100644 --- a/src/babashka/impl/clojure/test.clj +++ b/src/babashka/impl/clojure/test.clj @@ -15,9 +15,9 @@ ;; contributions and suggestions. (ns - ^{:author "Stuart Sierra, with contributions and suggestions by + ^{:author "Stuart Sierra, with contributions and suggestions by Chas Emerick, Allen Rohner, and Stuart Halloway", - :doc "A unit testing framework. + :doc "A unit testing framework. ASSERTIONS @@ -231,10 +231,10 @@ For additional event types, see the examples in the code. "} - babashka.impl.clojure.test + babashka.impl.clojure.test (:require [babashka.impl.common :refer [ctx]] - [clojure.stacktrace :as stack] + [babashka.impl.clojure.stacktrace :as bbstack] [clojure.template :as temp] [sci.core :as sci] [sci.impl.namespaces :as sci-namespaces] @@ -248,10 +248,10 @@ ;;; USER-MODIFIABLE GLOBALS (defonce - ^{:doc "True by default. If set to false, no test functions will + ^{:doc "True by default. If set to false, no test functions will be created by deftest, set-test, or with-test. Use this to omit tests when compiling or loading production code."} - load-tests + load-tests (sci/new-dynamic-var '*load-tests* true {:ns tns})) (def @@ -261,7 +261,6 @@ stack-trace-depth (sci/new-dynamic-var '*stack-trace-depth* nil {:ns tns})) - ;;; GLOBALS USED BY THE REPORTING FUNCTIONS (def report-counters (sci/new-dynamic-var '*report-counters* nil {:ns tns})) ; bound to a ref of a map in test-ns @@ -342,7 +341,7 @@ [m] (report (case - (:type m) + (:type m) :fail m :error m m))) @@ -372,7 +371,7 @@ (print " actual: ") (let [actual (:actual m)] (if (instance? Throwable actual) - (stack/print-cause-trace actual @stack-trace-depth) + (bbstack/print-cause-trace actual @stack-trace-depth) (prn actual))))) (defmethod report-impl :summary [m] @@ -390,8 +389,6 @@ (defmethod report-impl :begin-test-var [m]) (defmethod report-impl :end-test-var [m]) - - ;;; UTILITIES FOR ASSERTIONS (defn get-possibly-unbound-var @@ -453,8 +450,6 @@ :expected '~form, :actual value#})) value#)) - - ;;; ASSERTION METHODS ;; You don't call these, but you can add methods to extend the 'is' @@ -530,21 +525,18 @@ :expected '~form, :actual e#}))) e#)))) - (defmacro try-expr "Used by the 'is' macro to catch unexpected exceptions. You don't call this." {:added "1.1"} [msg form] `(try ~(assert-expr msg form) - (catch Throwable t# + (catch ~(with-meta 'Exception {:sci/error true}) t# (clojure.test/do-report {:file clojure.core/*file* :line ~(:line (meta form)) :type :error, :message ~msg, :expected '~form, :actual t#})))) - - ;;; ASSERTION MACROS ;; You use these in your tests. @@ -602,8 +594,6 @@ `(binding [clojure.test/*testing-contexts* (conj clojure.test/*testing-contexts* ~string)] ~@body)) - - ;;; DEFINING TESTS (defmacro with-test @@ -618,7 +608,6 @@ `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) definition)) - (defmacro deftest "Defines a test function with no arguments. Test functions may call other tests, so tests may be composed. If you compose tests, you @@ -644,7 +633,6 @@ `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true) (fn [] (test-var (var ~name)))))) - (defmacro set-test "Experimental. Sets :test metadata of the named var to a fn with the given body. @@ -656,8 +644,6 @@ (when @load-tests `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) - - ;;; DEFINING FIXTURES (def ^:private ns->fixtures (atom {})) @@ -702,9 +688,6 @@ [fixtures] (reduce compose-fixtures default-fixture fixtures)) - - - ;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS (defn test-var-impl @@ -770,8 +753,6 @@ (do-report {:type :end-test-ns, :ns ns-obj})) @@report-counters)) - - ;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS (defn run-tests diff --git a/test/babashka/test_test.clj b/test/babashka/test_test.clj index b0ad6da5a..c18fa7d97 100644 --- a/test/babashka/test_test.clj +++ b/test/babashka/test_test.clj @@ -115,6 +115,18 @@ (deftest testing-vars-str-test (is (str/includes? - (bb "(clojure.test/testing-vars-str {:file \"x\" :line 1})") - "() (x:1)") + (bb "(clojure.test/testing-vars-str {:file \"x\" :line 1})") + "() (x:1)") "includes explicit line number + file name in test report")) + +(deftest is-should-include-name-of-function-test + (let [output (bb "(require '[clojure.test :as t]) (defn function-under-test [] (zero? nil)) (t/deftest foo (t/is (= false (function-under-test)))) (foo)")] + (is (str/includes? output "user/function-under-test")))) + +(deftest is-should-throw-wrapped-exception-assert-test + (let [output (bb "(require '[clojure.test :as t]) (t/deftest foo (t/is (assert false))) (foo)")] + ;; FIXME: doesn't work for assert yet + #_(is (str/includes? output ":type :sci/error")))) + +;; FIXME: handle thrown? +;; FIXME: handle thrown-with-message?