simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Readable messages for host conditions

Browse source 
clojure.test reported a host-condition crash with a blank message (ex-message is
nil for non-ex-info conditions); fall back to jolt.host/condition-message.
condition-message itself left a Chez format-template message (open-input-file's
'failed for ~a: ~(~a~)') unformatted; apply its irritants.
This commit is contained in:
Yogthos 2026-06-24 11:03:34 -04:00
parent 7947918919
commit 79d0084163
2 changed files with 25 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

19
host/chez/records.ss
View file

@ -255,10 +255,21 @@
;; &message text plus any &irritants, or display-condition output as a fallback. ;; &message text plus any &irritants, or display-condition output as a fallback.
(define (condition->message-string c) (define (condition->message-string c)
(if (message-condition? c) (if (message-condition? c)
(let ((m (condition-message c)) (let* ((m (condition-message c))
(irr (if (irritants-condition? c) (condition-irritants c) '()))) (irr (if (irritants-condition? c) (condition-irritants c) '()))
(let loop ((xs irr) (acc m)) (append-irr (lambda ()
(if (null? xs) acc (loop (cdr xs) (string-append acc " " (jolt-pr-str (car xs))))))) (let loop ((xs irr) (acc m))
(if (null? xs) acc
(loop (cdr xs) (string-append acc " " (jolt-pr-str (car xs)))))))))
;; some Chez conditions (open-input-file etc.) carry a format-template
;; message ("failed for ~a: ~(~a~)") whose irritants fill the directives;
;; format it in. Fall back to appending the irritants if that fails.
(if (and (string? m) (let scan ((i 0))
(cond ((>= i (string-length m)) #f)
((char=? (string-ref m i) #\~) #t)
(else (scan (+ i 1))))))
(guard (e (#t (append-irr))) (apply format m irr))
(append-irr)))
(with-output-to-string (lambda () (display-condition c))))) (with-output-to-string (lambda () (display-condition c)))))
;; expose a Chez condition's message to Clojure (ex-message returns nil for raw ;; expose a Chez condition's message to Clojure (ex-message returns nil for raw
;; host conditions): the nREPL eval handler surfaces it instead of an opaque ;; host conditions): the nREPL eval handler surfaces it instead of an opaque

12
stdlib/clojure/test.clj
View file

@ -46,6 +46,14 @@
(defn n-error [] (:error @counters)) (defn n-error [] (:error @counters))
(defn failures [] (:fails @counters)) (defn failures [] (:fails @counters))
;; Message of a thrown value: ex-info's message, else a raw host condition's text
;; (ex-message is nil for those), else its printed form — so a crash is never
;; reported with a blank message.
(defn err-text [e]
(or (ex-message e)
(jolt.host/condition-message e)
(str e)))
;; clojure.test/report multimethod — present so suites that add reporting ;; clojure.test/report multimethod — present so suites that add reporting
;; methods (defmethod clojure.test/report :begin-test-var ...) load. The runner ;; methods (defmethod clojure.test/report :begin-test-var ...) load. The runner
;; below does its own console output and doesn't dispatch through it. ;; below does its own console output and doesn't dispatch through it.
@ -110,7 +118,7 @@
(clojure.test/inc-pass!) (clojure.test/inc-pass!)
(clojure.test/fail! (str (pr-str '~form) (when ~msg (str " — " ~msg))))) (clojure.test/fail! (str (pr-str '~form) (when ~msg (str " — " ~msg)))))
(catch Throwable e# (catch Throwable e#
(clojure.test/err! (str (pr-str '~form) " threw: " (clojure.core/ex-message e#)))))))) (clojure.test/err! (str (pr-str '~form) " threw: " (clojure.test/err-text e#))))))))
(defmacro testing [s & body] (defmacro testing [s & body]
`(do `(do
@ -152,7 +160,7 @@
(try (try
((:fn t)) ((:fn t))
(catch Throwable e (catch Throwable e
(err! (str (:name t) " crashed: " (clojure.core/ex-message e)))))))) (err! (str (:name t) " crashed: " (err-text e))))))))
(defn run-registered [] (defn run-registered []
(doseq [t @registry] (run-one t)) (doseq [t @registry] (run-one t))