Map raw Chez runtime errors to their JVM exception classes

A wrong-arity or non-seqable error that Chez raises carried no jolt exception
class, so (class e) was :object and (thrown? ArityException …) / (thrown?
IllegalArgumentException …) never matched. Classify these by message:
incorrect-number-of-arguments -> clojure.lang.ArityException, not-seqable ->
java.lang.IllegalArgumentException, with ArityException modeled as a subclass of
IllegalArgumentException. (class e) and instance? now match the JVM.

All java-layer (records-interop.ss classifies, host-class.ss reports the class +
the ArityException token). medley 281 -> 283 passing.

jolt-o9dc
This commit is contained in:
Yogthos 2026-06-26 17:55:30 -04:00
parent 5f72ec9bcb
commit a9ecae9a29
3 changed files with 39 additions and 1 deletions

View file

@ -54,6 +54,14 @@
;; the class NAME of x (string), or nil for nil. (class x) wraps it in a Class
;; value (make-class-obj, host-static-classes.ss) so it renders like a JVM Class
;; while staying = its name string.
;; a raw Chez condition Clojure raises a specific class for (records-interop.ss
;; chez-condition-exc-class) reports that JVM class, so (class e) and a
;; (thrown? ArityException …) test match — not the opaque :object fallback.
(register-class-arm!
(lambda (x) (and (chez-condition-exc-class x) #t))
(lambda (x) (if (string=? (chez-condition-exc-class x) "ArityException")
"clojure.lang.ArityException"
"java.lang.IllegalArgumentException")))
(define (jolt-class-name x)
(let loop ((as jolt-class-arms))
(cond ((null? as) (jolt-class-base x))
@ -94,6 +102,7 @@
("Charset" . "java.nio.charset.Charset") ("Base64" . "java.util.Base64")
("Exception" . "java.lang.Exception")
("IllegalArgumentException" . "java.lang.IllegalArgumentException")
("ArityException" . "clojure.lang.ArityException")
("IllegalStateException" . "java.lang.IllegalStateException")
("RuntimeException" . "java.lang.RuntimeException")
("UnsupportedOperationException" . "java.lang.UnsupportedOperationException")
@ -165,7 +174,7 @@
"java.lang.IndexOutOfBoundsException" "java.io.FileNotFoundException"
"java.io.UnsupportedEncodingException"
;; clojure.lang.ExceptionInfo / IExceptionInfo compared against (class e)
"clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo"
"clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo" "clojure.lang.ArityException"
"java.util.regex.Pattern" "java.net.URI" "java.util.UUID"
"clojure.lang.PersistentQueue"
"clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.Atom"))

View file

@ -16,6 +16,7 @@
'(("ExceptionInfo" . "RuntimeException")
("RuntimeException" . "Exception")
("IllegalArgumentException" . "RuntimeException")
("ArityException" . "IllegalArgumentException")
("NumberFormatException" . "IllegalArgumentException")
("IllegalStateException" . "RuntimeException")
("UnsupportedOperationException" . "RuntimeException")
@ -51,6 +52,24 @@
((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
(else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
;; A raw Chez condition (an arity or non-seqable error Chez itself raised, not a
;; jolt ex-info) carries no jolt exception class. Map the ones Clojure raises a
;; specific class for, by message, so (class e) and (instance? C e) match the JVM.
;; Returns a simple class name or #f.
(define (ri-substring? needle hay)
(let ((nl (string-length needle)) (hl (string-length hay)))
(let loop ((i 0))
(cond ((> (+ i nl) hl) #f)
((string=? needle (substring hay i (+ i nl))) #t)
(else (loop (+ i 1)))))))
(define (chez-condition-exc-class v)
(and (condition? v) (message-condition? v)
(let ((m (condition-message v)))
(and (string? m)
(cond ((ri-substring? "incorrect number of arguments" m) "ArityException")
((ri-substring? "not seqable" m) "IllegalArgumentException")
(else #f))))))
;; instance-check: (type-sym val) — type/protocol membership. Host shims loaded
;; later (io, inst-time, natives-array, natives-queue, host-static-classes)
;; register an arm with register-instance-check-arm! instead of set!-wrapping
@ -61,6 +80,13 @@
(define (register-instance-check-arm! f) ; f: (type-sym val) -> #t | #f | 'pass
(set! instance-check-registry (cons f instance-check-registry)))
;; (instance? C raw-condition): match when C is the condition's mapped class or a
;; supertype of it (ArityException is also an IllegalArgumentException, etc.).
(register-instance-check-arm!
(lambda (type-sym val)
(let ((k (chez-condition-exc-class val)))
(if k (if (exception-isa? k (last-dot (symbol-t-name type-sym))) #t #f) 'pass))))
(define (instance-check-base type-sym val)
(let ((tname (symbol-t-name type-sym)))
(cond