clojure.stacktrace now works with GraalVM!

This commit is contained in:
Michiel Borkent 2020-03-05 22:01:47 +01:00
parent e7cbc67b30
commit 91a273034a
4 changed files with 29 additions and 107 deletions

View file

@ -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}}}

View file

@ -1,88 +1,10 @@
;; Copyright (c) Rich Hickey. All rights reserved.
;; 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)
;; 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))))
(ns babashka.impl.clojure.stacktrace
{:no-doc true}
(:require [clojure.stacktrace :as stacktrace]))
(def stacktrace-namespace
{'root-cause root-cause
'print-trace-element print-trace-element
'print-throwable print-throwable
'print-stack-trace print-stack-trace
'print-cause-trace print-cause-trace})
{'root-cause stacktrace/root-cause
'print-trace-element stacktrace/print-trace-element
'print-throwable stacktrace/print-throwable
'print-stack-trace stacktrace/print-stack-trace
'print-cause-trace stacktrace/print-cause-trace})

View file

@ -1,10 +1,10 @@
; Copyright (c) Rich Hickey. All rights reserved.
; 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)
; 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.
;; Copyright (c) Rich Hickey. All rights reserved.
;; 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)
;; 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.
;;; 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]
[babashka.impl.common :refer [ctx]]
[clojure.string :as str]
(:require [babashka.impl.common :refer [ctx]]
[clojure.stacktrace :as stack]
[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#))))

View file

@ -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]