Throw typed exceptions; one exception hierarchy
jolt's own throw sites raised untyped Chez conditions with the class name buried
in an English message, so (class e) reported the opaque :object and only a broad
catch worked:
(class (try (Long/parseLong "xyz") (catch Throwable e e))) => :object
; JVM: java.lang.NumberFormatException
Raise typed throwables (jolt-host-throwable) at the Long/Double parse and
StringTokenizer sites so (class e) / .getMessage / a specific catch all reflect
the real class. And fold the exception supertype table (exception-parent) into
the one class graph: exception-isa? now resolves the simple name to its graph key
and asks jch-isa?, so exceptions and every other class share a single hierarchy.
Runtime only, no re-mint. make test green (0 new/stale), +2 corpus rows.
This commit is contained in:
Yogthos
parent
01f98c2e89
commit
f856c16f06
5 changed files with 35 additions and 47 deletions
|
|
@ -104,11 +104,30 @@
|
|||
(or (hashtable-ref jch-known-cache wanted #f)
|
||||
(hashtable-ref jch-known-cache (jch-last-segment wanted) #f)))
|
||||
|
||||
;; A register also invalidates the known-name cache.
|
||||
;; simple last-segment -> canonical FQN for a modeled class (first registered
|
||||
;; wins). Lets a simple exception name (from chez-condition-exc-class) resolve to
|
||||
;; its graph key so the exception hierarchy answers through the one graph.
|
||||
(define jch-simple->fqn-cache #f)
|
||||
(define (jch-fqn-of-simple name)
|
||||
(when (not jch-simple->fqn-cache)
|
||||
(set! jch-simple->fqn-cache (make-hashtable string-hash string=?))
|
||||
(let-values (((keys vals) (hashtable-entries jvm-class-parents)))
|
||||
(vector-for-each
|
||||
(lambda (k supers)
|
||||
(for-each (lambda (n)
|
||||
(let ((seg (jch-last-segment n)))
|
||||
(when (not (hashtable-ref jch-simple->fqn-cache seg #f))
|
||||
(hashtable-set! jch-simple->fqn-cache seg n))))
|
||||
(cons k supers)))
|
||||
keys vals)))
|
||||
(or (hashtable-ref jch-simple->fqn-cache name #f) name))
|
||||
|
||||
;; A register also invalidates the derived caches.
|
||||
(define jch-register-supers!-inner jch-register-supers!)
|
||||
(set! jch-register-supers!
|
||||
(lambda (name supers)
|
||||
(set! jch-known-cache #f)
|
||||
(set! jch-simple->fqn-cache #f)
|
||||
(jch-register-supers!-inner name supers)))
|
||||
|
||||
;; ---- seed the built-in graph: direct supers only, faithful to the JVM ---------
|
||||
|
|
|
|||
|
|
@ -455,7 +455,7 @@
|
|||
(let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
|
||||
(if (< p (length toks))
|
||||
(begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))
|
||||
(error #f "NoSuchElementException")))))
|
||||
(jolt-throw (jolt-host-throwable "java.util.NoSuchElementException" "no more tokens"))))))
|
||||
;; StringTokenizer implements java.util.Enumeration — enumeration-seq drives
|
||||
;; it through these, so alias them onto the token methods.
|
||||
(cons "hasMoreElements" (lambda (self) (< (vector-ref (jhost-state self) 1) (length (vector-ref (jhost-state self) 0)))))
|
||||
|
|
@ -463,7 +463,7 @@
|
|||
(let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
|
||||
(if (< p (length toks))
|
||||
(begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))
|
||||
(error #f "NoSuchElementException")))))))
|
||||
(jolt-throw (jolt-host-throwable "java.util.NoSuchElementException" "no more tokens"))))))))
|
||||
|
||||
;; ---- String / BigInteger / MapEntry constructors ----------------------------
|
||||
;; (String. bytes [charset]) decodes bytes (a bytevector OR a jolt byte-array)
|
||||
|
|
|
|||
|
|
@ -194,8 +194,9 @@
|
|||
(and n (integer? n) (->num n))))
|
||||
(define (parse-int-or-throw s radix what)
|
||||
(or (parse-int-str s radix)
|
||||
(error #f (string-append "NumberFormatException: For input string: \""
|
||||
(if (string? s) s (jolt-str-render-one s)) "\""))))
|
||||
(jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
|
||||
(string-append "For input string: \""
|
||||
(if (string? s) s (jolt-str-render-one s)) "\"")))))
|
||||
(define (char-code c) (if (char? c) (char->integer c) (jnum->exact c)))
|
||||
|
||||
;; parse a double string (Double/parseDouble, (Double. s)); JVM accepts NaN /
|
||||
|
|
@ -209,7 +210,8 @@
|
|||
(else (let ((n (string->number t))) (and n (real? n) (exact->inexact n)))))))
|
||||
(define (parse-double-or-throw s)
|
||||
(or (parse-double-str s)
|
||||
(error #f (string-append "NumberFormatException: For input string: \""
|
||||
(if (string? s) s (jolt-str-render-one s)) "\""))))
|
||||
(jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
|
||||
(string-append "For input string: \""
|
||||
(if (string? s) s (jolt-str-render-one s)) "\"")))))
|
||||
(define (->double x) (if (number? x) (exact->inexact x) (parse-double-or-throw x)))
|
||||
|
||||
|
|
|
|||
|
|
@ -10,47 +10,12 @@
|
|||
(define (ex-info-class v)
|
||||
(let ((c (jolt-get v jolt-kw-class jolt-nil)))
|
||||
(if (string? c) c "clojure.lang.ExceptionInfo")))
|
||||
;; immediate-parent chain of the JVM exception hierarchy (simple names). Drives
|
||||
;; instance? across exception supertypes — (instance? Throwable (ex-info …)) etc.
|
||||
(define exception-parent
|
||||
'(("ExceptionInfo" . "RuntimeException")
|
||||
("RuntimeException" . "Exception")
|
||||
("IllegalArgumentException" . "RuntimeException")
|
||||
("ArityException" . "IllegalArgumentException")
|
||||
("NumberFormatException" . "IllegalArgumentException")
|
||||
("IllegalStateException" . "RuntimeException")
|
||||
("UnsupportedOperationException" . "RuntimeException")
|
||||
("ArithmeticException" . "RuntimeException")
|
||||
("NullPointerException" . "RuntimeException")
|
||||
("ClassCastException" . "RuntimeException")
|
||||
("IndexOutOfBoundsException" . "RuntimeException")
|
||||
("ConcurrentModificationException" . "RuntimeException")
|
||||
("NoSuchElementException" . "RuntimeException")
|
||||
("UncheckedIOException" . "RuntimeException")
|
||||
("DateTimeException" . "RuntimeException")
|
||||
("DateTimeParseException" . "DateTimeException")
|
||||
("InterruptedException" . "Exception")
|
||||
("IOException" . "Exception")
|
||||
("FileNotFoundException" . "IOException")
|
||||
("UnsupportedEncodingException" . "IOException")
|
||||
("UnknownHostException" . "IOException")
|
||||
("SocketException" . "IOException")
|
||||
("ConnectException" . "IOException")
|
||||
("SocketTimeoutException" . "IOException")
|
||||
("MalformedURLException" . "IOException")
|
||||
("SSLException" . "IOException")
|
||||
("Exception" . "Throwable")
|
||||
("Error" . "Throwable")
|
||||
("AssertionError" . "Error")
|
||||
("Throwable" . "Object")))
|
||||
;; Is `wanted` (simple name) `cls` or a supertype of it? ExceptionInfo also
|
||||
;; implements the IExceptionInfo interface.
|
||||
;; Is `wanted` (simple name) `cls` or a supertype of it? The exception hierarchy
|
||||
;; lives in the one class graph (class-hierarchy.ss) — resolve the simple name to
|
||||
;; its graph key and ask jch-isa?, so exceptions and every other class share a
|
||||
;; single source of truth (ExceptionInfo -> IExceptionInfo is a graph edge).
|
||||
(define (exception-isa? cls wanted)
|
||||
(let loop ((c cls))
|
||||
(cond ((not c) #f)
|
||||
((string=? c wanted) #t)
|
||||
((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
|
||||
(else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
|
||||
(jch-isa? (jch-fqn-of-simple cls) wanted))
|
||||
|
||||
;; 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
|
||||
|
|
|
|||
|
|
@ -3511,4 +3511,6 @@
|
|||
{:suite "host-interop / getClass" :label ".getClass is a universal Object method, reached on every value type" :expected "[\"java.util.Date\" \"java.io.File\"]" :actual "[(.getName (.getClass (java.util.Date.))) (.getName (.getClass (java.io.File. \"x\")))]"}
|
||||
{:suite "reduce / IReduceInit" :label "reduce drives a deftype's own reduce method (init arity)" :expected "110" :actual "(do (deftype Rng [n] clojure.lang.IReduceInit (reduce [_ f init] (loop [i 0 acc init] (if (< i n) (recur (inc i) (f acc i)) acc)))) (reduce + 100 (->Rng 5)))"}
|
||||
{:suite "reduce / IReduceInit" :label "a deftype reduce honors reduced short-circuit" :expected "3" :actual "(do (deftype Rng [n] clojure.lang.IReduceInit (reduce [_ f init] (loop [i 0 acc init] (if (< i n) (let [a (f acc i)] (if (reduced? a) @a (recur (inc i) a))) acc)))) (reduce (fn [acc x] (if (= x 3) (reduced acc) (+ acc x))) 0 (->Rng 10)))"}
|
||||
{:suite "exceptions / typed throw" :label "a jolt-raised NumberFormatException reports its real class and message" :expected "[\"java.lang.NumberFormatException\" \"For input string: \\\"xyz\\\"\"]" :actual "(try (Long/parseLong \"xyz\") (catch Throwable e [(.getName (class e)) (.getMessage e)]))"}
|
||||
{:suite "exceptions / hierarchy catch" :label "a typed throwable matches its superclasses, not unrelated ones" :expected "[true true true false]" :actual "(let [e (try (Long/parseLong \"z\") (catch Throwable e e))] [(instance? NumberFormatException e) (instance? IllegalArgumentException e) (instance? Exception e) (instance? java.io.IOException e)])"}
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue