github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

🚧 WIP Step 10, defcase body validation, docs

Browse Source
This commit is contained in:
Miguel de Benito Delgado 2026-09-22 16:47:46 +02:00
parent 8d04530e07
commit d46f5e59c6
4 changed files with 133 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.clj-kondo/config.edn
View File

@ -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"

10
frontend/test/benches/render_wasm/scenes/core.clj
View File

@ -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*)))))

72
frontend/test/benches/render_wasm/scenes/core.cljs
View File

@ -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

61
frontend/test/frontend_tests/benches/contracts_test.cljs
View File

@ -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))))