simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix: try/catch/finally correctness + current-ns restore (jolt-96m + try bug)

Browse source 
Two try bugs that blocked migratus's migrate (run/table-exists? are multi-body
try/catch/finally with janet-interop jdbc calls, which punt to the interpreter):
- The interpreter's try took only form 1 as the body, dropping later body forms
  before the clauses, and did not run finally on the success path when a catch
  was present. Rewritten to collect every body form before the first
  catch/finally and to always run finally (via defer, so it fires even if a
  catch body throws).
- current-ns leaked after a caught throw from an INTERPRETED fn (it sets ns to
  its defining ns and can't restore on unwind). The interpreter's try now
  restores; the compiled try (emit-try) snapshots the ns at entry and resets it
  in the catch via new __current-ns/__set-current-ns! core fns. Statement
  values also get a :close key so with-open can close them.

With these, migratus migrate/rollback round-trips on jolt (verified end to end
against sqlite). Conformance 335/335 x3, full gate green.
This commit is contained in:
Yogthos 2026-06-13 17:16:40 -04:00
parent eec3edf632
commit 4f59958d92
3 changed files with 79 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/jolt/backend.janet
View file

@ -182,11 +182,25 @@
(tuple/slice (array/concat @[(symbol (node :recur-name))]
(map |(emit ctx $) (vview (node :args))))))
# Var-cell read of a clojure.core fn, as ((in 'cell :root) args...) — the same
# live-root call the :var emit uses, for the ns get/set helpers below.
(defn- core-fn-call [ctx nm & args]
(def cell (cell-for ctx "clojure.core" nm))
(tuple (tuple 'in (tuple 'quote cell) :root) ;args))
(defn- emit-try [ctx node]
(def core
(if (node :catch-sym)
['try (emit ctx (node :body))
[[(symbol (node :catch-sym))] (emit ctx (node :catch-body))]]
# Restore current-ns in the catch: a caught throw from an INTERPRETED fn
# 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 (core-fn-call ctx "__current-ns")]
['try (emit ctx (node :body))
[[(symbol (node :catch-sym))]
['do (core-fn-call ctx "__set-current-ns!" saved)
(emit ctx (node :catch-body))]]]])
(emit ctx (node :body))))
(if (node :finally)
['defer (emit ctx (node :finally)) core]

4
src/jolt/core.janet
View file

@ -1747,7 +1747,9 @@
(defn core-jdbc-conn-raw [x]
(if (and (table? x) (= :jolt/jdbc-conn (get x :jolt/type))) (get x :raw) x))
(defn core-jdbc-make-stmt [w]
@{:jolt/type :jolt/jdbc-stmt :exec (get w :exec) :cmds @[]})
# :close lets with-open close the statement (core-close-resource calls :close);
# nothing to release — executeBatch already ran the commands.
@{:jolt/type :jolt/jdbc-stmt :exec (get w :exec) :cmds @[] :close (fn [] nil)})
# java.io.File model (jolt-hjw). io/file and (File. …) build a tagged :jolt/file
# value so (instance? File x) works and migratus's File-vs-jar branching takes

106
src/jolt/evaluator.janet
View file

@ -1345,6 +1345,12 @@
expand to calls of these)."
[ctx]
(def core (ctx-find-ns ctx "clojure.core"))
# current-ns get/set for compiled code (emit-try restores the ns on a caught
# throw — an interpreted fn that throws leaves ctx-current-ns set to its
# defining ns, since it can't restore on unwind; the interpreted try already
# repairs this, the compiled try did not, leaking the ns past a catch).
(ns-intern core "__current-ns" (fn [] (ctx-current-ns ctx)))
(ns-intern core "__set-current-ns!" (fn [ns-sym] (ctx-set-current-ns ctx ns-sym) nil))
(ns-intern core "protocol-dispatch"
(fn [proto-name method-name obj rest-args]
(protocol-dispatch-impl ctx proto-name method-name obj rest-args)))
@ -2098,9 +2104,20 @@
(apply loop-fn args))))
"throw" (let [val (eval-form ctx bindings (in form 1))]
(error {:jolt/type :jolt/exception :value val}))
"try" (let [body-form (in form 1)
clauses (tuple/slice form 2)
n (length clauses)
"try" (let [# The body is EVERY form between `try` and the first catch/finally
# clause (not just form 1 — a multi-form body before the clauses,
# e.g. (try (foo) (bar) (catch …)), dropped all but the first).
forms (tuple/slice form 1)
clause? (fn [c]
(and (array? c) (> (length c) 0)
(struct? (first c)) (= :symbol ((first c) :jolt/type))
(or (= "catch" ((first c) :name))
(= "finally" ((first c) :name)))))
split (do (var k 0)
(while (and (< k (length forms)) (not (clause? (in forms k)))) (++ k))
k)
body-forms (tuple/slice forms 0 split)
clauses (tuple/slice forms split)
# current-ns is dynamic state. The interpreter rebinds it to a
# fn's defining ns while that fn runs and restores it on normal
# return, but a fn that THROWS unwinds past its own restore — so
@ -2111,52 +2128,49 @@
(var catch-sym nil)
(var catch-body nil)
(var finally-body nil)
(var i 0)
(while (< i n)
(let [clause (in clauses i)]
(if (and (array? clause) (> (length clause) 0))
(let [head (first clause)]
(if (and (struct? head) (= :symbol (head :jolt/type)))
(match (head :name)
"catch" (do
(set catch-sym (in clause 2))
(set catch-body (tuple/slice clause 3)))
"finally" (set finally-body (tuple/slice clause 1)))))))
(++ i))
(defn run-finally [f]
(when f
(each fb f (eval-form ctx bindings fb))))
(if catch-sym
(try
(eval-form ctx bindings body-form)
([err]
(ctx-set-current-ns ctx try-ns)
(var new-bindings @{})
(table/setproto new-bindings bindings)
# 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)))
(run-finally finally-body)
result))
(if finally-body
(each clause clauses
(when (and (array? clause) (> (length clause) 0))
(let [head (first clause)]
(when (and (struct? head) (= :symbol (head :jolt/type)))
(match (head :name)
"catch" (do
(set catch-sym (in clause 2))
(set catch-body (tuple/slice clause 3)))
"finally" (set finally-body (tuple/slice clause 1)))))))
(defn eval-body []
(var result nil)
(each bf body-forms (set result (eval-form ctx bindings bf)))
result)
(defn run-finally []
(when finally-body
(each fb finally-body (eval-form ctx bindings fb))))
(defn run-protected []
(if catch-sym
(try
(do
(def result (eval-form ctx bindings body-form))
(run-finally finally-body)
result)
(eval-body)
([err]
(ctx-set-current-ns ctx try-ns)
(run-finally finally-body)
(error err)))
(eval-form ctx bindings body-form))))
(var new-bindings @{})
(table/setproto new-bindings bindings)
# 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)))
result))
# no catch: restore the ns on an unwinding error, then re-raise
(try (eval-body) ([err] (ctx-set-current-ns ctx try-ns) (error err)))))
# finally ALWAYS runs (success, caught error, or rethrow) — defer so it
# fires even if a catch body throws. Without a finally, just run.
(if finally-body
(defer (run-finally) (run-protected))
(run-protected)))
"set!" (let [target (in form 1)
val (eval-form ctx bindings (in form 2))]
# Handle (set! (.-field obj) val) — .-field shorthand as a list