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

instance? matches a thrown :class envelope by its class hierarchy (#242)

Browse source 
A library that throws an ex-info envelope carrying a JVM :class (jolt.host/
tagged-table with a "class" entry — e.g. http-client's UnknownHostException on a
DNS failure) was caught only by a broad (catch Throwable …): (class e) read the
class but (instance? C e) — which catch dispatch lowers to — always returned
false, so clj-http-lite's (catch UnknownHostException e …) for :ignore-unknown-host?
never matched and the condition propagated.

Add an instance? arm matching such an envelope against the carried class or any
ancestor (full name or last segment), and register the common exception hierarchy
(Throwable/Exception/RuntimeException/IOException + the java.net socket/host
exceptions) so (catch IOException e) / (instance? Throwable e) also match. A
non-throwable class (RuntimeException over an IOException, String) stays false.

Fixes http-client's :ignore-unknown-host? test (116/0/0, was 1 error). make test
green, 0 new divergences. Runtime .ss, no re-mint.

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-26 20:18:27 +00:00 • committed by GitHub
parent 301cda2e46
commit 283a0f0eec
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
1 changed files with 30 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

30
host/chez/java/host-static-classes.ss
View file

@ -836,6 +836,18 @@
(reg-class-supers! "clojure.lang.AFn" '("clojure.lang.IFn" "java.lang.Runnable" "java.util.concurrent.Callable")) (reg-class-supers! "clojure.lang.AFn" '("clojure.lang.IFn" "java.lang.Runnable" "java.util.concurrent.Callable"))
(reg-class-supers! "clojure.lang.AFunction" '("clojure.lang.AFn" "clojure.lang.IFn" "clojure.lang.Fn" (reg-class-supers! "clojure.lang.AFunction" '("clojure.lang.AFn" "clojure.lang.IFn" "clojure.lang.Fn"
"java.lang.Runnable" "java.util.concurrent.Callable")) "java.lang.Runnable" "java.util.concurrent.Callable"))
;; common exception hierarchy, so (instance? IOException e) / (catch IOException e)
;; match a more specific throwable a library threw (e.g. http-client's
;; UnknownHostException, caught by clj-http-lite's :ignore-unknown-host?).
(reg-class-supers! "java.lang.Throwable" '("java.lang.Object"))
(reg-class-supers! "java.lang.Exception" '("java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.lang.RuntimeException" '("java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.io.IOException" '("java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.io.InterruptedIOException" '("java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.SocketException" '("java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.UnknownHostException" '("java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.ConnectException" '("java.net.SocketException" "java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.SocketTimeoutException" '("java.io.InterruptedIOException" "java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
;; transitive closure of direct supers (set semantics via an accumulator list) ;; transitive closure of direct supers (set semantics via an accumulator list)
(define (class-ancestors-list name) (define (class-ancestors-list name)
@ -845,6 +857,24 @@
(else (loop (append (hashtable-ref class-supers-tbl (car pending) '()) (cdr pending)) (else (loop (append (hashtable-ref class-supers-tbl (car pending) '()) (cdr pending))
(cons (car pending) seen)))))) (cons (car pending) seen))))))
;; (instance? Class e) on a throwable tagged-table carrying a JVM :class matches the
;; carried class or any of its ancestors (full name or last segment), so a library's
;; (catch UnknownHostException e …) / (catch IOException e …) matches the ex-info
;; envelope it threw. Mirrors the (class e) arm (host-table.ss) for catch dispatch,
;; which lowers to (instance? C e). Non-match returns 'pass so other arms still run.
(register-instance-check-arm!
(lambda (type-sym val)
(if (and (htable? val) (string? (hashtable-ref (htable-h val) "class" #f)))
(let* ((cls (hashtable-ref (htable-h val) "class" #f))
(want (symbol-t-name type-sym))
(want-seg (hsc-last-segment want)))
(let loop ((names (cons cls (class-ancestors-list cls))))
(cond ((null? names) 'pass)
((or (string=? want (car names))
(string=? want-seg (hsc-last-segment (car names)))) #t)
(else (loop (cdr names))))))
'pass)))
;; (jolt.host/class-supers name) / (jolt.host/class-ancestors name) — a jolt seq of ;; (jolt.host/class-supers name) / (jolt.host/class-ancestors name) — a jolt seq of
;; super / ancestor class-name strings, or nil when jolt models no hierarchy for it. ;; super / ancestor class-name strings, or nil when jolt models no hierarchy for it.
(def-var! "jolt.host" "class-supers" (def-var! "jolt.host" "class-supers"