From 47864403e8c6df48598e8ad82cffc4537abdd4b4 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Mon, 22 Jun 2026 18:27:27 -0400 Subject: [PATCH] Conformance: throwable chaining, URL ctor/getProtocol, ClassLoader/Thread shims MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Surfaced running the DB libraries (migratus) on the jolt db library: - java.sql.SQLException .getNextException / .getStackTrace / .printStackTrace on jolt throwables (conditions + ex-info) return nil/empty, so a library walking the exception chain doesn't crash. - java.net.URL ctor + .getProtocol (file/http), alongside the existing url shim. - A generic java.lang.ClassLoader: getSystemClassLoader / a thread's contextClassLoader resolve a named resource against the source roots (the same model as clojure.java.io/resource) — file: URL or nil. Thread/currentThread. These are generic host capabilities, not DB-specific. The jolt-lang/db next.jdbc surface now runs migratus far enough to connect, build the migrations table, and discover migrations; migratus's remaining dependency is java.nio.file (FileSystems/Path/PathMatcher glob), a JVM filesystem API kept out of core. --- host/chez/dot-forms.ss | 3 +++ host/chez/io.ss | 39 +++++++++++++++++++++++++++++++++++++++ host/chez/records.ss | 4 ++++ test/chez/unit.edn | 3 +++ 4 files changed, 49 insertions(+) diff --git a/host/chez/dot-forms.ss b/host/chez/dot-forms.ss index 8aa53ba..ce85f4c 100644 --- a/host/chez/dot-forms.ss +++ b/host/chez/dot-forms.ss @@ -57,6 +57,9 @@ (jolt-get obj jolt-kw-message jolt-nil) (jolt-str-render-one obj)))) ((string=? name "getCause") (list (jolt-get obj jolt-kw-cause jolt-nil))) + ;; java.sql.SQLException chaining — ex-info / host throwables don't chain. + ((string=? name "getNextException") (list jolt-nil)) + ((string=? name "getStackTrace") (list (jolt-vector))) ((string=? name "toString") (list (jolt-str-render-one obj))) ((string=? name "hashCode") (list (jolt-hash obj))) ((string=? name "equals") (list (if (jolt= obj (car args)) #t #f))) diff --git a/host/chez/io.ss b/host/chez/io.ss index 562364e..53f2c21 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -62,9 +62,18 @@ (define (url-strip-scheme spec) (if (and (>= (string-length spec) 5) (string=? (substring spec 0 5) "file:")) (substring spec 5 (string-length spec)) spec)) +(define (url-protocol spec) + (let ((i (let loop ((j 0)) (cond ((>= j (string-length spec)) #f) + ((char=? (string-ref spec j) #\:) j) (else (loop (+ j 1))))))) + (if i (substring spec 0 i) ""))) +;; (java.net.URL. spec) — a basic file/http URL value (a library may register a +;; richer URL shim, which overrides this). +(register-class-ctor! "URL" (lambda (spec . _) (make-url (jolt-str-render-one spec)))) +(register-class-ctor! "java.net.URL" (lambda (spec . _) (make-url (jolt-str-render-one spec)))) (register-host-methods! "url" (list (cons "toString" (lambda (self) (url-spec self))) (cons "toExternalForm" (lambda (self) (url-spec self))) + (cons "getProtocol" (lambda (self) (url-protocol (url-spec self)))) (cons "getPath" (lambda (self) (url-strip-scheme (url-spec self)))) (cons "getFile" (lambda (self) (url-strip-scheme (url-spec self)))))) @@ -341,6 +350,36 @@ (else (let ((ctor (lookup-class class-ctors-tbl "URL"))) (if ctor (ctor (jolt-str-render-one x)) (make-url (jolt-str-render-one x)))))))) +;; --- java.lang.ClassLoader (jolt-1nnn) -------------------------------------- +;; jolt has no classpath; a "classloader" resolves a named resource against the +;; loader's source roots (the same model as clojure.java.io/resource), returning a +;; file: URL or nil. getSystemClassLoader / a thread's contextClassLoader both hand +;; back this loader. Libraries that probe the classpath (e.g. migratus's migration- +;; dir discovery) then fall back to the filesystem when a resource isn't a root. +(define the-classloader (make-jhost "classloader" (vector))) +(define (cl-get-resource self name) + (let ((nm (jolt-str-render-one name))) + (let loop ((roots (get-source-roots))) + (cond ((null? roots) jolt-nil) + ((file-exists? (string-append (car roots) "/" nm)) + (make-url (string-append "file:" (car roots) "/" nm))) + (else (loop (cdr roots))))))) +(register-host-methods! "classloader" + (list (cons "getResource" cl-get-resource) + (cons "getResourceAsStream" + (lambda (self name) + (let ((u (cl-get-resource self name))) + (if (jolt-nil? u) jolt-nil (host-new "StringReader" (jolt-slurp (url-strip-scheme (url-spec u)))))))))) +(register-class-statics! "ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader)))) +(register-class-statics! "java.lang.ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader)))) +;; Thread/currentThread -> a thread jhost whose getContextClassLoader is the loader. +(define the-thread (make-jhost "thread" (vector))) +(register-host-methods! "thread" + (list (cons "getContextClassLoader" (lambda (self) the-classloader)) + (cons "getName" (lambda (self) "main")))) +(register-class-statics! "Thread" (list (cons "currentThread" (lambda () the-thread)))) +(register-class-statics! "java.lang.Thread" (list (cons "currentThread" (lambda () the-thread)))) + ;; --- java.io.File / java.util.UUID constructors (jolt-1nnn) ------------------ ;; (java.io.File. parent child) joins with "/"; (File. path) wraps the path. (register-class-ctor! "File" diff --git a/host/chez/records.ss b/host/chez/records.ss index d4bb403..352f7c6 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -323,6 +323,10 @@ (condition->message-string obj)) ((string=? method-name "toString") (condition->message-string obj)) ((string=? method-name "getCause") jolt-nil) + ;; java.sql.SQLException chaining — jolt errors don't chain (nil). + ((or (string=? method-name "getNextException") (string=? method-name "getCause")) jolt-nil) + ((string=? method-name "getStackTrace") (jolt-vector)) + ((string=? method-name "printStackTrace") jolt-nil) (else (error #f (string-append "No method " method-name " on Throwable"))))) ;; java.lang.Character interop: (.toString \+) -> "+", etc. ((char? obj) diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 9c2ed22..1e741aa 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -110,6 +110,9 @@ {:suite "reader" :expr "(let [r (-> \"(+ 1 2) 99\" java.io.StringReader. java.io.PushbackReader.)] [(read r) (read r)])" :expected "[(+ 1 2) 99]"} {:suite "hostctor" :expr "(String/format \"%d-%s\" 5 \"x\")" :expected "5-x"} {:suite "hostctor" :expr "[(.format (java.text.NumberFormat/getInstance) 1234567.5) (.format (java.text.NumberFormat/getIntegerInstance) 1234567)]" :expected "[1,234,567.5 1,234,567]"} + {:suite "hostctor" :expr "[(.getProtocol (java.net.URL. \"file:/tmp/x\")) (.getFile (java.net.URL. \"http://h/p\")) (.getProtocol (java.net.URL. \"http://h/p\"))]" :expected "[file http://h/p http]"} + {:suite "hostobj" :expr "(try (throw (ex-info \"x\" {})) (catch Throwable e [(.getNextException e) (vec (.getStackTrace e))]))" :expected "[nil []]"} + {:suite "hostobj" :expr "[(some? (ClassLoader/getSystemClassLoader)) (some? (.getContextClassLoader (Thread/currentThread)))]" :expected "[true true]"} {:suite "dotform" :expr "(.equals \"a\" \"a\")" :expected "true"} {:suite "dotform" :expr "(.equals \"a\" \"b\")" :expected "false"} {:suite "dotform" :expr "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" :expected "v=41"}