From 555cd7631ed0199681e312677b7c712b9e3012c6 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 5 Jun 2026 01:23:52 -0400 Subject: [PATCH] fix: catch binds unwrapped thrown value; var-set targets thread binding Close jolt-dd5. - catch now binds the originally-thrown value (unwrapping the :jolt/exception envelope), so (catch ... e (throw e)) rethrows the same exception instead of nesting another envelope, and (catch ... e e) on (throw 42) yields 42. - var-set updates the innermost thread-binding frame for the var (replacing the stack slot) when the var is dynamically bound, matching Clojure; it falls back to the root otherwise. Restored spec cases: exceptions rethrow + catch-binds-thrown-value, namespaces var-set-in-binding. conformance 218/218, jpm test green. --- src/jolt/evaluator.janet | 9 ++++++++- src/jolt/types.janet | 14 ++++++++++++-- test/spec/exceptions-spec.janet | 6 +++++- test/spec/namespaces-spec.janet | 3 ++- 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index e3fe5d1..2a7a958 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -857,7 +857,14 @@ ([err] (var new-bindings @{}) (table/setproto new-bindings bindings) - (put new-bindings (catch-sym :name) err) + # bind the originally-thrown value (unwrap the :jolt/exception + # envelope) so (catch ... e (throw e)) rethrows the same value + # rather than nesting another envelope + (def caught + (if (and (or (table? err) (struct? err)) (= :jolt/exception (get err :jolt/type))) + (get err :value) + err)) + (put new-bindings (catch-sym :name) caught) (var result nil) (each cb catch-body (set result (eval-form ctx new-bindings cb))) diff --git a/src/jolt/types.janet b/src/jolt/types.janet index 5abcc51..cee32ae 100644 --- a/src/jolt/types.janet +++ b/src/jolt/types.janet @@ -120,9 +120,19 @@ (if (not (nil? result)) result (v :root))) (defn var-set - "Set the root binding of a var." + "Set a var's value. If the var has a thread-local binding on the stack, update + the innermost frame that binds it (matching Clojure, where var-set targets the + current binding); otherwise set the root." [v val] - (put v :root val)) + (var i (dec (length binding-stack))) + (var done false) + (while (and (not done) (>= i 0)) + (let [frame (in binding-stack i)] + (if (not (nil? (get frame v))) + (do (put binding-stack i (merge frame {v val})) (set done true)) + (-- i)))) + (unless done (put v :root val)) + val) (defn alter-var-root "Atomically alter the root binding of v by applying f to current value plus args." diff --git a/test/spec/exceptions-spec.janet b/test/spec/exceptions-spec.janet index 77cd3bf..4b0709f 100644 --- a/test/spec/exceptions-spec.janet +++ b/test/spec/exceptions-spec.janet @@ -25,4 +25,8 @@ ["ex-cause" "true" "(let [c (ex-info \"root\" {})] (= c (ex-cause (ex-info \"outer\" {} c))))"] ["propagates to outer" "\"inner\"" - "(try (try (throw (ex-info \"inner\" {})) (finally nil)) (catch :default e (ex-message e)))"]) + "(try (try (throw (ex-info \"inner\" {})) (finally nil)) (catch :default e (ex-message e)))"] + ["catch binds thrown value" "42" + "(try (throw 42) (catch :default e e))"] + ["rethrow preserves ex" "\"inner\"" + "(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"]) diff --git a/test/spec/namespaces-spec.janet b/test/spec/namespaces-spec.janet index 18d2080..951d09f 100644 --- a/test/spec/namespaces-spec.janet +++ b/test/spec/namespaces-spec.janet @@ -11,7 +11,8 @@ ["defn defines fn" "3" "(do (defn f [x] (inc x)) (f 2))"] ["def with docstring" "7" "(do (def d \"a doc\" 7) d)"] ["dynamic var binding" "2" "(do (def ^:dynamic *x* 1) (binding [*x* 2] *x*))"] - ["binding restores" "1" "(do (def ^:dynamic *y* 1) (binding [*y* 9] nil) *y*)"]) + ["binding restores" "1" "(do (def ^:dynamic *y* 1) (binding [*y* 9] nil) *y*)"] + ["var-set in binding" "5" "(do (def ^:dynamic *z* 1) (binding [*z* 0] (var-set (var *z*) 5) *z*))"]) (defspec "namespaces / ns operations" ["in-ns switches" "true" "(do (in-ns 'my.ns) (symbol? 'x))"]