[WIP] clojure.test: print sci stacktraces

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
+ "<built-in>"
+ "<expr>"))
+ (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))})

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

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?