Merge f632d74d9f into 238a98d9b2

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
 
 (defn- add-ns-meta
@@ -700,9 +686,6 @@
   [fixtures]
   (reduce compose-fixtures default-fixture fixtures))
 
-
-
-
 ;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS
 
 (defn test-var-impl
@@ -766,8 +749,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

@@ -122,6 +122,18 @@ true")))))
 
 (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?