diff --git a/frontend/test/benches/render_wasm/cases.cljs b/frontend/test/benches/render_wasm/cases.cljs new file mode 100644 index 0000000000..6c15565911 --- /dev/null +++ b/frontend/test/benches/render_wasm/cases.cljs @@ -0,0 +1,135 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns benches.render-wasm.cases + "Case collection for the renderer benchmarks. + + Loading this namespace registers the scene namespaces listed here. That + require list is the discovery manifest. Nothing here should import browser + or renderer code, so the Node runner and offline reports load scenes without + renderer side effects. + + Usage: + + (cases/collect-cases {:master-seed 42}) + ;; => + [{:id :rects/load + :scene :rects + :scene-version 1 + :scene-description \"Seeded rectangles with translucent fills and centered strokes\" + :scene-seed 2602546180 + :params {:count 1000 :width 1920 :height 1080 :min-size 20 :max-size 100} + :view {:scale 1 :x 0 :y 0} + :context :fresh + :completion :render-full + :batch-size 1 + :preparation {:version 1}} + {:id :rects/pan ...} + {:id :rects/zoom ...}]" + (:require + [app.common.schema :as sm] + [benches.render-wasm.scenes.core :as core] + benches.render-wasm.scenes.rects + [clojure.string :as str])) + +(defn- check-master-seed! + "Collection requires an integer master seed in [0, 2^32)." + [seed] + (when-not (and (integer? seed) (<= 0 seed) (< seed 4294967296)) + (throw (ex-info "case collection requires an integer master seed in [0, 2^32)" + {:type ::invalid-master-seed + :seed seed})))) + +(defn- as-invalid-case! + "Runs `thunk`, translating core case-validation failures into this + namespace's ::invalid-case so `collect-cases` has a single error + contract. Registry mechanics (::duplicate-*, ::unknown-scene) and scene + declarations (::invalid-scene) keep their own types." + [thunk] + (try + (thunk) + (catch :default cause + (let [data (ex-data cause)] + (if (contains? #{::core/invalid-case ::core/non-serializable-case} (:type data)) + (throw (ex-info (ex-message cause) + (assoc data :type ::invalid-case) + cause)) + (throw cause)))))) + +(defn- check-params! + "Validates case params against the scene's closed schema." + [case-id scene-id schema params] + (when-not (sm/validate schema params) + (throw (ex-info (str "invalid params for case " case-id) + {:type ::invalid-case + :id case-id + :scene scene-id + ::sm/explain (sm/explain schema params)})))) + +(defn- validate-case! + "Validates a registered case entry against its scene: unknown scene, + case-namespace mismatch, declaration schema and closed params." + [{:keys [id scene params] :as registered} scene-by-id] + (let [entry (get scene-by-id scene)] + (when (nil? entry) + (throw (ex-info (str "case " id " names an unknown scene: " scene) + {:type ::unknown-scene + :id id + :scene scene}))) + (when-not (= (name scene) (namespace id)) + (throw (ex-info (str "case id " id " is not namespaced by its scene: " scene) + {:type ::invalid-case + :id id + :scene scene}))) + (as-invalid-case! #(core/check-registered-case! registered)) + (check-params! id scene (:params-schema entry) params) + registered)) + +(defn- describe-case + "Projects a validated case to its collected descriptor: scene + version/description/seed attached, internal keys stripped, plain data + checked." + [master-seed registered scene-entry] + (let [projected (-> (core/project-case registered) + (assoc :scene-version (:version scene-entry) + :scene-description (:description scene-entry) + :scene-seed (core/derive-seed master-seed + (:scene registered) + (:params registered))))] + (as-invalid-case! #(core/check-collected-case! projected)))) + +(defn scene-ids + "Registered scene ids in declaration order." + [] + (mapv :id (core/scenes))) + +(defn case-ids + "Registered case ids in declaration order." + [] + (mapv :id (core/cases))) + +(defn collect-cases + "Selected benchmark cases as plain data. + + Validates scenes, cases and parameters before any browser work. `:filter` + is a substring match on the case id; an empty selection throws ::no-cases." + [{:keys [master-seed] :as options}] + (check-master-seed! master-seed) + (let [pattern (:filter options) + scene-by-id (into {} (map (juxt :id identity)) (core/scenes))] + (doseq [scene (core/scenes)] + (core/check-registered-scene! scene)) + (let [selected (->> (core/cases) + (map #(validate-case! % scene-by-id)) + (filter (fn [registered] + (or (str/blank? pattern) + (str/includes? (str (:id registered)) pattern)))) + (mapv #(describe-case master-seed % (get scene-by-id (:scene %)))))] + (when (empty? selected) + (throw (ex-info "no benchmark cases match the selection" + {:type ::no-cases + :filter pattern}))) + selected))) diff --git a/frontend/test/benches/render_wasm/scenes/core.clj b/frontend/test/benches/render_wasm/scenes/core.clj new file mode 100644 index 0000000000..9c56b41f16 --- /dev/null +++ b/frontend/test/benches/render_wasm/scenes/core.clj @@ -0,0 +1,39 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns benches.render-wasm.scenes.core + "Registration macros for renderer benchmark scenes and cases. + + The macros expand to calls to `register-scene!`/`register-case!` in + `core.cljs`. Registration is done there so it can be inspected and tested.") + +(defmacro defscene + "Registers a scene and returns its id. + + - `id` (keyword) + - `opts` (`schema:scene`): maps `:version`, `:description` and + `:params-schema`. + - `build` resolves to a one-argument function of the scene parameters." + [id opts build] + `(benches.render-wasm.scenes.core/register-scene! + (assoc ~opts :id ~id :ns ~(str *ns*) :build ~build))) + +(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." + [id scene opts & body] + (if (seq body) + `(benches.render-wasm.scenes.core/register-case! + (assoc ~opts + :id ~id + :scene ~scene + :ns ~(str *ns*) + :run! (fn [~'rtx] ~@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 new file mode 100644 index 0000000000..39918a83c4 --- /dev/null +++ b/frontend/test/benches/render_wasm/scenes/core.cljs @@ -0,0 +1,327 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns benches.render-wasm.scenes.core + "Registry and contract for renderer benchmark scenes and cases. + + Scene namespaces register themselves at load time through the `defscene` + and `defcase` macros in `core.clj`. We don't import browser or renderer + code here. + + - A scene declares an id, a version, a human description, a closed + parameters schema and a one-argument build function. + - A case declares an id namespaced by its scene, the scene, base parameters, + a view, a context policy, a completion mode and an optional operation + identity and run function. + + Collection validates every declaration, derives each scene seed and + returns plain data" + (:require + [app.common.schema :as sm] + [clojure.string :as str])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Schemas +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def schema:view + [:map {:closed true} + [:scale [:and number? pos?]] + [:x number?] + [:y number?]]) + +(def schema:scene + [:map {:closed true} + [:id simple-keyword?] + [:ns string?] + [:version [:int {:min 1}]] + [:description string?] + [:params-schema vector?] + [:build fn?]]) + +(def schema:registered-case + [:map {:closed true} + [:id qualified-keyword?] + [:scene simple-keyword?] + [:ns string?] + [:params [:map]] + [:view schema:view] + [:context [:enum :fresh :reuse]] + [:completion {:optional true} [:enum :call :await :render-full]] + [:batch-size {:optional true} [:int {:min 1}]] + [:operation {:optional true} [:map]] + [:preparation {:optional true} [:map]] + [:run! {:optional true} fn?]]) + +(def schema:collected-case + [:map {:closed true} + [:id qualified-keyword?] + [:scene simple-keyword?] + [:scene-version [:int {:min 1}]] + [:scene-description string?] + [:scene-seed [:int {:min 0 :max 4294967295}]] + [:params [:map]] + [:view schema:view] + [:context [:enum :fresh :reuse]] + [:completion [:enum :call :await :render-full]] + [:batch-size [:int {:min 1}]] + [:preparation [:map]] + [:operation {:optional true} [:map]]]) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Registry +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defonce registry + (atom {:scenes {} + :scene-order [] + :cases {} + :case-order []})) + +(defn register-scene! + "Adds `scene` to the registry. Re-registering the same id from the same + namespace replaces the entry, so that namespace reload work. + The same id from another namespace throws ::duplicate-scene." + [{:keys [id ns] :as scene}] + (let [existing (get-in @registry [:scenes id])] + (when (and (some? existing) (not= ns (:ns existing))) + (throw (ex-info (str "duplicate scene id: " id) + {:type ::duplicate-scene + :id id + :ns ns + :existing-ns (:ns existing)}))) + (swap! registry + (fn [reg] + (if (contains? (:scenes reg) id) + (assoc-in reg [:scenes id] scene) + (-> reg + (assoc-in [:scenes id] scene) + (update :scene-order conj id)))))) + id) + +(defn register-case! + "Adds `bench-case` to the registry with the same replace/reject semantics + as register-scene!." + [{:keys [id ns] :as bench-case}] + (let [existing (get-in @registry [:cases id])] + (when (and (some? existing) (not= ns (:ns existing))) + (throw (ex-info (str "duplicate case id: " id) + {:type ::duplicate-case + :id id + :ns ns + :existing-ns (:ns existing)}))) + (swap! registry + (fn [reg] + (if (contains? (:cases reg) id) + (assoc-in reg [:cases id] bench-case) + (-> reg + (assoc-in [:cases id] bench-case) + (update :case-order conj id)))))) + id) + +(defn unregister-scene! + "Removes a scene registration. Tests use it to clean up synthetic scenes." + [id] + (swap! registry + (fn [reg] + (-> reg + (update :scenes dissoc id) + (update :scene-order #(vec (remove #{id} %)))))) + id) + +(defn unregister-case! + "Removes a case registration. Tests use it to clean up synthetic cases." + [id] + (swap! registry + (fn [reg] + (-> reg + (update :cases dissoc id) + (update :case-order #(vec (remove #{id} %)))))) + id) + +(defn scenes + "Registered scenes in declaration order." + [] + (mapv (:scenes @registry) (:scene-order @registry))) + +(defn cases + "Registered cases in declaration order." + [] + (mapv (:cases @registry) (:case-order @registry))) + +(defn registered-scene + "Full registered entry for a scene id." + [id] + (get-in @registry [:scenes id])) + +(defn registered-case + "Full registered entry for a case id, including the browser-side run + function when the case declares one. The browser bridge resolves + executions through this namespace; the Node runner only reads collected + descriptors." + [id] + (get-in @registry [:cases id])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Schema helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- check-params-schema! + "Parses the scene's params schema with Penpot's registry, so a malformed + schema fails here with a typed error instead of raw invalid-schema + halfway through collection." + [{:keys [id params-schema]}] + (try + (sm/schema params-schema) + (catch :default cause + (throw (ex-info (str "invalid params schema for scene " id) + {:type ::invalid-scene + :id id} + cause))))) + +(defn check-registered-scene! + "Validates a scene declaration and returns it unchanged." + [scene] + (check-params-schema! scene) + (when-not (sm/validate schema:scene scene) + (throw (ex-info (str "invalid scene declaration: " (:id scene)) + {:type ::invalid-scene + :id (:id scene) + ::sm/explain (sm/explain schema:scene scene)}))) + scene) + +(defn check-registered-case! + "Validates a registered case declaration and returns it unchanged." + [bench-case] + (when-not (sm/validate schema:registered-case bench-case) + (throw (ex-info (str "invalid case declaration: " (:id bench-case)) + {:type ::invalid-case + :id (:id bench-case) + ::sm/explain (sm/explain schema:registered-case bench-case)}))) + bench-case) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Seed derivation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- check-param-keys! + "Rejects params keys that `canonical-params` cannot tell apart: only + simple keywords render distinctly by name." + [scene-id params] + (letfn [(check [value path] + (cond + (map? value) + (doseq [[k v] value] + (when-not (simple-keyword? k) + (throw (ex-info (str "seed identity requires simple keyword keys at " path) + {:type ::invalid-params + :scene scene-id + :path path + :key k}))) + (check v (str path "/" (name k)))) + + (vector? value) + (dorun (map-indexed (fn [index v] (check v (str path "[" index "]"))) value))))] + (check params ""))) + +(defn- canonical-params + "Stable textual identity of a params map: keys render sorted by name, + vectors keep their order, nested values render the same way. Map key + order is an accident of construction, so sorting keeps the identity on + the parameters themselves: equal parameters give the same seed whatever + their literal order. Keys render by name, so params maps use simple + keyword keys; derive-seed rejects anything else." + [params] + (letfn [(render [value] + (cond + (map? value) + (str "{" + (str/join "," + (map (fn [[k v]] (str (name k) ":" (render v))) + (sort-by (comp name key) value))) + "}") + + (vector? value) + (str "[" (str/join "," (map render value)) "]") + + :else + (pr-str value)))] + (render params))) + +(defn derive-seed + "FNV-1a 32-bit keyed hash of a case's parameter identity. + + Fowler-Noll-Vo, 32-bit, offset basis 2166136261, prime 16777619, hashed + over `\\0/`. A keyed hash, not + the scene PRNG: the scene's mulberry32 generator is seeded with the + result, and a sequential draw cannot substitute because it would couple + cases through collection order. Keyed by scene and params only, so the + seed does not depend on case name, collection order, operation body, + attempts or A/B feature selection. Params maps use simple keyword keys; + namespaced keywords and string keys cannot be told apart by name and make + derive-seed throw ::invalid-params." + [master-seed scene-id params] + (check-param-keys! scene-id params) + (let [text (str master-seed "\u0000" (name scene-id) "/" (canonical-params params))] + (loop [index 0 + seed 2166136261] + (if (< index (count text)) + (recur (inc index) + (unsigned-bit-shift-right + (js/Math.imul (bit-xor seed (.charCodeAt text index)) 16777619) + 0)) + seed)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Projection +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn serializable? + "True when `value` is plain data the runner can hand to the browser and + store in results: nil, booleans, numbers, strings, keywords, and maps and + vectors thereof. Records fail: a record reaches the runner as a host + object, not plain data. Functions, atoms and host objects fail." + [value] + (cond + (or (nil? value) (boolean? value) (number? value) + (string? value) (keyword? value)) + true + + (and (map? value) (not (record? value))) + (every? (fn [[k v]] (and (serializable? k) (serializable? v))) value) + + (vector? value) + (every? serializable? value) + + :else + false)) + +(defn project-case + "Plain-data projection of a registered case: internal keys (`:ns`, `:run!`) + stripped, collection defaults applied." + [bench-case] + (-> bench-case + (select-keys [:id :scene :params :view :context :completion :batch-size + :operation :preparation]) + (update :completion #(or % :render-full)) + (update :batch-size #(or % 1)) + (update :preparation #(or % {:version 1})))) + +(defn check-collected-case! + "Validates a collected case descriptor and returns it unchanged. Rejects + anything that is not plain data: browser-side run functions must never + reach the runner." + [projected] + (when-not (sm/validate schema:collected-case projected) + (throw (ex-info (str "invalid collected case: " (:id projected)) + {:type ::invalid-case + :id (:id projected) + ::sm/explain (sm/explain schema:collected-case projected)}))) + (when-not (serializable? projected) + (throw (ex-info (str "collected case is not plain data: " (:id projected)) + {:type ::non-serializable-case + :id (:id projected)}))) + projected) diff --git a/frontend/test/benches/render_wasm/scenes/rects.cljs b/frontend/test/benches/render_wasm/scenes/rects.cljs index 76494624f0..24a5ca4815 100644 --- a/frontend/test/benches/render_wasm/scenes/rects.cljs +++ b/frontend/test/benches/render_wasm/scenes/rects.cljs @@ -5,23 +5,46 @@ ;; Copyright (c) KALEIDOS SUBSIDIARY SL (ns benches.render-wasm.scenes.rects - "Rectangle fixture, the smallest benchmark workload. + "Rectangle scene, the smallest benchmark workload. Distributes rectangles over the canvas with varied sizes, translucent fills and centered strokes, all drawn from the scope's seeded generator. - Ticket20 wraps `build` with case declarations; the path and effect - fixtures arrive in tickets07/08." - (:require - [benches.render-wasm.scenes.builder :as sb :include-macros true])) + `build` produces the fixture snapshot; `defscene` and `defcase` declare + the scene and its standard cases. The three cases share parameters, so + they render the same scene. The path and effect fixtures arrive in + tickets07/08. -(def default-params + Operation bodies are deferred to tickets05/06. The intended threaded + shape is: + + (defcase :rects/pan :rects {...} + (-> rtx + (restore! base-view) + (pan! {:frames 20 :distance [120 60] :settle-ms 100}) + (drain! :full))) + + where `rtx` is the injected runtime and each operation contributes its + plain-data identity to the collected case." + (:require + [benches.render-wasm.scenes.builder :as sb :include-macros true] + [benches.render-wasm.scenes.core :as core :include-macros true])) + +(def ^:private default-params {:count 1000 :width 1920 :height 1080 :min-size 20 :max-size 100}) -(defn rect-defaults +(def ^:private schema:params + [:map {:closed true} + [:count [:int {:min 1 :max 100000}]] + [:width pos?] + [:height pos?] + [:min-size pos?] + [:max-size pos?]]) + +(defn- rect-defaults "Attribute generators for one rectangle of the workload." [{:keys [width height min-size max-size]}] {:x (sb/gen-int 0 width) @@ -37,7 +60,7 @@ (defn build "Builds the seeded rectangle fixture. `params` requires `:seed`; the other - keys default to `default-params`." + keys default to the standard case parameters." [params] (let [params (merge default-params params)] (sb/fixture {:seed (:seed params) @@ -48,3 +71,29 @@ :defaults {:rect (rect-defaults params)}} (doseq [_ (range (:count params))] (sb/rect))))) + +(core/defscene :rects + {:version 1 + :description "Seeded rectangles with translucent fills and centered strokes" + :params-schema schema:params} + build) + +(def ^:private base-view + {:scale 1 :x 0 :y 0}) + +(core/defcase :rects/load :rects + {:params default-params + :view base-view + :context :fresh}) + +(core/defcase :rects/pan :rects + {:params default-params + :view base-view + :context :reuse + :completion :render-full}) + +(core/defcase :rects/zoom :rects + {:params default-params + :view base-view + :context :reuse + :completion :render-full}) diff --git a/frontend/test/frontend_tests/benches/builder_test.cljs b/frontend/test/frontend_tests/benches/builder_test.cljs index 249f0505bd..9626026ec6 100644 --- a/frontend/test/frontend_tests/benches/builder_test.cljs +++ b/frontend/test/frontend_tests/benches/builder_test.cljs @@ -42,7 +42,6 @@ (t/deftest rectangle-workload-keeps-default-count (let [instance (rects/build {:seed 42}) rects (rect-shapes instance)] - (t/is (= 1000 (:count rects/default-params))) (t/is (= 1000 (count rects))) (t/is (< 1 (count (distinct (map :x rects))))))) diff --git a/frontend/test/frontend_tests/benches/contracts_test.cljs b/frontend/test/frontend_tests/benches/contracts_test.cljs new file mode 100644 index 0000000000..e700c580d3 --- /dev/null +++ b/frontend/test/frontend_tests/benches/contracts_test.cljs @@ -0,0 +1,357 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns frontend-tests.benches.contracts-test + (:require + [app.common.schema :as sm] + [benches.render-wasm.cases :as cases] + [benches.render-wasm.scenes.core :as core :include-macros true] + [cljs.test :as t :include-macros true])) + +(defrecord Point [x y]) + +(core/defscene :contracts-scene + {:version 1 + :description "Synthetic scene for contract tests" + :params-schema [:map {:closed true}]} + (fn [params] params)) + +(core/defcase :contracts-scene/case + :contracts-scene + {:params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh} + (throw (ex-info "run body must not execute during collection" + {:type ::boom}))) + +(defn- failure-data + [f] + (try + (f) + nil + (catch :default cause + (ex-data cause)))) + +(defn- rect-cases + ([] (rect-cases 42 "rects/")) + ([master-seed filter] + (cases/collect-cases {:master-seed master-seed :filter filter}))) + +(defn- with-synthetic-scene + "Registers a synthetic scene and case under `scene-id`, runs `f`, then + unregisters both so the live registry survives." + [scene-id case-params f] + (core/register-scene! {:id scene-id + :ns "contracts-test" + :version 1 + :description "synthetic" + :params-schema [:map {:closed true} [:count [:int {:min 1 :max 100000}]]] + :build (fn [params] params)}) + (core/register-case! {:id (keyword (name scene-id) "case") + :scene scene-id + :ns "contracts-test" + :params case-params + :view {:scale 1 :x 0 :y 0} + :context :fresh}) + (try + (f) + (finally + (core/unregister-case! (keyword (name scene-id) "case")) + (core/unregister-scene! scene-id)))) + +(t/deftest defscene-registers-metadata-and-build + (let [scene (core/registered-scene :rects)] + (t/is (= :rects (:id scene))) + (t/is (= "benches.render-wasm.scenes.rects" (:ns scene))) + (t/is (= 1 (:version scene))) + (t/is (= "Seeded rectangles with translucent fills and centered strokes" + (:description scene))) + (t/is (vector? (:params-schema scene))) + (t/is (fn? (:build scene))))) + +(t/deftest rects-cases-are-collected-in-declaration-order + (let [collected (rect-cases)] + (t/is (= [:rects/load :rects/pan :rects/zoom] (mapv :id collected))))) + +(t/deftest collected-cases-are-plain-data + (doseq [case-desc (rect-cases)] + (t/is (not (contains? case-desc :run!)) (str (:id case-desc))) + (t/is (not (contains? case-desc :ns)) (str (:id case-desc))) + (t/is (core/serializable? case-desc) (str (:id case-desc))))) + +(t/deftest rects-cases-carry-declared-view-context-and-completion + (let [collected (rect-cases)] + (t/is (= [[:rects/load :fresh] [:rects/pan :reuse] [:rects/zoom :reuse]] + (mapv (juxt :id :context) collected))) + (doseq [case-desc collected] + (t/is (= {:count 1000 :width 1920 :height 1080 :min-size 20 :max-size 100} + (:params case-desc)) + (str (:id case-desc))) + (t/is (= {:scale 1 :x 0 :y 0} (:view case-desc)) (str (:id case-desc))) + (t/is (= :render-full (:completion case-desc)) (str (:id case-desc))) + (t/is (= 1 (:batch-size case-desc)) (str (:id case-desc))) + (t/is (= {:version 1} (:preparation case-desc)) (str (:id case-desc)))))) + +(t/deftest rects-cases-carry-scene-metadata-and-seed + (let [collected (rect-cases)] + (doseq [case-desc collected] + (t/is (= :rects (:scene case-desc))) + (t/is (= 1 (:scene-version case-desc))) + (t/is (= "Seeded rectangles with translucent fills and centered strokes" + (:scene-description case-desc))) + (t/is (= 2602546180 (:scene-seed case-desc)) (str (:id case-desc))))) + (let [collected (rect-cases 43 "rects/")] + (t/is (every? #(= 2993218129 (:scene-seed %)) collected)))) + +(t/deftest derive-seed-depends-on-scene-and-params-only + (let [params {:count 1000 :width 1920 :height 1080 :min-size 20 :max-size 100} + base (core/derive-seed 42 :rects params)] + (t/is (= 2602546180 base)) + (t/is (= base (core/derive-seed 42 :rects (into {} (reverse (seq params)))))) + (t/is (= 2993218129 (core/derive-seed 43 :rects params))) + (t/is (not= base (core/derive-seed 42 :rects (assoc params :count 10)))) + (t/is (not= base (core/derive-seed 42 :paths params))))) + +(t/deftest derive-seed-rejects-keys-it-cannot-tell-apart + (t/is (= ::core/invalid-params + (:type (failure-data #(core/derive-seed 42 :rects {"count" 1}))))) + (t/is (= ::core/invalid-params + (:type (failure-data #(core/derive-seed 42 :rects {:rects/count 1}))))) + (t/is (= :rects (:scene (failure-data #(core/derive-seed 42 :rects {"count" 1})))))) + +(t/deftest unknown-params-are-rejected + (with-synthetic-scene :contracts-unknown-params {:count 1 :bogus 2} + (fn [] + (let [data (failure-data + #(cases/collect-cases {:master-seed 42 + :filter "contracts-unknown-params/"}))] + (t/is (= ::cases/invalid-case (:type data))) + (t/is (some? (::sm/explain data))))))) + +(t/deftest out-of-range-count-is-rejected + (with-synthetic-scene :contracts-bad-count {:count 0} + (fn [] + (let [data (failure-data + #(cases/collect-cases {:master-seed 42 + :filter "contracts-bad-count/"}))] + (t/is (= ::cases/invalid-case (:type data))) + (t/is (some? (::sm/explain data))))))) + +(t/deftest duplicate-scene-id-from-another-namespace-is-rejected + (t/is (= ::core/duplicate-scene + (:type (failure-data + #(core/register-scene! {:id :rects + :ns "another-namespace" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)})))))) + +(t/deftest same-namespace-registration-replaces + (try + (core/register-scene! {:id :contracts-replaced + :ns "contracts-test" + :version 1 + :description "first" + :params-schema [:map] + :build (fn [params] params)}) + (core/register-scene! {:id :contracts-replaced + :ns "contracts-test" + :version 2 + :description "second" + :params-schema [:map] + :build (fn [params] params)}) + (t/is (= "second" (:description (core/registered-scene :contracts-replaced)))) + (finally + (core/unregister-scene! :contracts-replaced)))) + +(t/deftest duplicate-case-id-from-another-namespace-is-rejected + (try + (core/register-scene! {:id :contracts-dup + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)}) + (core/register-case! {:id :contracts-dup/case + :scene :contracts-dup + :ns "contracts-test" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh}) + (t/is (= ::core/duplicate-case + (:type (failure-data + #(core/register-case! {:id :contracts-dup/case + :scene :contracts-dup + :ns "another-namespace" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh}))))) + (finally + (core/unregister-case! :contracts-dup/case) + (core/unregister-scene! :contracts-dup)))) + +(t/deftest unknown-scene-reference-is-rejected + (try + (core/register-case! {:id :contracts-missing/case + :scene :contracts-missing + :ns "contracts-test" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh}) + (t/is (= ::cases/unknown-scene + (:type (failure-data + #(cases/collect-cases {:master-seed 42 + :filter "contracts-missing/"}))))) + (finally + (core/unregister-case! :contracts-missing/case)))) + +(t/deftest case-id-must-be-namespaced-by-its-scene + (try + (core/register-scene! {:id :contracts-other + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)}) + (core/register-case! {:id :contracts-other/case + :scene :rects + :ns "contracts-test" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh}) + (t/is (= ::cases/invalid-case + (:type (failure-data + #(cases/collect-cases {:master-seed 42 + :filter "contracts-other/"}))))) + (finally + (core/unregister-case! :contracts-other/case) + (core/unregister-scene! :contracts-other)))) + +(t/deftest scene-without-params-schema-is-rejected + (try + (core/register-scene! {:id :contracts-noschema + :ns "contracts-test" + :version 1 + :description "x" + :build (fn [params] params)}) + (t/is (= ::core/invalid-scene + (:type (failure-data #(cases/collect-cases {:master-seed 42}))))) + (finally + (core/unregister-scene! :contracts-noschema)))) + +(t/deftest malformed-params-schema-is-rejected + (try + (core/register-scene! {:id :contracts-badschema + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map [:count]] + :build (fn [params] params)}) + (let [data (failure-data #(cases/collect-cases {:master-seed 42}))] + (t/is (= ::core/invalid-scene (:type data))) + (t/is (= :contracts-badschema (:id data)))) + (finally + (core/unregister-scene! :contracts-badschema)))) + +(t/deftest qualified-scene-id-is-rejected + (try + (core/register-scene! {:id :contracts-ns/scene + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)}) + (t/is (= ::core/invalid-scene + (:type (failure-data #(cases/collect-cases {:master-seed 42}))))) + (finally + (core/unregister-scene! :contracts-ns/scene)))) + +(t/deftest invalid-declarations-fail-outside-the-filter + (with-synthetic-scene :contracts-global {:count 1 :bogus 2} + (fn [] + (t/is (= ::cases/invalid-case + (:type (failure-data #(cases/collect-cases {:master-seed 42 + :filter "rects/"})))))))) + +(t/deftest incomplete-case-declaration-is-rejected + (try + (core/register-scene! {:id :contracts-incomplete + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)}) + (core/register-case! {:id :contracts-incomplete/case + :scene :contracts-incomplete + :ns "contracts-test" + :params {} + :context :fresh}) + (t/is (= ::cases/invalid-case + (:type (failure-data #(cases/collect-cases {:master-seed 42 + :filter "contracts-incomplete/"}))))) + (finally + (core/unregister-case! :contracts-incomplete/case) + (core/unregister-scene! :contracts-incomplete)))) + +(t/deftest records-are-not-plain-data + (let [point (->Point 1 2)] + (t/is (false? (core/serializable? point))) + (t/is (false? (core/serializable? {:point point}))))) + +(t/deftest case-replacement-preserves-order-and-unregister-removes + (try + (core/register-scene! {:id :contracts-replacecase + :ns "contracts-test" + :version 1 + :description "x" + :params-schema [:map] + :build (fn [params] params)}) + (core/register-case! {:id :contracts-replacecase/case + :scene :contracts-replacecase + :ns "contracts-test" + :params {} + :view {:scale 1 :x 0 :y 0} + :context :fresh}) + (core/register-case! {:id :contracts-replacecase/case + :scene :contracts-replacecase + :ns "contracts-test" + :params {} + :view {:scale 2 :x 0 :y 0} + :context :fresh}) + (t/is (= 1 (count (filter #(= :contracts-replacecase/case (:id %)) (core/cases))))) + (t/is (= {:scale 2 :x 0 :y 0} (:view (core/registered-case :contracts-replacecase/case)))) + (core/unregister-case! :contracts-replacecase/case) + (t/is (nil? (core/registered-case :contracts-replacecase/case))) + (finally + (core/unregister-case! :contracts-replacecase/case) + (core/unregister-scene! :contracts-replacecase)))) + +(t/deftest invalid-master-seed-is-rejected + (doseq [seed [-1 4294967296 "42"]] + (t/is (= ::cases/invalid-master-seed + (:type (failure-data #(cases/collect-cases {:master-seed seed})))) + (str seed)))) + +(t/deftest filter-matches-case-ids + (t/is (= [:rects/pan] + (mapv :id (cases/collect-cases {:master-seed 42 :filter "rects/pan"})))) + (t/is (= 3 (count (cases/collect-cases {:master-seed 42 :filter "rects/"}))))) + +(t/deftest empty-selection-is-rejected + (t/is (= ::cases/no-cases + (:type (failure-data #(cases/collect-cases {:master-seed 42 + :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)))))) + (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)))))