clojure.stacktrace now works with GraalVM!

.clj-kondo/config.edn

@@ -4,4 +4,4 @@
            babashka.impl.File/gen-wrapper-fn-2 clojure.core/def
            babashka.impl.Pattern/gen-wrapper-fn-2 clojure.core/def
            babashka.impl.Pattern/gen-constants clojure.core/declare}
- :linters {:unsorted-namespaces {:level :warning}}}
+ :linters {:unsorted-required-namespaces {:level :warning}}}

src/babashka/impl/clojure/stacktrace.clj

@@ -1,88 +1,10 @@
-;;   Copyright (c) Rich Hickey. All rights reserved.
+(ns babashka.impl.clojure.stacktrace
-;;   The use and distribution terms for this software are covered by the
+  {:no-doc true}
-;;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+  (:require [clojure.stacktrace :as stacktrace]))
-;;   which can be found in the file epl-v10.html at the root of this distribution.
-;;   By using this software in any fashion, you are agreeing to be bound by
-;;   the terms of this license.
-;;   You must not remove this notice, or any other, from this software.
-
-;;; stacktrace.clj: print Clojure-centric stack traces
-
-;; by Stuart Sierra
-;; January 6, 2009
-
-(ns ^{:doc "Print stack traces oriented towards Clojure, not Java."
-      :author "Stuart Sierra"
-      :no-doc true}
-    babashka.impl.clojure.stacktrace)
-
-(set! *warn-on-reflection* true)
-
-(defn root-cause
-  "Returns the last 'cause' Throwable in a chain of Throwables."
-  {:added "1.1"}
-  [^Throwable tr]
-  (if-let [cause (.getCause tr)]
-    (recur cause)
-    tr))
-
-(defn print-trace-element
-  "Prints a Clojure-oriented view of one element in a stack trace."
-  {:added "1.1"}
-  [^StackTraceElement e]
-  (let [class (.getClassName e)
-        method (.getMethodName e)]
-    (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" (str class))]
-      (if (and match (= "invoke" method))
-        (apply printf "%s/%s" (rest match))
-        (printf "%s.%s" class method))))
-  (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
-
-(defn print-throwable
-  "Prints the class and message of a Throwable. Prints the ex-data map
-  if present."
-  {:added "1.1"}
-  [^Throwable tr]
-  (printf "%s: %s" (.getName (class tr)) (.getMessage tr))
-  (when-let [info (ex-data tr)]
-    (newline)
-    (pr info)))
-
-(defn print-stack-trace
-  "Prints a Clojure-oriented stack trace of tr, a Throwable.
-  Prints a maximum of n stack frames (default: unlimited).
-  Does not print chained exceptions (causes)."
-  {:added "1.1"}
-  ([tr] (print-stack-trace tr nil))
-  ([^Throwable tr n]
-   (let [st (.getStackTrace tr)]
-     (print-throwable tr)
-     (newline)
-     (print " at ")
-     (if-let [e (first st)]
-       (print-trace-element e)
-       (print "[empty stack trace]"))
-     (newline)
-     (doseq [e (if (nil? n)
-                 (rest st)
-                 (take (dec n) (rest st)))]
-       (print "    ")
-       (print-trace-element e)
-       (newline)))))
-
-(defn print-cause-trace
-  "Like print-stack-trace but prints chained exceptions (causes)."
-  {:added "1.1"}
-  ([tr] (print-cause-trace tr nil))
-  ([^Throwable tr n]
-   (print-stack-trace tr n)
-   (when-let [cause (.getCause tr)]
-     (print "Caused by: " )
-     (recur cause n))))
 
 (def stacktrace-namespace
-  {'root-cause root-cause
+  {'root-cause stacktrace/root-cause
-   'print-trace-element print-trace-element
+   'print-trace-element stacktrace/print-trace-element
-   'print-throwable print-throwable
+   'print-throwable stacktrace/print-throwable
-   'print-stack-trace print-stack-trace
+   'print-stack-trace stacktrace/print-stack-trace
-   'print-cause-trace print-cause-trace})
+   'print-cause-trace stacktrace/print-cause-trace})

src/babashka/impl/clojure/test.clj

@@ -1,10 +1,10 @@
-                                        ;   Copyright (c) Rich Hickey. All rights reserved.
+;;   Copyright (c) Rich Hickey. All rights reserved.
-                                        ;   The use and distribution terms for this software are covered by the
+;;   The use and distribution terms for this software are covered by the
-                                        ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-                                        ;   which can be found in the file epl-v10.html at the root of this distribution.
+;;   which can be found in the file epl-v10.html at the root of this distribution.
-                                        ;   By using this software in any fashion, you are agreeing to be bound by
+;;   By using this software in any fashion, you are agreeing to be bound by
-                                        ;   the terms of this license.
+;;   the terms of this license.
-                                        ;   You must not remove this notice, or any other, from this software.
+;;   You must not remove this notice, or any other, from this software.
 
 ;;; test.clj: test framework for Clojure
 
@@ -232,9 +232,8 @@
    For additional event types, see the examples in the code.
 "}
     babashka.impl.clojure.test
-  (:require [babashka.impl.clojure.stacktrace :as stack]
+  (:require [babashka.impl.common :refer [ctx]]
-            [babashka.impl.common :refer [ctx]]
+            [clojure.stacktrace :as stack]
-            [clojure.string :as str]
             [clojure.template :as temp]
             [sci.core :as sci]
             [sci.impl.analyzer :as ana]
@@ -430,9 +429,9 @@
            result# (apply ~pred values#)]
        (if result#
          (clojure.test/do-report {:type :pass, :message ~msg,
-                     :expected '~form, :actual (cons ~pred values#)})
+                                  :expected '~form, :actual (cons ~pred values#)})
          (clojure.test/do-report {:type :fail, :message ~msg,
-                     :expected '~form, :actual (list '~'not (cons '~pred values#))}))
+                                  :expected '~form, :actual (list '~'not (cons '~pred values#))}))
        result#)))
 
 (defn assert-any
@@ -443,9 +442,9 @@
   `(let [value# ~form]
      (if value#
        (clojure.test/do-report {:type :pass, :message ~msg,
-                   :expected '~form, :actual value#})
+                                :expected '~form, :actual value#})
        (clojure.test/do-report {:type :fail, :message ~msg,
-                   :expected '~form, :actual value#}))
+                                :expected '~form, :actual value#}))
      value#))
 
 
@@ -479,9 +478,9 @@
      (let [result# (instance? klass# object#)]
        (if result#
          (clojure.test/do-report {:type :pass, :message ~msg,
-                     :expected '~form, :actual (class object#)})
+                                  :expected '~form, :actual (class object#)})
          (clojure.test/do-report {:type :fail, :message ~msg,
-                     :expected '~form, :actual (class object#)}))
+                                  :expected '~form, :actual (class object#)}))
        result#)))
 
 (defmethod assert-expr 'thrown? [msg form]
@@ -492,10 +491,10 @@
         body (nthnext form 2)]
     `(try ~@body
           (clojure.test/do-report {:type :fail, :message ~msg,
-                      :expected '~form, :actual nil})
+                                   :expected '~form, :actual nil})
           (catch ~klass e#
             (clojure.test/do-report {:type :pass, :message ~msg,
-                        :expected '~form, :actual e#})
+                                     :expected '~form, :actual e#})
             e#))))
 
 (defmethod assert-expr 'thrown-with-msg? [msg form]
@@ -512,7 +511,7 @@
             (let [m# (.getMessage e#)]
               (if (re-find ~re m#)
                 (clojure.test/do-report {:type :pass, :message ~msg,
-                            :expected '~form, :actual e#})
+                                         :expected '~form, :actual e#})
                 (clojure.test/do-report {:type :fail, :message ~msg,
                                          :expected '~form, :actual e#})))
             e#))))

src/babashka/main.clj

@@ -10,7 +10,7 @@
    [babashka.impl.clojure.java.shell :refer [shell-namespace]]
    [babashka.impl.clojure.main :refer [demunge]]
    [babashka.impl.clojure.pprint :refer [pprint-namespace]]
-   [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace print-stack-trace]]
+   [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace]]
    [babashka.impl.common :as common]
    [babashka.impl.csv :as csv]
    [babashka.impl.pipe-signal-handler :refer [handle-pipe! pipe-signal-received?]]
@@ -21,6 +21,7 @@
    [babashka.wait :as wait]
    [clojure.edn :as edn]
    [clojure.java.io :as io]
+   [clojure.stacktrace :refer [print-stack-trace]]
    [clojure.string :as str]
    [sci.addons :as addons]
    [sci.core :as sci]