From d46f5e59c611ea1a59d28c37dad7c86223aa8767 Mon Sep 17 00:00:00 2001 From: Miguel de Benito Delgado Date: Tue, 22 Sep 2026 16:47:46 +0200 Subject: [PATCH] :construction: WIP Step 10, defcase body validation, docs --- .clj-kondo/config.edn | 6 ++ .../test/benches/render_wasm/scenes/core.clj | 10 +-- .../test/benches/render_wasm/scenes/core.cljs | 72 +++++++++++++++++-- .../benches/contracts_test.cljs | 61 ++++++++++++++-- 4 files changed, 133 insertions(+), 16 deletions(-) diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index ed58d74207..bf284f7073 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -26,6 +26,12 @@ app.common.i18n/tr hooks.i18n/tr-dynamic }} + ;; Avoid false positives in defcases which use helpers available only in the + ;; browser + :config-in-call + {benches.render-wasm.scenes.core/defcase + {:linters {:unresolved-symbol {:level :off}}}} + :output {:exclude-files ["data_readers.clj" diff --git a/frontend/test/benches/render_wasm/scenes/core.clj b/frontend/test/benches/render_wasm/scenes/core.clj index 9c56b41f16..924c695ac7 100644 --- a/frontend/test/benches/render_wasm/scenes/core.clj +++ b/frontend/test/benches/render_wasm/scenes/core.clj @@ -24,9 +24,10 @@ (defmacro defcase "Registers a case for `scene` and returns its id. - The optional body is the function run by the browser for the case. It sees - the injected runtime as `rtx`. Case collection strips the body before - handing descriptors to the runner." + The optional body threads the injected runtime as `rtx` and becomes the + case's browser-side run function. The quoted body source travels with the + registration for validation; case collection strips the body and the + source before handing descriptors to the runner." [id scene opts & body] (if (seq body) `(benches.render-wasm.scenes.core/register-case! @@ -34,6 +35,7 @@ :id ~id :scene ~scene :ns ~(str *ns*) - :run! (fn [~'rtx] ~@body))) + :run! (fn [~'rtx] ~@body) + :body-source '~body)) `(benches.render-wasm.scenes.core/register-case! (assoc ~opts :id ~id :scene ~scene :ns ~(str *ns*))))) diff --git a/frontend/test/benches/render_wasm/scenes/core.cljs b/frontend/test/benches/render_wasm/scenes/core.cljs index 39918a83c4..0f0027248e 100644 --- a/frontend/test/benches/render_wasm/scenes/core.cljs +++ b/frontend/test/benches/render_wasm/scenes/core.cljs @@ -23,6 +23,30 @@ [app.common.schema :as sm] [clojure.string :as str])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Runtime contract +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; rtx is the case execution context. The driver builds one map per attempt, +;; calls the case body with it, and reads it back at completion: +;; +;; :case the collected case descriptor (id, scene, params, view, +;; context, completion, batch-size, operation) +;; :scene the built scene snapshot {:objects ... :refs ...} +;; :module the WASM module handle, bound by the driver after init +;; :slices recorded render slices; helpers conj here +;; :metrics recorded phase timings +;; :now zero-arg clock fn +;; :frame zero-arg promise of the next rAF timestamp +;; :sleep (fn [ms] ...) promise +;; :check zero-arg guard covering cancellation, deadline, context loss +;; +;; Ops take rtx first and return it, or a promise of it. Case bodies thread +;; rtx with `->`; the body's value is the rtx the driver collects. The +;; driver, the clock/scheduling helpers and the op vocabulary arrive with +;; tickets 05/06/14; this namespace fixes the binding name, the single +;; threaded value, and the body shape checked below. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Schemas ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -54,7 +78,8 @@ [:batch-size {:optional true} [:int {:min 1}]] [:operation {:optional true} [:map]] [:preparation {:optional true} [:map]] - [:run! {:optional true} fn?]]) + [:run! {:optional true} fn?] + [:body-source {:optional true} [:fn seq?]]]) (def schema:collected-case [:map {:closed true} @@ -102,10 +127,47 @@ (update :scene-order conj id)))))) id) +(defn- thread-form? + [form] + (and (seq? form) + (contains? '#{-> clojure.core/->} (first form)) + (= 'rtx (second form)))) + +(defn- valid-tail? + [form] + (cond + (thread-form? form) + true + + (and (seq? form) (contains? '#{do let} (first form))) + (valid-tail? (last form)) + + :else + false)) + +(defn check-body-source! + "Validates a defcase body source and returns it unchanged. Every value + the body can return threads the injected runtime: a `(-> rtx ...)` + pipeline, optionally preceded by setup forms or wrapped in `let`/`do`. + Anything else throws ::invalid-case. The checker covers shape only; + review and fake-runtime unit tests cover sense." + [id body-source] + (when-not (and (seq body-source) (valid-tail? (last body-source))) + (throw (ex-info (str "defcase " id " threads the injected runtime: " + "its value is a (-> rtx ...) pipeline, " + "optionally wrapped in let/do. Got: " + (pr-str body-source)) + {:type ::invalid-case + :id id}))) + body-source) + (defn register-case! "Adds `bench-case` to the registry with the same replace/reject semantics - as register-scene!." - [{:keys [id ns] :as bench-case}] + as register-scene!. A declared body source is validated here, at load + time, so a malformed pipeline fails before any browser work." + [{:keys [id ns body-source] :as bench-case}] + (when (some? body-source) + (check-body-source! id body-source)) (let [existing (get-in @registry [:cases id])] (when (and (some? existing) (not= ns (:ns existing))) (throw (ex-info (str "duplicate case id: " id) @@ -300,8 +362,8 @@ false)) (defn project-case - "Plain-data projection of a registered case: internal keys (`:ns`, `:run!`) - stripped, collection defaults applied." + "Plain-data projection of a registered case: internal keys (`:ns`, `:run!`, + `:body-source`) stripped, collection defaults applied." [bench-case] (-> bench-case (select-keys [:id :scene :params :view :context :completion :batch-size diff --git a/frontend/test/frontend_tests/benches/contracts_test.cljs b/frontend/test/frontend_tests/benches/contracts_test.cljs index e700c580d3..d90b65ed68 100644 --- a/frontend/test/frontend_tests/benches/contracts_test.cljs +++ b/frontend/test/frontend_tests/benches/contracts_test.cljs @@ -13,6 +13,14 @@ (defrecord Point [x y]) +(def ^:private body-calls + (atom [])) + +(defn- touch! + [rtx] + (swap! body-calls conj :touched) + rtx) + (core/defscene :contracts-scene {:version 1 :description "Synthetic scene for contract tests" @@ -24,8 +32,7 @@ {:params {} :view {:scale 1 :x 0 :y 0} :context :fresh} - (throw (ex-info "run body must not execute during collection" - {:type ::boom}))) + (-> rtx (touch!))) (defn- failure-data [f] @@ -347,11 +354,51 @@ :filter "missing"})))))) (t/deftest defcase-body-is-stored-and-stripped - (let [entry (core/registered-case :contracts-scene/case)] - (t/is (= "frontend-tests.benches.contracts-test" (:ns entry))) - (t/is (fn? (:run! entry))) - (t/is (= ::boom (:type (failure-data #((:run! entry) :runtime)))))) + (reset! body-calls []) (let [collected (cases/collect-cases {:master-seed 42 :filter "contracts-scene/"})] (t/is (= [:contracts-scene/case] (mapv :id collected))) (t/is (not (contains? (first collected) :run!))) - (t/is (core/serializable? (first collected))))) + (t/is (not (contains? (first collected) :body-source))) + (t/is (core/serializable? (first collected)))) + (t/is (empty? @body-calls)) + (let [entry (core/registered-case :contracts-scene/case)] + (t/is (= "frontend-tests.benches.contracts-test" (:ns entry))) + (t/is (fn? (:run! entry))) + (t/is (= :runtime ((:run! entry) :runtime))) + (t/is (= [:touched] @body-calls)))) + +(t/deftest check-body-source-accepts-pipelines + (doseq [source ['((-> rtx (pan! x))) + '((let [a 1] (-> rtx (pan! a)))) + '((do (log! 1) (-> rtx (pan!)))) + '((comment "setup") (-> rtx (pan!))) + '((clojure.core/-> rtx (pan!)))]] + (t/is (= source (core/check-body-source! :case source)) (pr-str source)))) + +(t/deftest check-body-source-rejects-other-shapes + (doseq [source ['((pan! x)) + '((-> other (pan!))) + '((->> rtx (pan!))) + '((if c (-> rtx a) (-> rtx b))) + '() + '((do)) + '((let [x 1]))]] + (t/is (= ::core/invalid-case + (:type (failure-data #(core/check-body-source! :case source)))) + (pr-str source)))) + +(t/deftest register-case-rejects-invalid-body-source + (try + (t/is (= ::core/invalid-case + (:type (failure-data + #(core/register-case! {:id :contracts-badbody/case + :scene :contracts-scene + :ns "contracts-test" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh + :run! (fn [rtx] rtx) + :body-source '((pan! x))}))))) + (t/is (nil? (core/registered-case :contracts-badbody/case))) + (finally + (core/unregister-case! :contracts-badbody/case))))