Clojure-compat fixes enabling external HTTP-client support (#159)
Generic language fixes so a host-shim library (jolt-lang/http-client) can carry
clj-http-lite without baking any HTTP/native code into core:
- reader: accept #^ (deprecated metadata reader macro) as ^
- (str pattern) returns the raw regex source, not #"..." — pattern composition
via (re-pattern (str p ...)) now works
- into/conj onto a map merges map items (was (into {} [{:a 1}]) -> {nil nil})
- a Var is callable as its current value (e.g. (wrap #'f) threading a var client)
- core-class reads a :class field off a thrown table, so libraries can throw
typed exceptions whose (class e) is a JVM class name
- compiled catch unwraps the interpreter's :jolt/exception envelope (__unwrap-ex),
so a typed throw keeps its class/message across the interpret/compile boundary
- slurp accepts a byte-array; io/copy is generic over :jolt/input-stream /
:jolt/output-stream stream markers
- instance? gains a registry (__register-instance-check!) for library shim types
- new clojure.test namespace (deftest/is/are/testing/use-fixtures/run-tests with
class-aware thrown?/thrown-with-msg?)
Spec: test/spec/clojure-interop-fixes-spec.janet.
Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
parent
951a3000e6
commit
3c853429f9
11 changed files with 275 additions and 13 deletions
|
|
@ -292,12 +292,15 @@
|
|||
# leaves ctx-current-ns set to that fn's defining ns (it can't restore on
|
||||
# unwind), which then breaks alias resolution in the catching ns. Snapshot
|
||||
# the ns at try entry, reset it on catch (mirrors the interpreter's try).
|
||||
(let [saved (gsym)]
|
||||
(let [saved (gsym) raw (gsym)]
|
||||
['let [saved (core-fn-call ctx "__current-ns")]
|
||||
['try (emit ctx (node :body))
|
||||
[[(symbol (node :catch-sym))]
|
||||
[[raw]
|
||||
['do (core-fn-call ctx "__set-current-ns!" saved)
|
||||
(emit ctx (node :catch-body))]]]])
|
||||
# bind the catch symbol to the UNWRAPPED value (mirrors the
|
||||
# interpreter), so an interpreted throw's envelope doesn't leak here.
|
||||
['let [(symbol (node :catch-sym)) (core-fn-call ctx "__unwrap-ex" raw)]
|
||||
(emit ctx (node :catch-body))]]]]])
|
||||
(emit ctx (node :body))))
|
||||
(if (node :finally)
|
||||
['defer (emit ctx (node :finally)) core]
|
||||
|
|
|
|||
|
|
@ -14,6 +14,11 @@
|
|||
|
||||
(defn as-file [x] (if (__file? x) x (__make-file x)))
|
||||
|
||||
(defn as-url
|
||||
"Coerce `x` to a java.net.URL value (a :jolt/url). Strings are parsed."
|
||||
[x]
|
||||
(if (= :jolt/url (get x :jolt/type)) x (java.net.URL. (str x))))
|
||||
|
||||
(defn reader [x]
|
||||
(cond
|
||||
;; already a reader (java.io shim or janet file handle) — pass through,
|
||||
|
|
@ -68,7 +73,23 @@
|
|||
(when-not (janet.os/stat parent) (janet.os/mkdir parent))))))
|
||||
|
||||
(defn copy
|
||||
"Copy from a path/handle `in` to a path/handle `out`."
|
||||
[in out]
|
||||
"Copy from `in` to `out`. A value carrying a truthy `:jolt/output-stream`
|
||||
marker is treated as a java.io OutputStream (write via its .write); a
|
||||
`:jolt/input-stream` source is pumped through its .read. This lets host-shim
|
||||
libraries (e.g. jolt-lang/http-client's byte streams) participate without core
|
||||
knowing their concrete types. Falls back to the original path/handle copy."
|
||||
[in out & opts]
|
||||
(cond
|
||||
(get out :jolt/output-stream)
|
||||
(if (get in :jolt/input-stream)
|
||||
(let [buf (byte-array 8192)]
|
||||
(loop []
|
||||
(let [n (.read in buf 0 8192)]
|
||||
(when (not= -1 n)
|
||||
(.write out buf 0 n)
|
||||
(recur)))))
|
||||
;; in is a byte-array / string
|
||||
(.write out in))
|
||||
:else
|
||||
(let [content (if (string? in) (slurp in) (janet.file/read in :all))]
|
||||
(if (string? out) (spit out content) (janet.file/write out content))))
|
||||
(if (string? out) (spit out content) (janet.file/write out content)))))
|
||||
|
|
|
|||
171
src/jolt/clojure/test.clj
Normal file
171
src/jolt/clojure/test.clj
Normal file
|
|
@ -0,0 +1,171 @@
|
|||
; Jolt Standard Library: clojure.test
|
||||
;
|
||||
; A practical subset of clojure.test for running real test suites under Jolt:
|
||||
; deftest / is / testing / are / use-fixtures / run-tests, with class-aware
|
||||
; (thrown? Class body) and (thrown-with-msg? Class re body) inside `is`. Class
|
||||
; matching is by simple-name (last dotted segment), since Jolt has no JVM class
|
||||
; objects — Exception/Throwable match any thrown value.
|
||||
;
|
||||
; Also exposes the counter/registry API the internal clojure-test-suite harness
|
||||
; uses (reset-report!, run-registered, n-pass/n-fail/n-error, failures), so this
|
||||
; is a drop-in superset.
|
||||
|
||||
(ns clojure.test
|
||||
(:require [clojure.string :as str]))
|
||||
|
||||
;; --- state -----------------------------------------------------------------
|
||||
|
||||
(def counters (atom {:test 0 :pass 0 :fail 0 :error 0 :fails []}))
|
||||
(def jolt-report counters) ;; alias used by the suite harness
|
||||
(def ctx-stack (atom []))
|
||||
(def registry (atom [])) ;; [{:name sym :fn thunk}]
|
||||
(def once-fixtures (atom []))
|
||||
(def each-fixtures (atom []))
|
||||
|
||||
(defn reset-report! []
|
||||
(reset! counters {:test 0 :pass 0 :fail 0 :error 0 :fails []})
|
||||
(reset! ctx-stack [])
|
||||
(reset! registry [])
|
||||
(reset! once-fixtures [])
|
||||
(reset! each-fixtures []))
|
||||
|
||||
(defn- ctx-str [] (str/join " " @ctx-stack))
|
||||
|
||||
(defn inc-pass! [] (swap! counters update :pass inc))
|
||||
(defn fail! [form]
|
||||
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "FAIL: " form)]
|
||||
(swap! counters (fn [r] (-> r (update :fail inc) (update :fails conj line))))
|
||||
(println line)))
|
||||
(defn err! [form]
|
||||
(let [line (str (ctx-str) (when (seq @ctx-stack) " ") "ERROR: " form)]
|
||||
(swap! counters (fn [r] (-> r (update :error inc) (update :fails conj line))))
|
||||
(println line)))
|
||||
|
||||
(defn n-pass [] (:pass @counters))
|
||||
(defn n-fail [] (:fail @counters))
|
||||
(defn n-error [] (:error @counters))
|
||||
(defn failures [] (:fails @counters))
|
||||
|
||||
;; clojure.test/report multimethod — present so suites that add reporting
|
||||
;; methods (defmethod clojure.test/report :begin-test-var ...) load. The runner
|
||||
;; below does its own console output and doesn't dispatch through it.
|
||||
(defmulti report :type)
|
||||
(defmethod report :default [_m] nil)
|
||||
|
||||
;; --- class matching for thrown? --------------------------------------------
|
||||
|
||||
(defn- last-seg [s]
|
||||
(let [s (str s)
|
||||
i (str/last-index-of s ".")]
|
||||
(if i (subs s (inc i)) s)))
|
||||
|
||||
(defn class-match?
|
||||
"True if thrown value `e` matches the wanted class simple-name `wanted`.
|
||||
Exception/Throwable match anything."
|
||||
[e wanted]
|
||||
(let [w (last-seg wanted)]
|
||||
(if (or (= w "Exception") (= w "Throwable"))
|
||||
true
|
||||
(let [c (class e)]
|
||||
(and (string? c) (= (last-seg c) w))))))
|
||||
|
||||
;; --- assertion macros ------------------------------------------------------
|
||||
|
||||
(defn- thrown-form? [form sym]
|
||||
(and (seq? form) (symbol? (first form)) (= sym (name (first form)))))
|
||||
|
||||
(defmacro is
|
||||
([form] `(is ~form nil))
|
||||
([form msg]
|
||||
(cond
|
||||
;; (is (thrown? Class body...))
|
||||
(thrown-form? form "thrown?")
|
||||
(let [klass (name (second form))
|
||||
body (nthrest form 2)]
|
||||
`(try
|
||||
~@body
|
||||
(clojure.test/fail! (str "expected " '~form " to throw" (when ~msg (str " — " ~msg))))
|
||||
(catch Throwable e#
|
||||
(if (clojure.test/class-match? e# ~klass)
|
||||
(clojure.test/inc-pass!)
|
||||
(clojure.test/fail! (str "expected throw of " ~klass " but got " (clojure.core/class e#)))))))
|
||||
|
||||
;; (is (thrown-with-msg? Class re body...))
|
||||
(thrown-form? form "thrown-with-msg?")
|
||||
(let [klass (name (second form))
|
||||
re (nth form 2)
|
||||
body (nthrest form 3)]
|
||||
`(try
|
||||
~@body
|
||||
(clojure.test/fail! (str "expected " '~form " to throw"))
|
||||
(catch Throwable e#
|
||||
(let [m# (or (clojure.core/ex-message e#) (str e#))]
|
||||
(if (and (clojure.test/class-match? e# ~klass) (re-find ~re m#))
|
||||
(clojure.test/inc-pass!)
|
||||
(clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#)))))))
|
||||
|
||||
:else
|
||||
`(try
|
||||
(if ~form
|
||||
(clojure.test/inc-pass!)
|
||||
(clojure.test/fail! (str (pr-str '~form) (when ~msg (str " — " ~msg)))))
|
||||
(catch Throwable e#
|
||||
(clojure.test/err! (str (pr-str '~form) " threw: " (clojure.core/ex-message e#))))))))
|
||||
|
||||
(defmacro testing [s & body]
|
||||
`(do
|
||||
(swap! clojure.test/ctx-stack conj ~s)
|
||||
(try
|
||||
(do ~@body)
|
||||
(finally (swap! clojure.test/ctx-stack pop)))))
|
||||
|
||||
(defmacro deftest [name & body]
|
||||
`(do
|
||||
(defn ~name [] ~@body)
|
||||
(swap! clojure.test/registry conj {:name '~name :fn ~name})
|
||||
(var ~name)))
|
||||
|
||||
(defmacro are [argv expr & data]
|
||||
(let [n (count argv)
|
||||
rows (partition n data)]
|
||||
`(do ~@(map (fn [row]
|
||||
`(let [~@(interleave argv row)]
|
||||
(clojure.test/is ~expr)))
|
||||
rows))))
|
||||
|
||||
;; --- fixtures + run --------------------------------------------------------
|
||||
|
||||
(defn use-fixtures [kind & fns]
|
||||
(cond
|
||||
(= kind :once) (reset! once-fixtures (vec fns))
|
||||
(= kind :each) (reset! each-fixtures (vec fns))))
|
||||
|
||||
(defn- wrap-fixtures [fixtures body-fn]
|
||||
(if (empty? fixtures)
|
||||
(body-fn)
|
||||
((first fixtures) (fn [] (wrap-fixtures (rest fixtures) body-fn)))))
|
||||
|
||||
(defn- run-one [t]
|
||||
(swap! counters update :test inc)
|
||||
(wrap-fixtures @each-fixtures
|
||||
(fn []
|
||||
(try
|
||||
((:fn t))
|
||||
(catch Throwable e
|
||||
(err! (str (:name t) " crashed: " (clojure.core/ex-message e))))))))
|
||||
|
||||
(defn run-registered []
|
||||
(doseq [t @registry] (run-one t))
|
||||
nil)
|
||||
|
||||
(defn run-tests [& _nses]
|
||||
(wrap-fixtures @once-fixtures (fn [] (run-registered)))
|
||||
(let [r @counters]
|
||||
(println)
|
||||
(println (str "Ran " (:test r) " tests. "
|
||||
(:pass r) " assertions passed, "
|
||||
(:fail r) " failures, " (:error r) " errors."))
|
||||
r))
|
||||
|
||||
(defn run-test [& _] nil)
|
||||
(defn test-var [& _] nil)
|
||||
|
|
@ -205,6 +205,8 @@
|
|||
(defn jolt-call [f & args]
|
||||
(cond
|
||||
(or (function? f) (cfunction? f)) (apply f args)
|
||||
# a var is callable as its current value (Clojure vars implement IFn)
|
||||
(var? f) (apply jolt-call (var-get f) args)
|
||||
(shape-rec? f) (core-get f (get args 0) (get args 1))
|
||||
(keyword? f) (core-get (get args 0) f (get args 1))
|
||||
(and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1))
|
||||
|
|
@ -454,12 +456,18 @@
|
|||
(and (struct? to) (nil? (get to :jolt/type)))
|
||||
(let [acc (array)]
|
||||
(each e (pairs to) (array/push acc e))
|
||||
(each item items (array/push acc [(vnth item 0) (vnth item 1)]))
|
||||
# each item is either a [k v] pair OR a map whose entries are merged
|
||||
# (Clojure: (into {} [{:a 1} {:b 2}]) => {:a 1 :b 2})
|
||||
(each item items
|
||||
(if (map-value? item)
|
||||
(each e (map-entries-of item) (array/push acc e))
|
||||
(array/push acc [(vnth item 0) (vnth item 1)])))
|
||||
(bulk-map-from-pairs acc))
|
||||
# Other map-likes (sorted maps, deftype records): fold core-assoc.
|
||||
# Other map-likes (sorted maps, deftype records): fold core-conj (handles
|
||||
# both [k v] pairs and map items).
|
||||
(or (struct? to) (and (table? to) (get to :jolt/deftype)))
|
||||
(do (var result to)
|
||||
(each item items (set result (core-assoc result (vnth item 0) (vnth item 1))))
|
||||
(each item items (set result (core-conj result item)))
|
||||
result)
|
||||
# Accumulate into a native array and bulk-build the pvec ONCE (pv-from-indexed),
|
||||
# instead of an immutable pv-conj per element (each allocating a wrapper +
|
||||
|
|
|
|||
|
|
@ -104,6 +104,8 @@
|
|||
(let [s (src :s) p (src :pos)]
|
||||
(put src :pos (length s))
|
||||
(string/slice s p))
|
||||
# a byte-array / buffer body: bytes already in hand, just stringify
|
||||
(buffer? src) (string src)
|
||||
(string (slurp src))))
|
||||
|
||||
(defn core-spit [path content & opts]
|
||||
|
|
|
|||
|
|
@ -182,6 +182,9 @@
|
|||
(and (struct? v) (= :jolt/inst (v :jolt/type))) (inst->rfc3339 v)
|
||||
# a java.io.File renders as its path (Clojure's File.toString)
|
||||
(and (table? v) (= :jolt/file (get v :jolt/type))) (get v :path)
|
||||
# (str pattern) -> raw regex source (no #"" delimiters), so libraries that
|
||||
# compose patterns via (re-pattern (str p1 ...)) work (Pattern.toString).
|
||||
(and (table? v) (= :jolt/regex (get v :jolt/type))) (get v :source)
|
||||
(= :jolt/namespace (get v :jolt/type)) (ns-display-name v)
|
||||
(and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v)
|
||||
(number? v) (fmt-number v)
|
||||
|
|
|
|||
|
|
@ -124,6 +124,9 @@
|
|||
# supers now lives in the Clojure collection tier (no class hierarchy: #{}).
|
||||
(defn core-class [x]
|
||||
(cond
|
||||
# typed throwables carry their JVM class name (host_net's HTTP/SSL shims):
|
||||
# (class e) -> "java.net.SocketTimeoutException" so (= ClassSym (class e)) holds
|
||||
(and (table? x) (get x :class)) (get x :class)
|
||||
(nil? x) nil (number? x) "java.lang.Number" (string? x) "java.lang.String"
|
||||
(boolean? x) "java.lang.Boolean" (keyword? x) "clojure.lang.Keyword"
|
||||
(function? x) "clojure.lang.IFn" (buffer? x) "[B"
|
||||
|
|
|
|||
|
|
@ -140,6 +140,9 @@
|
|||
[ctx f args]
|
||||
(cond
|
||||
(or (function? f) (cfunction? f)) (apply f args)
|
||||
# a var is callable as its current value (Clojure vars implement IFn) —
|
||||
# e.g. (wrap-request #'core/request) threads the var as the base client
|
||||
(var? f) (jolt-invoke ctx (var-get f) args)
|
||||
(jolt-transient? f) (transient-lookup f (get args 0) (get args 1))
|
||||
# a record shape-rec is callable: IFn impl if it has one, else map-like
|
||||
# field access. A plain (non-record) shape-rec is just field access.
|
||||
|
|
|
|||
|
|
@ -682,6 +682,12 @@
|
|||
false)))
|
||||
# instance?: the overlay macro passes the TYPE NAME quoted (class names don't
|
||||
# evaluate to values on jolt); the value arg arrives evaluated.
|
||||
# Generic hook so an external host-shim library (e.g. jolt-lang/http-client)
|
||||
# can teach instance? about its own shim types without editing core. Each hook
|
||||
# is (fn [class-name val] -> truthy|nil); consulted when no built-in matches.
|
||||
(var instance-check-hooks @[])
|
||||
(ns-intern core "__register-instance-check!"
|
||||
(fn [f] (array/push instance-check-hooks f) nil))
|
||||
(ns-intern core "instance-check"
|
||||
(fn [type-sym val]
|
||||
(if (record-tag val)
|
||||
|
|
@ -756,10 +762,21 @@
|
|||
"clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val))
|
||||
"clojure.lang.IPersistentSet" (set? val)
|
||||
"Object" true
|
||||
false))))
|
||||
# no built-in match — consult library-registered instance? hooks
|
||||
(do (var r false)
|
||||
(each h instance-check-hooks
|
||||
(when (h (type-sym :name) val) (set r true) (break)))
|
||||
r)))))
|
||||
# Reader / expansion as plain fns: read-string parses one form; macroexpand-1
|
||||
# expands a (quoted, already-evaluated) call form once via its macro var.
|
||||
(ns-intern core "read-string" (fn [s] (parse-string s)))
|
||||
# Strip the interpreter's {:jolt/type :jolt/exception :value v} throw envelope.
|
||||
# Compiled catch uses this so a caught value matches what the interpreter binds
|
||||
# (interpreted throw wraps; compiled throw raises raw) — keeps (class e) /
|
||||
# ex-message / catch consistent across the compiled⇄interpreted boundary.
|
||||
(ns-intern core "__unwrap-ex"
|
||||
(fn [e] (if (and (or (table? e) (struct? e)) (= :jolt/exception (get e :jolt/type)))
|
||||
(get e :value) e)))
|
||||
# The *in* reader family's host seams. __stdin-read-line: one line from real
|
||||
# stdin, newline stripped, nil at EOF. __parse-next: one form off a string ->
|
||||
# [form rest-of-string], nil when only whitespace remains. *in*, read-line,
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
|
||||
# Forward declaration for mutual recursion
|
||||
(var read-form nil)
|
||||
(var read-meta nil) # forward decl: read-dispatch (#^) calls it before its defn below
|
||||
|
||||
# Source-position tracking for the success checker (jolt-fqy). When enabled, the
|
||||
# reader records each LIST form's absolute start offset (lists are the forms that
|
||||
|
|
@ -571,6 +572,7 @@
|
|||
(= c 95) (let [[_ new-pos] (read-form s (+ pos 2))] # #_
|
||||
[{:jolt/type :jolt/skip} new-pos])
|
||||
(= c 39) (read-var-quote s pos) # #'
|
||||
(= c 94) (read-meta s (+ pos 1)) # #^ — deprecated metadata reader macro (= ^)
|
||||
(= c 34) (read-regex s pos) # #"regex
|
||||
(= c 35) # ## symbolic value: ##Inf ##-Inf ##NaN
|
||||
(let [end (read-symbol-name s (+ pos 2) (+ pos 2))
|
||||
|
|
@ -622,7 +624,7 @@
|
|||
(string? meta-form) {:tag meta-form}
|
||||
nil))
|
||||
|
||||
(defn read-meta [s pos]
|
||||
(set read-meta (fn read-meta [s pos]
|
||||
# pos is at ^
|
||||
(let [[meta-form new-pos] (read-form s (+ pos 1))
|
||||
[form new-pos2] (read-form s new-pos)
|
||||
|
|
@ -636,7 +638,7 @@
|
|||
# Non-symbol targets (collections etc.) keep a runtime with-meta form. Use the
|
||||
# NORMALIZED metadata map (:kw -> {:kw true}, tag -> {:tag …}); a map-literal
|
||||
# meta-form (m is nil) is already a map, so pass it through.
|
||||
[(array (sym "with-meta") form (if m m meta-form)) new-pos2])))
|
||||
[(array (sym "with-meta") form (if m m meta-form)) new-pos2]))))
|
||||
|
||||
(defn read-until-newline [s pos]
|
||||
(if (or (>= pos (length s)) (= (s pos) 10))
|
||||
|
|
|
|||
29
test/spec/clojure-interop-fixes-spec.janet
Normal file
29
test/spec/clojure-interop-fixes-spec.janet
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
# Specification: Clojure-compat fixes that landed with HTTP-client support
|
||||
# (jolt-lang/http-client). All are general language behaviours, exercised here
|
||||
# across interpret + compile modes by the harness.
|
||||
(use ../support/harness)
|
||||
|
||||
(defspec "interop-fixes / deprecated #^ metadata reader"
|
||||
["#^ type hint on a param" "\"x\""
|
||||
"(do (defn f1 [#^String s] s) (f1 \"x\"))"]
|
||||
["#^\"[B\" array hint" "[1 2]"
|
||||
"(do (defn f2 [#^\"[B\" b] b) (f2 [1 2]))"]
|
||||
["#^ is equivalent to ^" "true"
|
||||
"(= (meta (with-meta [] {:tag (quote String)})) {:tag (quote String)})"])
|
||||
|
||||
(defspec "interop-fixes / (str pattern) yields raw source"
|
||||
["str of a regex" "\"abc\"" "(str #\"abc\")"]
|
||||
["compose patterns via str" "true"
|
||||
"(boolean (re-matches (re-pattern (str #\"<\" \"(.*)\" \">\")) \"<hi>\"))"])
|
||||
|
||||
(defspec "interop-fixes / into onto a map"
|
||||
["merges map items" "true" "(= {:a 1 :b 2} (into {} [{:a 1} {:b 2}]))"]
|
||||
["accepts [k v] pairs" "true" "(= {:a 1} (into {} [[:a 1]]))"]
|
||||
["map item onto empty {}" "true" "(= {:x 1} (into {} (list {:x 1})))"]
|
||||
["conj a map onto {}" "true" "(= {:a 1} (conj {} {:a 1}))"])
|
||||
|
||||
(defspec "interop-fixes / a var is callable as its value"
|
||||
["call a var directly" "42"
|
||||
"(do (def vf (fn [x] (inc x))) ((var vf) 41))"]
|
||||
["var bound as a client fn" "\"ok\""
|
||||
"(do (def base (fn [_] \"ok\")) (def mw (fn [client] (fn [req] (client req)))) ((mw (var base)) {}))"])
|
||||
Loading…
Add table
Add a link
Reference in a new issue