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

🚧 WIP 23 Results and reporting. Cleanup

Browse Source
This commit is contained in:
Miguel de Benito Delgado 2026-10-05 15:39:52 +02:00
parent cddccf6338
commit 35cd79cb03
27 changed files with 2741 additions and 503 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

337
frontend/test/benches/render_wasm/browser/bridge.cljs
View File

@ -5,16 +5,19 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.browser.bridge
"Browser bridge for the benchmarks.
"The browser bridge prepares scenes and executes renderer benchmark attempts.
Lifecycle here mirrors the editor cold-load path
(`app.render-wasm.api/initialize-viewport` + `set-objects` sync).
A preparation owns one module, graphics context, scene snapshot and upload.
'Warm' attempts are those that reuse that preparation. 'Fresh' preparations
execute once.
The browser exports `bridge`; Node passes data through `page.evaluate`.
Setup follows the editor initialization and synchronous object upload paths.
Node calls the exported bridge through `page.evaluate`.
`loadScene` resolves to Transit. `ping` and `dispose` return plain data.
Scene, measurement and reports return Transit. Ping and disposal return status
objects.
Failures are returned as `{\"status\" \"failed\" ...}` maps."
Failures retain their phase, cause and available partial evidence."
(:require
[app.common.render-wasm.helpers :as h]
[app.common.render-wasm.serialize-shape :as serialize-shape]
@ -27,12 +30,18 @@
;; at load
[app.render-wasm.api.enums]
[app.render-wasm.api.webgl :as webgl]
[benches.render-wasm.browser.upload :as upload]
[benches.render-wasm.cases]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.failures :as fail]
[benches.render-wasm.fingerprint :as fingerprint]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
[benches.render-wasm.runtime.protocol :as protocol]
[benches.render-wasm.snapshot :as scenes]))
[benches.render-wasm.snapshot :as snapshot]))
;; Forward decls
(declare now guard-current! read-graphics)
@ -40,19 +49,23 @@
(def schema:load-scene-args
"Decoded Transit request for `load-scene`."
[:map {:closed true}
[:case map?]
[:case decl/schema:collected-case]
[:preparation-id {:optional true} some?]
[:timeout-ms {:optional true} [:int {:min 1}]]
[:module-url {:optional true} string?]
[:wasm-url {:optional true} string?]])
(def ^:const ^:private attempt-ms-budget
"Own wall deadline for one bridge attempt, checked by `browser-hooks`.
Ticket 11 accepts a per-attempt timeout; until then this fixed value
bounds runaway drains. The Node outer timeout stays the backstop for
synchronously blocked pages."
"Default wall deadline for setup or one attempt, checked by browser-hooks.
Requests can supply a timeout. Node's outer timeout covers blocked pages."
30000)
(defn- browser-hooks
"Browser hooks for one owner epoch and deadline."
"Browser hooks for one owner epoch and deadline.
This somewhat awkward decoupling keeps scene declarations safe to load in
Node, where we don't have a canvas nor a graphics context. It also lets tests
control time and renderer responses."
[epoch deadline-ms]
{:now now
;; rAF scheduling
@ -94,13 +107,18 @@
(defonce ^:private canvas*
(atom nil))
(defonce ^:private prepared*
(atom nil))
(defn- mark-live!
"Marks the current renderer context as initialized and available."
[]
(reset! wasm/context-lost? false)
(set! wasm/context-initialized? true))
(defn- now
"Reads the browser's monotonic clock in milliseconds."
[]
(.now js/performance))
@ -135,6 +153,7 @@
(catch :default _ "unknown")))
(defn- software-renderer?
"Recognizes common software graphics implementations from their renderer text."
[s]
(boolean (re-find #"(?i)swiftshader|llvmpipe|software|basic render" (or s ""))))
@ -160,7 +179,8 @@
;; reload path; bench disposal owns it explicitly.
(reset! wasm/context-lost? false)
(set! wasm/internal-module nil)
(reset! canvas* nil))
(reset! canvas* nil)
(reset! prepared* nil))
(defn dispose!
"Closes the current owner: bumps the epoch (running continuations go
@ -195,7 +215,12 @@
(catch :default _ nil))
attr (fn [k]
(when (some? attrs)
(unchecked-get attrs k)))]
(unchecked-get attrs k)))
vendor (try
(if-let [ext (.getExtension ^js ctx "WEBGL_debug_renderer_info")]
(str (.getParameter ^js ctx (unchecked-get ext "UNMASKED_VENDOR_WEBGL")))
"unknown")
(catch :default _ "unknown"))]
{:css-width width
:css-height height
:drawing-buffer-width (.-drawingBufferWidth ^js ctx)
@ -208,6 +233,7 @@
:alpha (attr "alpha")
:preserve-drawing-buffer (attr "preserveDrawingBuffer")
:renderer renderer
:vendor vendor
:software (software-renderer? renderer)}))
(defn- install-listeners!
@ -258,11 +284,15 @@
"unknown failure"))
detail (try (fail/describe-cause cause)
(catch :default _
[{:message fail/unrenderable-cause-text}]))]
[{:message fail/unrenderable-cause-text}]))
partial (try (:partial (ex-data cause)) (catch :default _ nil))
preparation (get-in @prepared* [:graphics :preparation])]
(dispose-if-current! epoch)
(fail/fail-data {:phase phase
:message message
:cause detail}))))
(cond-> (fail/fail-data {:phase phase
:message message
:cause detail})
partial (assoc :partial partial)
preparation (assoc :preparation preparation)))))
(defn- guard-current!
"Throws the stale marker when `epoch` no longer owns the realm. Every
@ -286,40 +316,39 @@
(defn- case-ok
"Adds lifecycle and graphics data to one compiled body's measurement."
[epoch live? case-desc seed dims graphics measurement]
[epoch case-desc seed graphics measurement]
(guard-current! epoch "render")
(if-not (live?)
(if-not (wasm/live?)
(do
(dispose-if-current! epoch)
(fail/fail-data {:phase (if (= :reuse (:context case-desc))
"interact"
"first-render")
:message "disposed or context lost during case"}))
(let [{:keys [module-ms graphics-ms renderer ctx snapshot upload-ms]} graphics
{:keys [width height dpr]} dims]
(cond-> (merge measurement
{:status "ok"
:module-init-ms module-ms
:graphics-init-ms graphics-ms
:upload-ms upload-ms
:scene {:shapes (count (:objects snapshot))
:seed seed}
:effective-graphics (read-graphics (:context ctx) width height dpr renderer)})
(= :fresh (:context case-desc))
(assoc :first-render-ms (:full-ms measurement)
:render-frames (count (:slices measurement)))))))
(let [{:keys [module-ms graphics-ms snapshot upload-ms preparation]} graphics
setup {:module-init-ms module-ms :graphics-init-ms graphics-ms :upload-ms upload-ms}]
(merge measurement
{:status "ok"
:preparation preparation
:metrics (measurement/metrics measurement (= :fresh (:context case-desc)) setup)
:trace (dissoc measurement :metrics)
:scene {:shapes (count (:objects snapshot))
:seed seed}
:effective-graphics (:effective-graphics preparation)}))))
(defn- run-case
"Awaits untimed restore for reuse cases, then calls the compiled body once.
Its synchronous return is assimilated into the same Promise result path."
[{:keys [epoch dims hooks live?]} case-desc local-case graphics]
[{:keys [epoch hooks]} case-desc local-case graphics]
(let [reuse? (= :reuse (:context case-desc))
prep (if reuse?
(-> (protocol/restore hooks (:view graphics))
(.catch (fn [cause]
(if (fail/stale? cause)
(throw cause)
(throw (ex-info "restore failed" {:phase "restore"} cause))))))
(throw (ex-info "restore failed"
(assoc (ex-data cause) :phase "restore")
(if (some? (ex-data cause)) (ex-cause cause) cause)))))))
(js/Promise.resolve nil))
rtx {:case case-desc
:scene (:snapshot graphics)
@ -331,10 +360,11 @@
(guard-current! epoch "render")
(js/Promise.resolve ((:run! local-case) rtx))))
(.then (fn [measurement]
(case-ok epoch live? case-desc (:scene-seed case-desc)
dims graphics measurement)))
(case-ok epoch case-desc (:scene-seed case-desc)
graphics measurement)))
(.catch (fn [cause]
(terminal-failure epoch cause (if reuse? "interact" "first-render")))))))
(assoc (terminal-failure epoch cause (if reuse? "interact" "first-render"))
:preparation (:preparation graphics)))))))
(defn- parse-load-request
"Decodes and validates the request before claiming the page. Failure
@ -346,19 +376,18 @@
{:error (fail/fail-data {:phase "invalid-args"
:message "load-scene needs a Transit request with case"})}
(let [case-desc (:case params)
checked (decl/check-collected-case case-desc)
scene (decl/registered-scene (:scene checked))
local (decl/registered-case (:id checked))]
scene (decl/registered-scene (:scene case-desc))
local (decl/registered-case (:id case-desc))]
(when (nil? scene)
(throw (ex-info (str "unknown scene: " (:scene checked))
(throw (ex-info (str "unknown scene: " (:scene case-desc))
{:phase "invalid-args"})))
(when-not (and local
(fn? (:run! local))
(= (:scene local) (:scene checked)))
(throw (ex-info (str "missing case body for " (:id checked))
(= (:scene local) (:scene case-desc)))
(throw (ex-info (str "missing case body for " (:id case-desc))
{:phase "invalid-args"})))
{:params params
:case-desc checked
:case-desc case-desc
:local-case local
:scene scene})))
(catch :default cause
@ -367,17 +396,15 @@
"invalid Transit request")})})))
(defn- begin-load!
"Claims the page, releases the prior owner, then fixes this attempt's
viewport, hooks and deadline. Module instantiation gets a fresh cache."
"Claims the page, releases the prior owner and fixes the viewport.
Module instantiation gets a fresh cache. Preparation supplies the deadline."
[case-desc]
(let [epoch (swap! owner-epoch* inc)]
(release-owner-resources!)
(reset! module-promise* nil)
(let [viewport (decl/resolve-viewport (:view case-desc))]
{:epoch epoch
:dims viewport
:hooks (browser-hooks epoch (+ (now) attempt-ms-budget))
:live? (fn [] (and (= epoch @owner-epoch*) (wasm/live?)))})))
:dims viewport})))
(defn- load-module
"Imports and instantiates the renderer. A failed import or factory call
@ -439,16 +466,16 @@
:ctx ctx})))
(defn- prepare-scene
"Builds and validates the registered scene, then orders its shapes before
the upload timer begins."
"Builds the registered scene, then fingerprints and orders its shapes before
the upload timer begins. Scene builders return validated snapshots."
[epoch scene case-desc seed graphics]
(guard-current! epoch "scene-build")
(try
(let [snapshot (-> ((:build scene) (assoc (:params case-desc) :seed seed))
(scenes/validate!))]
(let [snapshot ((:build scene) (assoc (:params case-desc) :seed seed))]
(assoc graphics
:snapshot snapshot
:ordered (upload/prepare-scene snapshot)))
:fingerprint (fingerprint/fingerprint snapshot)
:ordered (snapshot/upload-order snapshot)))
(catch :default cause
(if (fail/stale? cause)
(throw cause)
@ -486,58 +513,172 @@
{:phase "upload"}
cause))))))
(defn- render-scene
"Runs the compiled case body after upload and any untimed preparation."
[{:keys [epoch] :as attempt} case-desc local-case graphics]
(guard-current! epoch "render")
(run-case attempt case-desc local-case graphics))
(defn- preparation-data
"Projects setup facts without renderer handles or snapshot contents."
[id case-desc dims graphics]
(let [{:keys [module-ms graphics-ms upload-ms renderer ctx snapshot fingerprint setup-render]} graphics
{:keys [width height dpr]} dims]
{:preparation-id id
:case-id (:id case-desc)
:fingerprint fingerprint
:effective-graphics (read-graphics (:context ctx) width height dpr renderer)
:diagnostics (cond-> {:module-init-ms module-ms :graphics-init-ms graphics-ms
:upload-ms upload-ms
:scene {:shapes (count (:objects snapshot)) :seed (:scene-seed case-desc)}}
setup-render (assoc :setup-render setup-render))}))
(defn- prepare-request
"Builds, fingerprints and uploads one owned scene.
Warm initial rendering stays in diagnostics. No attempt slot runs here."
[request]
(try
(let [{:keys [error params case-desc local-case scene]} (parse-load-request request)]
(if error
(js/Promise.resolve error)
(let [{:keys [epoch dims] :as owner} (begin-load! case-desc)
timeout-ms (or (:timeout-ms params) attempt-ms-budget)
owner (assoc owner :hooks (browser-hooks epoch (+ (now) timeout-ms)))
id (or (:preparation-id params) epoch)
available* (volatile! {})]
(-> (load-module epoch params)
(.then (fn [module] (initialize-graphics! epoch dims module)))
(.then (fn [graphics]
(vreset! available* (select-keys graphics [:module-ms :graphics-ms]))
(let [graphics (prepare-scene epoch scene case-desc (:scene-seed case-desc) graphics)]
(vswap! available* assoc :fingerprint (:fingerprint graphics))
graphics)))
(.then (fn [graphics] (upload-scene! epoch case-desc graphics)))
(.then (fn [graphics]
(vswap! available* assoc :upload-ms (:upload-ms graphics))
(if (= :reuse (:context case-desc))
(-> (protocol/restore (:hooks owner) (:view graphics))
(.then (fn [trace] (assoc graphics :setup-render trace))))
graphics)))
(.then (fn [graphics]
(guard-current! epoch "prepare")
(let [preparation (preparation-data id case-desc dims graphics)]
(reset! prepared* {:owner owner :case-desc case-desc :local-case local-case
:timeout-ms timeout-ms :busy? false :used? false
:graphics (assoc graphics :preparation preparation)})
{:status "ok" :preparation preparation})))
(.catch (fn [cause]
(if (fail/stale? cause)
(terminal-failure epoch cause "aborted")
(terminal-failure epoch
(ex-info (or (ex-message cause) "setup failed")
(assoc (ex-data cause) :partial
(merge {:setup @available*}
(:partial (ex-data cause))))
(if (some? (ex-data cause)) (ex-cause cause) cause))
"aborted"))))))))
(catch :default cause
(js/Promise.resolve (fail/fail-data {:phase "setup" :message (ex-message cause)})))))
(defn- execute-prepared
"Runs one body against the owned preparation with a fresh attempt deadline.
Fresh preparations run once; warm preparations restore and drain before each
body without rebuilding, uploading or copying setup metrics into samples."
[{:keys [preparation-id timeout-ms]}]
(let [{:keys [owner case-desc local-case graphics busy? used?] :as prepared} @prepared*
id (get-in graphics [:preparation :preparation-id])]
(if (or (nil? prepared) (not= id preparation-id) busy?
(and used? (= :fresh (:context case-desc))))
(js/Promise.resolve (fail/fail-data {:phase "invalid-args"
:message "preparation unavailable, busy or already used"}))
(let [epoch (:epoch owner)
timeout-ms (or timeout-ms (:timeout-ms prepared))
owner (assoc owner :hooks (browser-hooks epoch (+ (now) timeout-ms)))]
(swap! prepared* assoc :busy? true :used? true)
(-> (run-case owner case-desc local-case graphics)
(.then (fn [evidence]
(when (= epoch @owner-epoch*)
(swap! prepared* assoc :busy? false))
evidence))
(.catch (fn [cause] (terminal-failure epoch cause "attempt"))))))))
(defn- encode-evidence
"Encodes bridge evidence after all timing; reports codec errors as failures."
[promise]
(let [epoch @owner-epoch*]
(-> promise
(.then codec/encode-str)
(.catch (fn [cause]
(dispose-if-current! epoch)
(t/encode-str (fail/fail-data {:phase "bridge"
:message (or (ex-message cause) "result encoding failed")})))))))
(defn prepare-scene-request
"Accepts a Transit load request and returns a Transit preparation.
Repeated warm attempts use runPrepared with this preparation's exact ID."
[request]
(encode-evidence (prepare-request request)))
(defn run-prepared
"Accepts Transit {:preparation-id id :timeout-ms optional-positive-ms}.
Invalid requests leave the owner untouched. Evidence resolves as Transit."
[request]
(encode-evidence
(try
(let [params (t/decode-str request)]
(if (sm/validate [:map {:closed true}
[:preparation-id some?]
[:timeout-ms {:optional true} [:int {:min 1}]]] params)
(execute-prepared params)
(js/Promise.resolve (fail/fail-data {:phase "invalid-args"
:message "runPrepared needs a preparation ID"}))))
(catch :default cause
(js/Promise.resolve (fail/fail-data {:phase "invalid-args"
:message (or (ex-message cause) "invalid Transit request")}))))))
(defn load-scene
"Loads one collected case to Full. Takes a Transit request with `:case`
and optional module/WASM URLs; resolves to a Transit result.
Validation precedes ownership and all timers. Fresh cases time upload
and one drain; reuse cases restore and drain outside interaction timing."
"Prepares a collected case and runs one attempt, returning Transit evidence.
Fresh render timing starts after upload. Warm setup stays diagnostic;
prepareScene/runPrepared let a serial runner reuse the owned warm scene."
[request]
(let [epoch* (volatile! nil)
result (try
(let [{:keys [error params case-desc local-case scene]}
(parse-load-request request)
seed (:scene-seed case-desc)]
(if error
(js/Promise.resolve error)
(let [{:keys [epoch dims] :as attempt} (begin-load! case-desc)]
(vreset! epoch* epoch)
(-> (load-module epoch params)
(.then (fn [module]
(initialize-graphics! epoch dims module)))
(.then (fn [graphics]
(prepare-scene epoch scene case-desc seed graphics)))
(.then (fn [graphics]
(upload-scene! epoch case-desc graphics)))
(.then (fn [graphics]
(render-scene attempt case-desc local-case graphics)))
(.catch (fn [cause]
(terminal-failure epoch cause "aborted")))))))
(catch :default cause
(js/Promise.resolve
(fail/fail-data {:phase "setup" :message (ex-message cause)}))))]
(-> result
(.then t/encode-str)
(.catch (fn [cause]
(when-some [epoch @epoch*]
(dispose-if-current! epoch))
(t/encode-str
(fail/fail-data {:phase "bridge"
:message (or (ex-message cause)
"result encoding failed")})))))))
(encode-evidence
(-> (prepare-request request)
(.then (fn [{:keys [status preparation] :as evidence}]
(if (= status "ok")
(execute-prepared {:preparation-id (:preparation-id preparation)})
evidence))))))
(defn ping
"Bridge placeholder that checks the Node/browser boundary."
[]
#js {"status" "ok"})
(defn summarize-record
"Returns a Transit summary of a raw Transit record."
([record-text] (summarize-record record-text nil))
([record-text analysis-text]
(codec/encode-str (summary/summarize (result/decode record-text)
(when analysis-text (t/decode-str analysis-text))))))
(defn compare-records
"Returns Comparison schema2 Transit for two saved runs and Transit options."
[baseline-text candidate-text options-text]
(result/encode (compare/compare-runs (result/decode baseline-text)
(result/decode candidate-text)
(t/decode-str options-text))))
(defn format-run
"Returns text for a summary computed from a raw Transit run."
[record-text]
(format/format-run (summary/summarize (result/decode record-text))))
(defn format-comparison
"Returns text for a Comparison schema2 Transit record."
[record-text]
(format/format-comparison (result/decode record-text)))
(def bridge
"Browser-side bridge exported from the compiled module."
#js {"ping" ping
"loadScene" load-scene
"prepareScene" prepare-scene-request
"runPrepared" run-prepared
"summarize" summarize-record
"compare" compare-records
"formatRun" format-run
"formatComparison" format-comparison
"dispose" dispose!})

41
frontend/test/benches/render_wasm/browser/upload.cljs
View File

@ -1,41 +0,0 @@
;; 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.browser.upload
"Benchmark scene upload.
In order to emulate editor behaviour, `upload-scene!` derives
parent-before-child order from a validated scene
snapshot and uploads it with `serialize-shapes-batch`
Validation, timing, lifecycle (`_begin/_end_loading`), host font/image/grid
sequencing and text layouts stay in the callers (tickets 02/05).
This uses renderer code, so don't pull this from Node case collection
(`benches.render-wasm.cases`)"
(:require
[app.common.render-wasm.serialize-shape :as serialize-shape]
[benches.render-wasm.snapshot :as common]))
(defn prepare-scene
"Derives the parent-before-child shape vector from a validated `snapshot`.
Call it outside measured regions, then pass the result to
`serialize-shapes-batch` inside."
[snapshot]
(common/upload-order snapshot))
(defn upload-scene!
"Uploads validated `snapshot` with `opts`.
- `snapshot` is `{:objects {uuid shape} :refs {label uuid}}` per the ticket02
contract; it must already be validated (see
`benches.render-wasm.snapshot/validate!`).
- `opts` carries `:include-layout?` and `:include-fills-strokes?` through to
the batch writer.
Returns the prepared shape vector."
[snapshot opts]
(serialize-shape/serialize-shapes-batch (prepare-scene snapshot) opts))

69
frontend/test/benches/render_wasm/builder.cljs
View File

@ -21,64 +21,14 @@
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.geom.shapes :as gsh]
[app.common.types.color :as clr]
[app.common.types.path :as path]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[benches.render-wasm.snapshot :as common]))
[benches.render-wasm.random :as rnd :refer
[rng-float rng-hex-color rng-int rng-opacity rng-uuid]]
[benches.render-wasm.snapshot :as snapshot]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Poor-man's seeded PRNG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WTF? clj has no seedable PRNG!? `rand`/`rand-int` call Math.random which is
;; unseeded. I can't find any RNG wich takes a seed among the deps.
;; We implement mulberry32 here instead.
(defn- make-random
"Returns a zero-arg function that draws a float in `[0, 1)` from the seeded.
This is Mulberry32 which reportedly misses about 1/3 of the range. Do NOT USE
for anything requiring actual random numbers!
"
[seed]
(let [state (atom (bit-or seed 0))]
(fn []
(let [s (swap! state (fn [s] (bit-or (+ s 0x6d2b79f5) 0)))
v (js/Math.imul (bit-xor s (unsigned-bit-shift-right s 15))
(bit-or s 1))
v (bit-xor v (+ v (js/Math.imul (bit-xor v (unsigned-bit-shift-right v 7))
(bit-or v 61))))
v (bit-xor v (unsigned-bit-shift-right v 14))]
(/ (unsigned-bit-shift-right v 0) 4294967296)))))
(defn rng-float
"Draws a float in `[min, max)` from the scope random source."
[rng min max]
(+ min (* (rng) (- max min))))
(defn rng-int
"Draws an integer in `[min, max)` from the scope random source."
[rng min max]
(js/Math.floor (rng-float rng min max)))
(defn- round3
[value]
(/ (js/Math.round (* 1000 value)) 1000))
(defn rng-uuid
"Draws a deterministic uuid from two 32-bit values of the random source."
[rng]
(uuid/custom (rng-int rng 0 4294967296)
(rng-int rng 0 4294967296)))
(defn- rng-hex-color
[rng]
(clr/rgb->hex [(rng-int rng 0 256) (rng-int rng 0 256) (rng-int rng 0 256)]))
(defn- rng-opacity
[rng]
(min 0.999 (round3 (rng-float rng 0.1 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Attribute generators
@ -92,7 +42,7 @@
(defn gen-float
"Float generator rounded to three decimals so snapshots stay readable."
[min max]
(fn [rng] (round3 (rng-float rng min max))))
(fn [rng] (rnd/round3 (rng-float rng min max))))
(defn gen-hex-color
"Generator of a random `#rrggbb` string."
@ -149,14 +99,17 @@
{:id uuid/zero :frame-id uuid/zero})
(defn- check-seed!
"Requires a scene seed from 0 through 4294967295, retaining the builder error type."
[seed]
(when-not (and (integer? seed) (<= 0 seed) (< seed 4294967296))
(when-not (rnd/seed? seed)
(throw (ex-info "scene scope requires an integer :seed in [0, 2^32)"
{:type ::invalid-seed
:seed seed}))))
(defn start
"Starts a scene scope. Returns the scope state atom."
"Starts a scene scope and returns its state atom with objects, refs and :rng.
The seeded generator belongs to this scope; other scopes and report draws
cannot advance its state."
[params]
(when (some? *state*)
(throw (ex-info "scene scopes cannot nest"
@ -171,7 +124,7 @@
:frame-id uuid/zero
:shapes []}))]
(atom {:seed seed
:rng (make-random seed)
:rng (rnd/create seed)
:objects {uuid/zero root}
:refs {}
:unfinished {}})))
@ -462,5 +415,5 @@
:ids (vec (keys unfinished))})))
(let [instance {:objects objects
:refs refs}]
(common/validate! instance)
(snapshot/validate! instance)
instance)))

12
frontend/test/benches/render_wasm/cases.cljs
View File

@ -15,10 +15,11 @@
(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.
Loading this namespace registers the scene namespaces listed here. The require
list is the discovery manifest for case collection.
NOTE: Nothing here should import browser or renderer code, so the Node runner
and offline reports load scenes without requiring a browser.
Usage:
@ -40,6 +41,7 @@
(:require
[app.common.schema :as sm]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.random :as random]
benches.render-wasm.scenes.masks
benches.render-wasm.scenes.paths
benches.render-wasm.scenes.plus
@ -49,7 +51,7 @@
(defn- check-master-seed!
"Collection requires an integer master seed in [0, 2^32)."
[seed]
(when-not (and (integer? seed) (<= 0 seed) (< seed 4294967296))
(when-not (random/seed? seed)
(throw (ex-info "case collection requires an integer master seed in [0, 2^32)"
{:type ::invalid-master-seed
:seed seed}))))

47
frontend/test/benches/render_wasm/codec.cljs Normal file
View File

@ -0,0 +1,47 @@
;; 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.codec
"Verifies that measurements survive transit encoding.
This ns exists mainly to preserve NaNs in the transit encoding of results.
We treat two NaN values as the same retained measurement.
Unrepresentable data raises an error."
(:require
[app.common.transit :as transit]))
(declare equivalent?)
(defn- equivalent-entry?
"Finds a map key and compares its value, including keys that contain NaN."
[other [k v]]
(if-let [entry (find other k)]
(equivalent? v (val entry))
(boolean (some (fn [[other-k other-v]]
(and (equivalent? k other-k) (equivalent? v other-v))) other))))
(defn equivalent?
"Checks Transit value equality while retaining NaN as a valid raw value."
[a b]
(or (= a b)
(cond
(and (number? a) (number? b)) (and (js/Number.isNaN a) (js/Number.isNaN b))
(and (map? a) (map? b)) (and (= (count a) (count b))
(every? #(equivalent-entry? b %) a))
(and (sequential? a) (sequential? b)) (and (= (count a) (count b))
(every? true? (map equivalent? a b)))
(and (set? a) (set? b)) (and (= (count a) (count b))
(every? (fn [item] (some #(equivalent? item %) b)) a))
:else false)))
(defn encode-str
"Encodes through app.common.transit and rejects any loss of supplied evidence."
([value] (encode-str value nil))
([value options]
(let [text (transit/encode-str value options)]
(when-not (equivalent? value (transit/decode-str text))
(throw (ex-info "Transit cannot preserve this value" {:type ::unrepresentable-value})))
text)))

81
frontend/test/benches/render_wasm/fingerprint.cljs Normal file
View File

@ -0,0 +1,81 @@
;; 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.fingerprint
"Scene fingerprints identify validated starting snapshots by content.
Encoding version 1 orders unordered representations in production verbose
Transit, preserves type tags and ordered collections, and hashes UTF-8 bytes.
Callers validate snapshots and compute fingerprints before upload and timers."
(:require
[benches.render-wasm.codec :as codec]
[goog.crypt :as crypt]
[goog.crypt.Sha256]))
(declare canonicalize)
(defn- canonical-text
"Encodes an already canonical Transit representation as deterministic text."
[value]
(js/JSON.stringify value))
(defn- canonical-array
"Preserves array order while canonicalizing each element."
[value]
(into-array (map canonicalize (array-seq value))))
(defn- canonical-pairs
"Orders a compound map by canonical key text, preserving key/value pairs."
[value]
(->> (partition 2 (array-seq value))
(map (fn [[k v]] [(canonicalize k) (canonicalize v)]))
(sort-by (comp canonical-text first))
(mapcat identity)
(into-array)))
(defn- canonicalize
"Orders verbose Transit objects, compound maps and unordered sets.
Tagged ordered-map and ordered-set representations retain their array order."
[value]
(cond
(array? value)
(canonical-array value)
(and (some? value) (= "object" (goog/typeOf value)))
(let [keys (sort (array-seq (js/Object.keys value)))
out (js/Object.create nil)]
(doseq [k keys]
(let [v (unchecked-get value k)]
(aset out k
(cond
(= k "~#cmap") (canonical-pairs v)
(= k "~#set") (->> (array-seq v)
(map canonicalize)
(sort-by canonical-text)
(into-array))
:else (canonicalize v)))))
out)
:else value))
(defn snapshot-text
"Returns encoding version 1 text for a validated snapshot.
Realizing :objects removes ObjectsMap's serialized shape strings while keeping
production shape, geometry and path tags in the values."
[snapshot]
(-> (assoc snapshot :objects (into {} (:objects snapshot)))
(codec/encode-str {:type :json-verbose})
(js/JSON.parse)
(canonicalize)
(canonical-text)))
(defn fingerprint
"Returns a SHA-256 digest and encoding version for a validated snapshot."
[snapshot]
(let [hash (goog.crypt.Sha256.)]
(.update hash (crypt/stringToUtf8ByteArray (snapshot-text snapshot)))
{:encoding-version 1
:algorithm :sha-256
:digest (crypt/byteArrayToHex (.digest hash))}))

71
frontend/test/benches/render_wasm/measurement.cljs Normal file
View File

@ -0,0 +1,71 @@
;; 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.measurement
"Measurement normalization runs after renderer timing ends.
Explicit entries declare which values supply observations. Raw traces retain
zero spans, non-finite values and diagnostic settings. Render-call totals sum
existing final/cached call durations and supply one observation per attempt."
(:require
[benches.render-wasm.result :as result]))
(defn- duration
"Declares one total duration with its timing semantics and zero policy."
[value semantics zero-policy]
(result/metric {:value value :unit :ms :semantics semantics
:basis {:kind :attempt-total} :zero-policy zero-policy}))
(defn- add-duration
"Adds a known duration only when its raw field exists, preserving explicit nil."
[metrics measurement field id semantics zero-policy]
(if (contains? measurement field)
(assoc metrics id (duration (get measurement field) semantics zero-policy))
metrics))
(defn render-call-total
"Sums existing call durations after timing, without interpreting GPU or CPU work.
No calls or missing durations yield nil; recorded zero durations remain zero.
NaN and infinities propagate as raw values."
[measurement]
(let [slices (concat (:slices measurement) (:cached-slices measurement))]
(when (and (seq slices) (every? #(number? (:duration-ms %)) slices))
(reduce + 0 (map :duration-ms slices)))))
(defn metrics
"Normalizes standard durations and any authored explicit metric entries.
Fresh Full completion has the sole metric ID :first-render-ms. Warm setup
stays in preparation diagnostics. Requested waits and counts stay raw."
[measurement fresh? setup]
(let [entries (into {} (map (fn [[id entry]] [id (result/metric entry)])) (:metrics measurement))
entries (if fresh?
(-> entries
(add-duration setup :module-init-ms :module-init-ms :module-instantiation :positive)
(add-duration setup :graphics-init-ms :graphics-init-ms :graphics-initialization :positive)
(add-duration setup :upload-ms :upload-ms :shared-encoding-and-upload :positive)
(add-duration measurement :full-ms :first-render-ms :prepared-scene-to-full :positive)
(add-duration measurement :viewport-ready-ms :viewport-ready-ms :prepared-scene-to-viewport-ready :positive))
(-> entries
(add-duration measurement :interact-ms :interact-ms :camera-session-to-full :positive)
(add-duration measurement :active-ms :active-ms :camera-active-span :positive)
(add-duration measurement :settling-actual-ms :settling-actual-ms :actual-settling-span :allow)
(add-duration measurement :set-view-end-ms :set-view-end-ms :synchronous-set-view-end-call :allow)
(add-duration measurement :time-to-viewport-ready-ms :time-to-viewport-ready-ms :finalization-to-viewport-ready :positive)
(add-duration measurement :time-to-full-ms :time-to-full-ms :finalization-to-full :positive)
(add-duration measurement :last-input-to-full-ms :last-input-to-full-ms :last-input-to-full :positive)))]
(if (or (contains? measurement :slices) (contains? measurement :cached-slices))
(assoc entries :renderer-call-total-ms
(duration (render-call-total measurement) :synchronous-render-call-elapsed :allow))
entries)))
(defn attempt
"Projects bridge evidence into a raw attempt; the run assigns its ordinal.
Failed evidence remains raw and supplies no statistical observations."
[case-id preparation-id warmup? evidence]
(cond-> {:case-id case-id :preparation-id preparation-id :warmup? warmup?
:outcome (if (= "ok" (:status evidence)) :completed :failed)
:metrics (or (:metrics evidence) {}) :trace (or (:trace evidence) {})}
(not= "ok" (:status evidence)) (assoc :failure (select-keys evidence [:status :phase :message :cause]))
(:partial evidence) (assoc :partial (:partial evidence))))

177
frontend/test/benches/render_wasm/node/pilot.cljs
View File

@ -5,8 +5,10 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.node.pilot
"Interim diagnostic: loads `:rects/load` in headless Chromium and prints
a Transit record with the bridge result on stdout.
"The diagnostic pilot executes one unscored case in headless Chromium.
An unscored attempt checks integration without a performance conclusion.
Stdout contains one raw RunRecord schema3 in Transit. The record
stores the saved plan, provenance, preparation, attempt and remaining slots.
THIS IS A SMOKE TEST AND THROWAWAY CODE. DO NOT USE THIS DESIGN AS GUIDANCE.
@ -21,14 +23,13 @@
ticket 11. Raw `.then` chains below are diagnostic scaffolding, not the
runner's interop pattern.
Exit codes: 0 when a result transit string is produced (including bridge
failure maps, which are valid pilot output); 1 on harness errors and
timeouts. A timeout closes the browser, so it stops even a synchronously blocked
page.
Exit codes: 0 when the case completes; 1 on case failures, harness errors and
timeouts. Failures retain raw records. A timeout closes the browser, including
a synchronously blocked page.
Usage, from `frontend/` with Playwright's Chromium installed:
PENPOT_WASM_PREPARED=1 ../render-wasm/build frontend
Follow README.md's prepared renderer release commands first.
clojure -M:dev:renderer-bench release bench-render-wasm-browser
pnpm run build:renderer-benchmarks:pilot
node target/renderer-benchmarks/pilot.cjs --seed 42 --screenshot /tmp/pilot-rects.png
@ -39,12 +40,21 @@
`--timeout-ms N` (default 30000), `--screenshot PATH` (optional untimed
capture for visual inspection)."
(:require
["child_process" :as child-process]
["fs" :as fs]
["http" :as http]
["os" :as os]
["path" :as path]
["playwright" :as playwright]
["playwright/package.json" :as playwright-package]
[app.common.transit :as t]
[benches.render-wasm.cases :as cases]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.random :as random]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
[clojure.string :as str]))
(def ^:private default-seed 42)
@ -71,6 +81,7 @@
joined)))
(defn- serve-file!
"Serves an existing artifact with its MIME type, or returns a missing status."
[^js res file]
(if (and (some? file) (fs/existsSync file))
(let [ext (path/extname file)]
@ -102,10 +113,12 @@
"port" (.-port (.address server))})))))))
(defn- usage
"Returns the diagnostic pilot's command syntax."
[]
"pilot [--case SCENE/NAME] [--seed N] [--timeout-ms N] [--screenshot PATH]")
(defn- parse-args
"Resolves one case, seed, deadline and optional screenshot path."
[argv]
(let [opts (loop [args argv
opts {:seed default-seed :timeout-ms default-timeout-ms
@ -119,10 +132,9 @@
(= flag "--timeout-ms") (recur rest-args (assoc opts :timeout-ms (js/parseInt value 10)))
(= flag "--screenshot") (recur rest-args (assoc opts :screenshot value))
:else (recur rest-args (assoc opts ::invalid flag))))))
valid-seed? (fn [n] (and (integer? n) (<= 0 n 4294967295)))
valid-timeout? (fn [n] (and (integer? n) (pos? n)))]
(if (and (nil? (::invalid opts))
(valid-seed? (:seed opts)) (valid-timeout? (:timeout-ms opts))
(random/seed? (:seed opts)) (valid-timeout? (:timeout-ms opts))
(some #{(:case-id opts)} (cases/case-ids)))
opts
(do
@ -131,15 +143,68 @@
(js/process.exit 1)))))
(defn- trace
"Diagnostic line on stderr; stdout carries only the result transit string."
"Diagnostic line on stderr (transit)"
[message]
(.error js/console message))
(defn- print-result!
[result]
(println (t/encode-str result)))
"Prints the raw schema3 record (transit)"
[record]
(println (result/encode record)))
(defn- git-provenance
"Reads the revision and dirty flag without saving status text or diffs."
[root]
(try
(let [opts #js {:cwd root :encoding "utf8"}]
{:sha (str/trim (child-process/execFileSync "git" #js ["rev-parse" "HEAD"] opts))
:dirty (not (str/blank? (child-process/execFileSync "git" #js ["status" "--porcelain"] opts)))})
(catch :default _ {:sha nil :dirty nil})))
(defn- pilot-metadata
"Captures available environment and declared build facts for an unscored pilot.
Prepared artifacts lack ticket10's stamp, so their functional identity stays
unverified. Environment capture uses a fixed allowlist."
[root opts]
(let [env (into {} (keep (fn [k]
(when-some [v (unchecked-get (.-env js/process) k)] [k v])))
["BUILD_MODE" "NODE_ENV" "PENPOT_WASM_PREPARED" "PENPOT_WASM_FUNCTION_NAMES"
"CARGO_BUILD_TARGET" "CARGO_NET_OFFLINE" "COREPACK_ENABLE_NETWORK"])
cpus (array-seq (os/cpus))]
{:git (git-provenance root)
:build {:functional {:prepared-artifact-settings :unverified :cljs-profile-marks false}
:provenance {:artifact-source :prepared-public-assets :declared-env env}}
:environment {:node (.-version js/process) :playwright (.-version playwright-package)
:browser nil :platform (os/platform) :release (os/release) :arch (os/arch)
:cpu {:models (vec (distinct (map #(.-model %) cpus))) :logical-count (count cpus)}
:launch {:headless true :args ["--enable-gpu"]}}
:scored? false
:diagnostics (select-keys opts [:seed :screenshot])}))
(defn- complete-record
"Adds available preparation and attempt evidence, then records termination.
Warm setup errors leave the slot unattempted. Fresh setup belongs to the
attempted cold load and consumes its slot even when setup fails."
[run preparation evidence attempted?]
(let [id (get-in run [:plan :cases 0 :id])
run (cond-> run preparation (result/record-preparation preparation))
run (if attempted?
(result/record-attempt run (measurement/attempt id (:preparation-id preparation) false evidence))
run)
ok? (= "ok" (:status evidence))]
(result/finish-run run (.toISOString (js/Date.))
(cond-> {:reason (if ok? :completed (if attempted? :failed :preparation-failed))}
(not ok?) (assoc :failure (select-keys evidence [:status :phase :message :cause])
:partial (:partial evidence))))))
(defn- evaluate-bridge
"Calls a fixed bridge method with one Transit string and returns its Promise.
JSON quoting embeds the string in JavaScript; records use Transit only."
[^js page method text]
(.evaluate page (str "window.__benchBridge." method "(" (.stringify js/JSON text) ")")))
(defn -main
"Runs one unscored attempt and verifies Node/browser summaries of its raw record."
[& argv]
(trace "pilot: parsing args")
(let [opts (parse-args (or argv []))
@ -150,7 +215,15 @@
seed (:seed opts)
selected (some #(when (= (:id %) (:case-id opts)) %)
(cases/collect-cases {:master-seed seed}))
deadline (:timeout-ms opts)]
deadline (:timeout-ms opts)
started-at (.toISOString (js/Date.))
initial-run (result/create-run {:run-id (str "pilot-" started-at) :started-at started-at
:plan {:cases [selected] :warmups 0 :repetitions 1
:timeout-policy {:attempt-ms deadline :pilot-total-ms deadline}}
:metadata (pilot-metadata root opts)})
preparation-ref (atom nil)
attempted-ref (atom false)
run-ref (atom initial-run)]
(-> (start-server! bundle js-dir html)
(.then
(fn [info]
@ -164,33 +237,41 @@
evaluate-load
(fn [^js page] (fn [_]
(trace "pilot: bridge ready, evaluating")
;; NOTE: a string page-function evaluates
;; as an expression, so inline the args
;; into an IIFE; a passed arg would
;; never arrive.
(let [request (t/encode-str
{:case selected
:module-url "/js/render-wasm.js"
:wasm-url "/js/render-wasm.wasm"})
call (str "(async () => window.__benchBridge.loadScene("
(.stringify js/JSON request)
"))()")]
(.evaluate page call))))
(when (= :fresh (:context selected))
(reset! attempted-ref true))
(let [request (t/encode-str {:case selected :timeout-ms deadline
:module-url "/js/render-wasm.js"
:wasm-url "/js/render-wasm.wasm"})]
(-> (evaluate-bridge page "prepareScene" request)
(.then (fn [text]
(let [prepared (t/decode-str text)]
(if (= "ok" (:status prepared))
(do
(reset! preparation-ref (:preparation prepared))
(reset! attempted-ref true)
(evaluate-bridge page "runPrepared"
(t/encode-str {:preparation-id (get-in prepared [:preparation :preparation-id])
:timeout-ms deadline})))
text))))))))
attach-screenshot-path
(fn [^js page ^js version] (fn [result]
(let [out {:seed seed
:case (:id selected)
:scored false
:attempts 1
:result (t/decode-str result)
:browser {:chromium version}}]
(if-let [shot (:screenshot opts)]
(-> (.screenshot
page
#js {"path" shot})
(.then (fn [_]
(assoc out :screenshot shot))))
out))))
(fn [^js page version] (fn [text]
(let [out (complete-record
(assoc-in @run-ref [:metadata :environment :browser] version)
@preparation-ref (t/decode-str text) @attempted-ref)
report (summary/summarize out)
check-report (fn [_]
(-> (evaluate-bridge page "summarize" (result/encode out))
(.then (fn [browser-summary]
(when-not (= report (t/decode-str browser-summary))
(throw (ex-info "Node/browser summaries differ" {})))
(trace "pilot: Node/browser summaries agree")
(trace (format/format-run report))
out))))]
(reset! run-ref out)
(-> (if-let [shot (:screenshot opts)]
(.screenshot page #js {"path" shot})
(js/Promise.resolve nil))
(.then check-report)))))
viewport #js {"viewport"
#js {"width" 1920 "height" 1080}
"deviceScaleFactor" 2}
@ -206,6 +287,7 @@
(fn [^js pw-browser]
(reset! browser-ref pw-browser)
(let [version (.version pw-browser)]
(swap! run-ref assoc-in [:metadata :environment :browser] version)
(-> (.newContext pw-browser viewport)
(.then
(fn [^js context]
@ -237,7 +319,7 @@
(.then (fn [_]
(print-result! out)
(js/process.exit
(if (= "ok" (get-in out [:result :status])) 0 1)))))))
(if (= :completed (get-in out [:termination :reason])) 0 1)))))))
(.catch (fn [cause]
;; The work chain may have left a browser open
;; (guard timeout, blocked page, post-launch
@ -249,9 +331,18 @@
(js/Promise.resolve nil))
(.then (fn [_] (close!)))
(.then (fn [_]
(println "pilot harness failure:"
(or (ex-message cause) (str cause)))
(if (= :running (get-in @run-ref [:termination :reason]))
(print-result! (complete-record @run-ref @preparation-ref
{:status "failed" :phase "pilot-harness"
:message (or (ex-message cause) (str cause))
:cause (failures/describe-cause cause)}
@attempted-ref))
(print-result! (assoc @run-ref :termination
{:reason :diagnostic-failed :cause (failures/describe-cause cause)})))
(js/process.exit 1))))))))))
(.catch (fn [cause]
(println "pilot startup failure:" (or (ex-message cause) (str cause)))
(print-result! (complete-record initial-run nil
{:status "failed" :phase "pilot-startup"
:message (or (ex-message cause) (str cause))
:cause (failures/describe-cause cause)} false))
(js/process.exit 1))))))

73
frontend/test/benches/render_wasm/random.cljs Normal file
View File

@ -0,0 +1,73 @@
;; 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.random
"Seeded numbers for reproducible scene construction and report resampling.
A seed is an integer from 0 through 4294967295. Each call to `create` owns a
separate Mulberry32 state. Calling the returned function advances that state
and returns a number in [0,1). Equal seeds and equal numbers of calls produce
equal sequences, including seed zero."
(:require
[app.common.types.color :as clr]
[app.common.uuid :as uuid]))
(defn seed?
"Returns true for integers from 0 through 4294967295, inclusive."
[value]
(and (integer? value) (<= 0 value 4294967295)))
(defn create
"Returns a function that draws seeded numbers from [0, 1) using Mulberry32.
Each function owns its state. A seed outside the uint32 range throws
::invalid-seed; uint32 means an integer from 0 through 4294967295."
[seed]
(when-not (seed? seed)
(throw (ex-info "random seed must be an integer in [0, 2^32)"
{:type ::invalid-seed :seed seed})))
(let [state (volatile! (bit-or seed 0))]
(fn []
(let [s (bit-or (+ @state 0x6d2b79f5) 0)
_ (vreset! state s)
v (js/Math.imul (bit-xor s (unsigned-bit-shift-right s 15))
(bit-or s 1))
v (bit-xor v (+ v (js/Math.imul (bit-xor v (unsigned-bit-shift-right v 7))
(bit-or v 61))))
v (bit-xor v (unsigned-bit-shift-right v 14))]
(/ (unsigned-bit-shift-right v 0) 4294967296)))))
(defn round3
"Rounds to 3 decimal places"
[value]
(/ (js/Math.round (* 1000 value)) 1000))
(defn rng-float
"Draws a float in `[min, max)` from the random source."
[rng min max]
(+ min (* (rng) (- max min))))
(defn rng-int
"Draws an integer in `[min, max)` from the random source."
[rng min max]
(js/Math.floor (rng-float rng min max)))
(defn rng-uuid
"Draws a deterministic uuid from two 32-bit values of the random source."
[rng]
(uuid/custom (rng-int rng 0 4294967296)
(rng-int rng 0 4294967296)))
(defn rng-hex-color
"Draws a hex color from three RGB channels in [0,256)."
[rng]
(clr/rgb->hex [(rng-int rng 0 256) (rng-int rng 0 256) (rng-int rng 0 256)]))
(defn rng-opacity
"Draws opacity in [0.1,0.999], rounded to three decimal places."
[rng]
(min 0.999 (round3 (rng-float rng 0.1 1))))

247
frontend/test/benches/render_wasm/report/analysis.cljs Normal file
View File

@ -0,0 +1,247 @@
;; 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.report.analysis
"Calculates statistics and median changes for benchmark measurements.
summarize/summarize-metric passes one vector to `statistics`. An attempt is
one execution of a benchmark case. Each value represents one attempt, including
a batch average: the attempt's total divided by its number of inner calls.
compare/compare-runs passes baseline and candidate vectors to changes.
Those callers exclude warmups, failed attempts and invalid measurements,
and supply already validated finite values and resolved settings.
Report fields use maps: {:value number} contains a calculated number;
{:lower number :upper number} contains interval bounds; {:reason keyword}
explains why a valid input cannot supply that result. For example,
:insufficient-observations can include :minimum, the required sample size.
This contract preserves unavailable fields through Transit and lets
report.format display the reason. quantile and resolve-settings reject invalid
arguments at their boundaries.
Resampling draws a sample of the original size, allowing repeated values.
Repeating this process gives medians whose central :confidence fraction
defines a percentile confidence interval. These intervals describe the
supplied measurements; evolving caches limit their interpretation.
:method-version records the calculation version for saved reports.
Version 1 is the only supported version."
(:require
[app.common.schema :as sm]
[benches.render-wasm.random :as random]))
(def defaults
"Default settings for report calculations.
:draws is the number of replacement samples; :seed controls their generator.
:confidence is the fraction between interval bounds. :min-ci, :min-p95 and
:min-p99 set the required observation counts for those results.
:method-version records the calculation rules, currently version 1."
{:method-version 1
:draws 2000
:seed 0x70656e70
:confidence 0.95
:min-ci 10
:min-p95 100
:min-p99 500})
(def schema:settings
"Valid settings for calculation version, sample draws, seed and report limits.
The seed is an integer in [0, 2^32); confidence lies strictly between 0 and 1.
Draw and minimum observation counts are positive integers."
[:map {:closed true}
[:method-version [:= 1]]
[:draws [:int {:min 1 :max 2147483647}]]
[:seed [:fn random/seed?]]
[:confidence [:fn #(and (number? %) (js/Number.isFinite %) (< 0 % 1))]]
[:min-ci [:int {:min 1}]]
[:min-p95 [:int {:min 1}]]
[:min-p99 [:int {:min 1}]]])
(defn resolve-settings
"Returns defaults merged with supplied overrides, or defaults for nil.
Accepts a complete settings map too. Invalid values or unknown keys throw
::invalid-settings. Callers store this resolved map with their results."
[overrides]
(let [settings (merge defaults overrides)]
(when-not (sm/validate schema:settings settings)
(throw (ex-info "invalid analysis settings" {:type ::invalid-settings
:settings settings})))
settings))
(defn- finite-number?
"Returns true for numbers other than NaN and positive or negative infinity."
[value]
(and (number? value) (js/Number.isFinite value)))
(defn- observation-vector
"Returns a vector of supplied finite measurements, or an empty vector for nil.
A non-sequence or any non-finite/non-numeric entry throws ::invalid-observations.
Report callers exclude unusable raw entries before requesting calculations."
[values]
(when-not (and (or (nil? values) (sequential? values))
(every? finite-number? values))
(throw (ex-info "observations must be a sequence of finite numbers"
{:type ::invalid-observations :values values})))
(vec values))
(defn- sorted-quantile
"Returns an interpolated value from a nonempty vector sorted in ascending order.
Probability 0 selects the minimum, 1 the maximum and 0.5 the median.
At position (count - 1) * probability, a fractional index gives the weighted
average of its neighboring values. Callers validate the probability."
[sorted probability]
(let [position (* (dec (count sorted)) probability)
lower (js/Math.floor position)
upper (js/Math.ceil position)
weight (- position lower)]
(+ (* (- 1 weight) (nth sorted lower))
(* weight (nth sorted upper)))))
(defn quantile
"Returns an interpolated quantile as a number, or nil for an empty sequence.
Probability 0 selects the minimum, 1 the maximum and 0.5 the median.
For example, [1 2 3 4] at probability 0.25 gives 1.75.
Values must form a sequence of finite numbers. Probability must be a finite
number in [0, 1]. Invalid arguments throw ::invalid-observations or
::invalid-probability; report callers handle unavailable results separately."
[values probability]
(when-not (and (finite-number? probability) (<= 0 probability 1))
(throw (ex-info "quantile probability must be a finite number in [0, 1]"
{:type ::invalid-probability :probability probability})))
(let [values (observation-vector values)]
(when (seq values)
(sorted-quantile (vec (sort values)) probability))))
(defn- number-result
"Returns {:value value} for a finite calculated number.
Non-finite arithmetic yields {:reason :undefined-estimate}, so a report can
retain the field and explain why it has no number."
[value]
(if (finite-number? value)
{:value value}
{:reason :undefined-estimate}))
(defn- resampled-median
"Returns the median of one replacement sample drawn from a nonempty vector.
The sample has the same size as values; repeated indices are allowed.
rng is a function that draws a number from [0, 1) on each call."
[values rng]
(let [n (count values)
sample (vec (sort (repeatedly n #(nth values (js/Math.floor (* n (rng)))))))]
(sorted-quantile sample 0.5)))
(defn- interval
"Returns bounds containing the central confidence fraction of calculated draws.
For confidence 0.95, the bounds are the 0.025 and 0.975 quantiles.
Empty or non-finite draws yield {:reason :undefined-bootstrap-estimate};
callers retain that reason rather than discarding an undefined draw."
[values confidence]
(if (and (seq values) (every? finite-number? values))
(let [sorted (vec (sort values))
tail (/ (- 1 confidence) 2)
lower (sorted-quantile sorted tail)
upper (sorted-quantile sorted (- 1 tail))]
(if (and (finite-number? lower) (finite-number? upper))
{:lower lower :upper upper}
{:reason :undefined-bootstrap-estimate}))
{:reason :undefined-bootstrap-estimate}))
(defn- quantile-result
"Returns a quantile in {:value number} when the sorted sample reaches minimum.
Otherwise returns {:reason :insufficient-observations :minimum minimum}.
Probability selects the quantile, such as 0.95 for p95."
[sorted probability minimum]
(if (< (count sorted) minimum)
{:reason :insufficient-observations :minimum minimum}
(number-result (sorted-quantile sorted probability))))
(defn statistics
"Returns statistics for one vector of finite measurement values.
`values` must be an already validated vector of finite measurements, and
`settings` must be the complete map returned by `resolve-settings`.
Callers enforce these preconditions.
`:count` is the number of original measurements, including each batch average
once. Numeric fields contain {:value number}; unavailable fields contain
{:reason keyword}, with :minimum for an observation requirement.
:sample-sd is sqrt(sum((x - mean)^2) / (count - 1)).
:mad is the median absolute distance from the median, without scaling.
:p95 and :p99 are observed 0.95 and 0.99 quantiles. :median-ci contains
bounds from repeatedly drawing replacement samples and taking their medians.
Empty input retains every field with :no-valid-observations.
Insufficient counts and undefined arithmetic retain reasons."
[values settings]
(let [{:keys [draws seed confidence min-ci min-p95 min-p99]} settings
n (count values)]
(if (zero? n)
(let [absent {:reason :no-valid-observations}]
{:count 0 :mean absent :median absent :min absent :max absent
:sample-sd absent :mad absent :median-ci absent :p95 absent :p99 absent})
(let [sorted (vec (sort values))
mean (reduce (fn [total x] (+ total (/ x n))) 0 values)
median (sorted-quantile sorted 0.5)
rng (random/create seed)]
{:count n
:mean (number-result mean)
:median (number-result median)
:min (number-result (first sorted))
:max (number-result (peek sorted))
:sample-sd (if (= n 1)
{:reason :insufficient-observations :minimum 2}
(number-result (js/Math.sqrt
(reduce (fn [total x]
(+ total (/ (* (- x mean) (- x mean)) (dec n))))
0 values))))
:mad (number-result (sorted-quantile (vec (sort (map #(js/Math.abs (- % median)) values))) 0.5))
:median-ci (if (< n min-ci)
{:reason :insufficient-observations :minimum min-ci}
(interval (vec (repeatedly draws #(resampled-median values rng)))
confidence))
:p95 (quantile-result sorted 0.95 min-p95)
:p99 (quantile-result sorted 0.99 min-p99)}))))
(defn changes
"Returns candidate-minus-baseline changes between the two observed medians.
Inputs must be already validated vectors of finite measurements; settings
must be the complete map returned by resolve-settings. Callers enforce these
preconditions. :absolute and :percentage contain
{:value number}; :absolute-ci and :percentage-ci contain {:lower number :upper number}.
Any unavailable result carries {:reason keyword} instead.
Each interval draw samples both inputs independently, allowing repeated
measurements, then calculates the change between those two sample medians.
Both original counts must reach :min-ci. A zero observed baseline suppresses
percentages; any zero resampled baseline suppresses the whole percentage
interval. Empty inputs or undefined arithmetic retain reasons.
compare/compare-runs calls this once per shared metric."
[baseline candidate settings]
(let [{:keys [draws seed confidence min-ci]} settings]
(if (or (empty? baseline) (empty? candidate))
{:absolute {:reason :no-valid-observations}
:percentage {:reason :no-valid-observations}
:absolute-ci {:reason :no-valid-observations}
:percentage-ci {:reason :no-valid-observations}}
(let [b (sorted-quantile (vec (sort baseline)) 0.5)
c (sorted-quantile (vec (sort candidate)) 0.5)
supported (and (>= (count baseline) min-ci) (>= (count candidate) min-ci))
rng (random/create seed)
samples (when supported
(vec (repeatedly draws
(fn [] [(resampled-median baseline rng)
(resampled-median candidate rng)]))))
low-count {:reason :insufficient-observations :minimum min-ci}]
{:absolute (number-result (- c b))
:percentage (if (zero? b) {:reason :zero-baseline} (number-result (* 100 (/ (- c b) b))))
:absolute-ci (if supported
(interval (mapv (fn [[b c]] (- c b)) samples) confidence)
low-count)
:percentage-ci (cond
(zero? b) {:reason :zero-baseline}
(not supported) low-count
(some (fn [[b _]] (zero? b)) samples) {:reason :zero-bootstrap-baseline}
:else (interval (mapv (fn [[b c]] (* 100 (/ (- c b) b))) samples)
confidence))}))))

173
frontend/test/benches/render_wasm/report/compare.cljs Normal file
View File

@ -0,0 +1,173 @@
;; 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.report.compare
"Offline comparisons of paired cases from two saved RunRecords.
By default, comparisons are made between matching cases with equal settings.
It is however possible to to explicitly select pairs allowing different case
definitions or to entirely deactivate compatibility checks."
(:require
[benches.render-wasm.report.analysis :as analysis]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
[clojure.string :as str]))
(defn resolve-case
"Resolves an identifier or exact name only from the saved plan.
Unknown or ambiguous selectors report the available names for that file."
[run selector]
(let [ids (mapv :id (get-in run [:plan :cases]))
matches (if (some #(= selector %) ids)
[selector]
(filterv #(= selector (result/case-name %)) ids))]
(if (= 1 (count matches))
(first matches)
(throw (ex-info (str "cannot resolve saved case " (pr-str selector)
"; available cases: " (str/join ", " (map result/case-name ids)))
{:type ::unknown-case :selector selector :available (mapv result/case-name ids)})))))
(defn selector-pair
"Resolves the prototype CLI's single A,B selector into the extensible pair list.
A belongs to baseline; B belongs to candidate. Force is a separate option."
[baseline candidate selector]
(let [names (str/split selector #"," -1)]
(when-not (and (= 2 (count names)) (every? seq names))
(throw (ex-info "--compare-cases requires one exact A,B pair" {:type ::invalid-selector})))
[[(resolve-case baseline (first names)) (resolve-case candidate (second names))]]))
(defn- difference
"Returns one compatibility difference when recorded values disagree."
[field baseline candidate waived?]
(when (not= baseline candidate)
{:field field :baseline baseline :candidate candidate :waived? waived?}))
(defn- preparations
"Returns chronological preparation evidence for an exact saved case."
[run id]
(filterv #(= id (:case-id %)) (:preparations run)))
(defn- preparation-facts
"Collects distinct recorded fingerprints or graphics, independent of prep IDs."
[run id field]
(set (map field (preparations run id))))
(defn- execution-settings
"Selects declared execution inputs; recipe versions and text remain provenance."
[definition]
(select-keys definition [:scene :scene-seed :params :view :context :completion
:batch-size :preparation :operation]))
(defn- evidence-differences
"Checks cross-run equality plus missing or varying preparation evidence."
[field baseline candidate waived?]
(concat
(when-let [d (difference field baseline candidate waived?)] [d])
(when (or (not= 1 (count baseline)) (not= 1 (count candidate)))
[{:field [field :incomplete-or-varying-evidence]
:baseline baseline :candidate candidate :waived? waived?}])))
(defn- pair-differences
"Checks saved inputs, graphics, environment, build, sampling and metric definitions."
[baseline candidate b c shared explicit?]
(let [bdef (some #(when (= b (:id %)) %) (get-in baseline [:plan :cases]))
cdef (some #(when (= c (:id %)) %) (get-in candidate [:plan :cases]))]
(vec
(concat
(keep identity
[(difference :execution (execution-settings bdef) (execution-settings cdef) explicit?)
(difference :environment (get-in baseline [:metadata :environment])
(get-in candidate [:metadata :environment]) false)
(difference :functional-build (get-in baseline [:metadata :build :functional])
(get-in candidate [:metadata :build :functional]) false)
(difference :warmups (get-in baseline [:plan :warmups])
(get-in candidate [:plan :warmups]) false)
(difference :timeout-policy (get-in baseline [:plan :timeout-policy])
(get-in candidate [:plan :timeout-policy]) false)
(difference :scored? (get-in baseline [:metadata :scored?])
(get-in candidate [:metadata :scored?]) false)])
(evidence-differences :fingerprint (preparation-facts baseline b :fingerprint)
(preparation-facts candidate c :fingerprint) explicit?)
(evidence-differences :effective-graphics (preparation-facts baseline b :effective-graphics)
(preparation-facts candidate c :effective-graphics) false)
(mapcat (fn [metric-id]
(let [bdefs (summary/definitions baseline b metric-id)
cdefs (summary/definitions candidate c metric-id)]
(evidence-differences [:metric metric-id] (set bdefs) (set cdefs) false)))
shared)))))
(defn- side-report
"Reports one side with saved definitions, setup evidence and sample accounting."
[run id shared analysis force]
{:case-id id
:definition (some #(when (= id (:id %)) %) (get-in run [:plan :cases]))
:preparations (preparations run id)
:remaining (get-in run [:remaining id])
:metrics (into {} (map (fn [metric-id]
[metric-id (summary/summarize-metric run id metric-id analysis force)])) shared)})
(defn- compare-pair
"Compares shared numeric observations after resolving the compatibility policy."
[baseline candidate [b c] explicit? force analysis]
(let [b (resolve-case baseline b)
c (resolve-case candidate c)
candidate-ids (set (summary/metric-ids candidate c))
shared (filterv #(contains? candidate-ids %) (summary/metric-ids baseline b))
mismatches (pair-differences baseline candidate b c shared explicit?)]
(when (empty? shared)
(throw (ex-info "selected cases have no shared metric identifiers"
{:type ::no-shared-metrics :baseline b :candidate c})))
(when (and (not force) (some #(not (:waived? %)) mismatches))
(throw (ex-info "incompatible saved runs"
{:type ::incompatible :baseline b :candidate c :mismatches mismatches})))
{:explicit? explicit?
:mismatches mismatches
:baseline (side-report baseline b shared analysis force)
:candidate (side-report candidate c shared analysis force)
:metrics (into {}
(map (fn [id]
[id (analysis/changes (:values (summary/observations baseline b id))
(:values (summary/observations candidate c id))
analysis)]))
shared)}))
(defn- provenance
"Retains run identity and facts without using Git/run/time as compatibility gates."
[run]
(select-keys run [:run-id :started-at :ended-at :metadata :termination]))
(defn compare-runs
"Creates a `:comparison` from constructed or decoded `:run-record`.
Inputs must already satisfy the `:runrecord` contract. Encoding validates the
returned comparison at the boundary.
Default pairs are over identical identifiers. This can be overriden by picking
explicit pairs, or by bypassing all checks.
- `:pairs` accepts an extensible vector of explicit [baseline candidate] pairs.
- `:force` allows comparing any two records, but obviusly only compares metrics
common to both.
- `:analysis` resolves from method defaults, independent of each run's defaults."
([baseline candidate] (compare-runs baseline candidate {}))
([baseline candidate {:keys [pairs force analysis]}]
(let [explicit? (some? pairs)
candidate-ids (set (map :id (get-in candidate [:plan :cases])))
pairs (or pairs (->> (get-in baseline [:plan :cases])
(map :id)
(filter #(contains? candidate-ids %))
(mapv #(vector % %))))
analysis (analysis/resolve-settings analysis)]
(when (or (empty? pairs) (not (every? #(and (vector? %) (= 2 (count %))) pairs)))
(throw (ex-info "comparison needs saved case pairs"
{:type ::invalid-pairs
:baseline (mapv (comp result/case-name :id) (get-in baseline [:plan :cases]))
:candidate (mapv (comp result/case-name :id) (get-in candidate [:plan :cases]))})))
{:type :comparison :schema-version 2 :analysis analysis
:baseline (provenance baseline) :candidate (provenance candidate)
:forced? (boolean force)
:source-coverage summary/source-coverage :interpretation summary/interpretation
:pairs (mapv #(compare-pair baseline candidate % explicit? force analysis) pairs)})))

102
frontend/test/benches/render_wasm/report/format.cljs Normal file
View File

@ -0,0 +1,102 @@
;; 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.report.format
"Text formatting for run summaries and saved comparisons.
Text leads with observed median, bootstrap interval and distinct counts.
Full statistics and forced differences retain units and observation bases."
(:require
[benches.render-wasm.result :as result]
[clojure.string :as str]))
(defn- number->text
"Formats safe integers in decimal form and other estimates with six significant digits."
[value]
(if (js/Number.isSafeInteger value)
(str value)
(.toPrecision value 6)))
(defn- estimate->text
"Formats an estimate, interval or suppression reason."
[estimate]
(cond
(contains? estimate :value) (number->text (:value estimate))
(contains? estimate :lower) (str "[" (number->text (:lower estimate)) ", "
(number->text (:upper estimate)) "]")
:else (str "unavailable (" (some-> (:reason estimate) name)
(when-some [n (:minimum estimate)] (str "; need " n)) ")")))
(defn- counts->text
"Prints valid, invalid, absent, failed, unattempted and excluded warmup counts."
[{:keys [valid invalid absent failed unattempted warmup]}]
(str "valid=" valid " invalid=" invalid " absent=" absent " failed=" failed
" unattempted=" unattempted " warmup=" warmup))
(defn metric->text
"Formats all statistics for one metric, including batch basis and support limits."
[id {:keys [definitions counts statistics]}]
(str (pr-str id) " median " (estimate->text (or (:median statistics) statistics))
" CI " (estimate->text (or (:median-ci statistics) statistics)) " | " (counts->text counts)
"\n definitions " (pr-str definitions)
(if-let [reason (:reason statistics)]
(str "\n unavailable (" (name reason) ")")
(str "\n mean " (estimate->text (:mean statistics))
" min " (estimate->text (:min statistics)) " max " (estimate->text (:max statistics))
" sample SD " (estimate->text (:sample-sd statistics))
" MAD " (estimate->text (:mad statistics))
" p95 " (estimate->text (:p95 statistics)) " p99 " (estimate->text (:p99 statistics))))))
(defn format-run
"Formats a summary without browser, registry or renderer access."
[{:keys [run-id metadata analysis termination source-coverage interpretation cases]}]
(str "Run " (pr-str run-id) " " (pr-str termination)
"\nGit " (pr-str (:git metadata))
"\nAnalysis " (pr-str analysis)
"\n" source-coverage "\n" interpretation
(when (some #(get-in % [:effective-graphics :software])
(mapcat :preparations cases)) "\nSOFTWARE RENDERER recorded")
(apply str (map (fn [{:keys [case-id remaining metrics]}]
(str "\n\nCase " (result/case-name case-id)
" remaining " (pr-str remaining)
(apply str (map (fn [[id metric]] (str "\n" (metric->text id metric))) metrics))))
cases))))
(defn- side->text
"Displays one comparison side's definitions, preparation facts and observations."
[label {:keys [case-id definition preparations metrics]}]
(str "\n" label " " (result/case-name case-id)
"\n case " (pr-str definition)
"\n preparations " (pr-str preparations)
(apply str (map (fn [[id metric]] (str "\n" (metric->text id metric))) metrics))))
(defn format-comparison
"Formats changes, exploratory intervals and every recorded mismatch.
Forced output displays both saved definitions and original metric definitions."
[{:keys [baseline candidate analysis forced? source-coverage interpretation pairs]}]
(str (when forced? "FORCED COMPARISON: compatibility differences bypassed\n")
(when (some #(get-in % [:effective-graphics :software])
(mapcat (fn [pair] (concat (get-in pair [:baseline :preparations])
(get-in pair [:candidate :preparations]))) pairs))
"SOFTWARE RENDERER recorded\n")
"Baseline " (pr-str (:run-id baseline)) " Git " (pr-str (get-in baseline [:metadata :git]))
"\nCandidate " (pr-str (:run-id candidate)) " Git " (pr-str (get-in candidate [:metadata :git]))
"\nAnalysis " (pr-str analysis) "\n" source-coverage "\n" interpretation
(apply str
(map (fn [{:keys [baseline candidate mismatches metrics]}]
(str "\n\nPair " (result/case-name (:case-id baseline)) ","
(result/case-name (:case-id candidate))
(when (seq mismatches) (str "\nMISMATCHES " (pr-str mismatches)))
(side->text "Baseline" baseline)
(side->text "Candidate" candidate)
(str/join "\n"
(map (fn [[id change]]
(str "\n" (pr-str id)
" median change " (estimate->text (:absolute change))
" CI " (estimate->text (:absolute-ci change))
"; percent " (estimate->text (:percentage change))
" CI " (estimate->text (:percentage-ci change)))) metrics))))
pairs))))

115
frontend/test/benches/render_wasm/report/summarize.cljs Normal file
View File

@ -0,0 +1,115 @@
;; 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.report.summarize
"Reports use saved definitions and explicit metrics from raw RunRecords.
Warmups and failed attempts supply no observations. A completed attempt can
supply valid, invalid or absent metrics independently. Unattempted slots remain
separate. Batches and render slices never multiply observation counts."
(:require
[benches.render-wasm.report.analysis :as analysis]
[benches.render-wasm.result :as result]))
(def source-coverage
"Limits of compatibility checks on stored inputs and settings."
"Recorded inputs and settings checked; runtime-helper identity is unverified. Git SHA and dirty state record provenance.")
(def interpretation
"Scope of intervals and of renderer completion measurements."
"Intervals are exploratory and conditional on observed runs. Caches can evolve between attempts; repeat whole runs to investigate findings. Full denotes renderer submission completion. Render-call totals measure synchronous elapsed calls, without exclusive CPU or GPU-completion claims.")
(defn case-attempts
"Returns chronological attempts for an exact saved case identifier."
[run case-id]
(filterv #(= case-id (:case-id %)) (:attempts run)))
(defn metric-ids
"Discovers dynamic metric identifiers in first-appearance order, including failures."
[run case-id]
(vec (distinct (mapcat (comp keys :metrics) (case-attempts run case-id)))))
(defn definitions
"Returns every recorded definition for a metric, so drift remains visible."
[run case-id metric-id]
(->> (case-attempts run case-id)
(keep #(get-in % [:metrics metric-id]))
(map result/metric-definition)
(distinct)
(vec)))
(defn observation-definitions
"Returns definitions only for valid, completed observations outside warmups."
[run case-id metric-id]
(->> (case-attempts run case-id)
(remove :warmup?)
(filter #(= :completed (:outcome %)))
(keep #(get-in % [:metrics metric-id]))
(remove :invalid-reason)
(map result/metric-definition)
(distinct)
(vec)))
(defn observations
"Returns valid values and distinct counts for a saved case/metric.
:unattempted counts remaining measured repetitions; case :remaining also
retains pending warmups. :warmup counts executed warmup attempts.
Failed measured attempts count as failed even with partial metrics.
Failed warmups count as warmup attempts."
[run case-id metric-id]
(reduce
(fn [out {:keys [warmup? outcome metrics]}]
(let [entry (get metrics metric-id)
kind (cond
warmup? :warmup
(= :failed outcome) :failed
(not (contains? metrics metric-id)) :absent
(:invalid-reason entry) :invalid
:else :valid)]
(cond-> (update-in out [:counts kind] inc)
(= kind :valid) (update :values conj (:value entry)))))
{:values []
:counts {:valid 0 :invalid 0 :absent 0 :failed 0
:unattempted (get-in run [:remaining case-id :repetitions])
:warmup 0}}
(case-attempts run case-id)))
(defn summarize-metric
"Computes statistics for one dynamic metric with its definitions and counts."
([run case-id metric-id analysis] (summarize-metric run case-id metric-id analysis false))
([run case-id metric-id analysis force?]
(let [{:keys [values counts]} (observations run case-id metric-id)
definitions (definitions run case-id metric-id)
mixed? (> (count (observation-definitions run case-id metric-id)) 1)]
{:definitions definitions
:counts counts
:mixed-definitions? mixed?
:statistics (if (and mixed? (not force?))
{:reason :inconsistent-metric-definitions :count (count values)}
(analysis/statistics values analysis))})))
(defn summarize
"Builds a portable report from a constructed or decoded RunRecord.
The run must already satisfy the RunRecord contract. Reporting uses one
resolved method.
Overrides affect reporting without changing the stored RunRecord."
([run] (summarize run nil))
([run overrides]
(let [analysis (analysis/resolve-settings (merge (:analysis run) overrides))]
{:run-id (:run-id run)
:metadata (:metadata run)
:analysis analysis
:termination (:termination run)
:source-coverage source-coverage
:interpretation interpretation
:cases (mapv (fn [{:keys [id] :as definition}]
{:case-id id
:definition definition
:preparations (filterv #(= id (:case-id %)) (:preparations run))
:remaining (get-in run [:remaining id])
:metrics (into {} (map (fn [metric-id]
[metric-id (summarize-metric run id metric-id analysis)]))
(metric-ids run id))})
(get-in run [:plan :cases]))})))

351
frontend/test/benches/render_wasm/result.cljs Normal file
View File

@ -0,0 +1,351 @@
;; 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.result
"Raw benchmark records retain scheduled work and its chronological evidence.
RunRecord schema3 stores a saved plan, provenance, preparations and attempts.
A preparation owns a scene fingerprint and setup diagnostics. An attempt uses
one scheduled slot, even on failure. Metric entries declare value, unit,
semantics, observation basis and zero policy. Comparison schema2 stores an
analysis of two saved runs. Everything is encoded with transit."
(:require
[app.common.schema :as sm]
[app.common.transit :as transit]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.report.analysis :as analysis]))
(def schema:basis
"An attempt total or an average over a declared number of inner calls."
[:or
[:map {:closed true} [:kind [:= :attempt-total]]]
[:map {:closed true} [:kind [:= :per-call-average]] [:calls [:int {:min 1}]]]])
(def schema:metric-definition
"The declared meaning and observation basis of a metric.
Authors define units and semantics; the schema accepts any vocabulary.
Comparison checks their equality without interpreting or converting them."
[:map {:closed true}
[:unit :any]
[:semantics :any]
[:basis schema:basis]
[:zero-policy [:enum :positive :allow]]])
(def schema:metric
"An explicit observation, including raw invalid values and their reason."
[:map {:closed true}
[:value :any]
[:unit :any]
[:semantics :any]
[:basis schema:basis]
[:zero-policy [:enum :positive :allow]]
[:invalid-reason [:maybe keyword?]]])
(def schema:fingerprint
"The content digest of the actual validated starting snapshot."
[:map {:closed true}
[:encoding-version [:= 1]]
[:algorithm [:= :sha-256]]
[:digest [:re #"^[0-9a-f]{64}$"]]])
(def schema:preparation
"Untimed setup evidence for one owned scene."
[:map {:closed true}
[:preparation-id some?]
[:case-id some?]
[:fingerprint schema:fingerprint]
[:effective-graphics map?]
[:diagnostics map?]])
(def schema:attempt
"One chronological execution; failure consumes a slot and may retain evidence."
[:map {:closed true}
[:ordinal [:int {:min 0}]]
[:case-id some?]
[:preparation-id [:maybe some?]]
[:warmup? boolean?]
[:outcome [:enum :completed :failed]]
[:metrics [:map-of :any schema:metric]]
[:trace map?]
[:failure {:optional true} map?]
[:partial {:optional true} map?]])
(def schema:metadata
"Git, functional build settings, environment and diagnostic provenance."
[:map {:closed true}
[:git [:map [:sha [:maybe string?]] [:dirty [:maybe boolean?]]]]
[:build [:map [:functional map?] [:provenance {:optional true} map?]]]
[:environment map?]
[:scored? boolean?]
[:diagnostics {:optional true} map?]])
(def schema:termination
"A run's current state or final reason, with optional diagnostic details."
[:map [:reason keyword?]])
(def schema:run
"RunRecord schema3. Cases are saved definitions, independent of any registry.
Build :functional holds compatibility settings; :provenance holds identities."
[:map {:closed true}
[:type [:= :run-record]]
[:schema-version [:= 3]]
[:run-id some?]
[:started-at string?]
[:ended-at [:maybe string?]]
[:plan [:map {:closed true}
[:cases [:vector [:map [:id some?]]]]
[:warmups [:int {:min 0}]]
[:repetitions [:int {:min 0}]]
[:timeout-policy [:map [:attempt-ms [:int {:min 1}]]]]]]
[:metadata schema:metadata]
[:analysis analysis/schema:settings]
[:preparations [:vector schema:preparation]]
[:attempts [:vector schema:attempt]]
[:remaining [:map-of :any [:map {:closed true}
[:warmups [:int {:min 0}]]
[:repetitions [:int {:min 0}]]]]]
[:termination schema:termination]])
(def schema:estimate
"A finite computed estimate or an explicit suppression reason."
[:or
[:map {:closed true} [:value [:fn #(and (number? %) (js/Number.isFinite %))]]]
[:map {:closed true} [:reason keyword?] [:minimum {:optional true} [:int {:min 1}]]]])
(def schema:interval
"Finite ordered percentile bounds or an explicit suppression reason."
[:or
[:and
[:map {:closed true}
[:lower [:fn #(and (number? %) (js/Number.isFinite %))]]
[:upper [:fn #(and (number? %) (js/Number.isFinite %))]]]
[:fn #(<= (:lower %) (:upper %))]]
[:map {:closed true} [:reason keyword?] [:minimum {:optional true} [:int {:min 1}]]]])
(def schema:statistics
"Observed statistics and supported intervals for one metric."
[:or
[:map {:closed true}
[:count [:int {:min 0}]]
[:mean schema:estimate] [:median schema:estimate] [:min schema:estimate] [:max schema:estimate]
[:sample-sd schema:estimate] [:mad schema:estimate] [:p95 schema:estimate] [:p99 schema:estimate]
[:median-ci schema:interval]]
[:map {:closed true} [:reason keyword?] [:count [:int {:min 0}]]]])
(def schema:metric-report
"Every metric definition, distinct counts and computed estimates."
[:map {:closed true}
[:definitions [:vector schema:metric-definition]]
[:counts [:map {:closed true}
[:valid [:int {:min 0}]] [:invalid [:int {:min 0}]] [:absent [:int {:min 0}]]
[:failed [:int {:min 0}]] [:unattempted [:int {:min 0}]] [:warmup [:int {:min 0}]]]]
[:mixed-definitions? boolean?]
[:statistics schema:statistics]])
(def schema:comparison-side
"One saved case's definition, preparations and shared metric reports."
[:map {:closed true}
[:case-id some?] [:definition [:map [:id some?]]]
[:preparations [:vector schema:preparation]]
[:remaining [:map {:closed true} [:warmups [:int {:min 0}]] [:repetitions [:int {:min 0}]]]]
[:metrics [:map-of :any schema:metric-report]]])
(def schema:provenance
"Saved run identity, timestamps, metadata and termination for comparison."
[:map {:closed true}
[:run-id some?] [:started-at string?] [:ended-at [:maybe string?]]
[:metadata schema:metadata] [:termination schema:termination]])
(def schema:comparison
"Comparison schema2 retains resolved analysis, differences and per-side reports."
[:map {:closed true}
[:type [:= :comparison]]
[:schema-version [:= 2]]
[:analysis analysis/schema:settings]
[:baseline schema:provenance]
[:candidate schema:provenance]
[:forced? boolean?]
[:source-coverage string?]
[:interpretation string?]
[:pairs [:vector
[:map {:closed true}
[:explicit? boolean?]
[:mismatches [:vector [:map {:closed true}
[:field :any] [:baseline :any] [:candidate :any] [:waived? boolean?]]]]
[:baseline schema:comparison-side] [:candidate schema:comparison-side]
[:metrics [:map-of :any [:map {:closed true}
[:absolute schema:estimate] [:percentage schema:estimate]
[:absolute-ci schema:interval] [:percentage-ci schema:interval]]]]]]]])
(defn case-name
"Returns the saved case identifier as shown in commands and reports."
[id]
(if (keyword? id) (subs (str id) 1) (str id)))
(defn- require-valid!
"Rejects malformed external data with enough context for the caller."
[valid? message data]
(when-not valid?
(throw (ex-info message (assoc data :type ::invalid-record)))))
(defn invalid-reason
"Classifies one raw measurement without changing its value.
Nil denotes an explicit missing value; an absent metric has no entry.
Aggregate durations require positivity unless their entry permits zero."
[{:keys [value zero-policy]}]
(cond
(nil? value) :missing-value
(not (number? value)) :not-numeric
(not (js/Number.isFinite value)) :non-finite
(neg? value) :negative
(and (zero? value) (= zero-policy :positive)) :below-resolution
:else nil))
(defn metric
"Validates an explicit metric definition and attaches its invalidity reason.
Authored invalidity reasons survive when the numeric value otherwise qualifies."
[entry]
(let [entry (assoc entry :invalid-reason (or (invalid-reason entry)
(:invalid-reason entry)))]
(require-valid! (sm/validate schema:metric entry) "invalid metric entry" {:metric entry})
entry))
(defn metric-definition
"Returns unit, semantics, basis and zero policy without a measurement value."
[entry]
(select-keys entry [:unit :semantics :basis :zero-policy]))
(defn- initial-remaining
"Creates each saved case's fixed budget of unattempted slots."
[{:keys [cases warmups repetitions]}]
(into {} (map (fn [{:keys [id]}] [id {:warmups warmups :repetitions repetitions}])) cases))
(defn- consume-slot
"Consumes a warmup or measured slot; completed and failed attempts count alike."
[remaining {:keys [case-id warmup?]}]
(let [kind (if warmup? :warmups :repetitions)
path [case-id kind]
left (get-in remaining path)]
(require-valid! (and (some? left) (pos? left)) "no planned slot for attempt"
{:case-id case-id :slot kind})
(require-valid! (or warmup? (zero? (get-in remaining [case-id :warmups])))
"measured attempt precedes planned warmups" {:case-id case-id})
(update-in remaining path dec)))
(defn check-run
"Validates schema3 and chronological accounting at a saved-data boundary.
Unsupported versions fail without invoking a legacy reader or case registry."
[run]
(when-not (and (= :run-record (:type run)) (= 3 (:schema-version run)))
(throw (ex-info "unsupported RunRecord format" {:type ::unsupported-format
:schema-version (:schema-version run)})))
(require-valid! (sm/validate schema:run run) "invalid RunRecord" {})
(let [case-ids (mapv :id (get-in run [:plan :cases]))
preps (:preparations run)
prep-ids (mapv :preparation-id preps)
prep-map (into {} (map (juxt :preparation-id identity)) preps)
left (reduce consume-slot (initial-remaining (:plan run)) (:attempts run))]
(require-valid! (= (count case-ids) (count (set case-ids))) "duplicate saved case" {})
(require-valid! (= (count prep-ids) (count (set prep-ids))) "duplicate preparation" {})
(require-valid! (every? #(contains? (set case-ids) %) (map :case-id preps)) "unknown preparation case" {})
(require-valid! (= left (:remaining run)) "remaining slots disagree with attempts" {})
(doseq [[ordinal attempt] (map-indexed vector (:attempts run))]
(require-valid! (= ordinal (:ordinal attempt)) "attempts are not chronological" {})
(when-some [id (:preparation-id attempt)]
(require-valid! (= (:case-id attempt) (:case-id (get prep-map id)))
"attempt references an unknown or different preparation" {:preparation-id id}))
(require-valid! (or (= :failed (:outcome attempt)) (some? (:preparation-id attempt)))
"completed attempt needs a preparation" {})
(doseq [[id entry] (:metrics attempt)]
(require-valid! (= (:invalid-reason entry)
(or (invalid-reason entry) (:invalid-reason entry)))
"metric validity disagrees with raw value" {:metric-id id})))
(when (= :completed (get-in run [:termination :reason]))
(require-valid! (every? #(every? zero? (vals %)) (vals left))
"completed run still has unattempted slots" {})))
run)
(defn create-run
"Creates an empty raw run from externally supplied identities and facts.
The plan defaults to 3 warmups, 10 repetitions and a 30000 ms attempt timeout.
For each case, all warmup slots precede measured slots. Failed attempts consume
their slot too; attempts retain chronological order across cases."
[{:keys [run-id started-at plan metadata analysis]}]
(let [plan (merge {:warmups 3 :repetitions 10 :timeout-policy {:attempt-ms 30000}} plan)]
(check-run {:type :run-record :schema-version 3
:run-id run-id :started-at started-at :ended-at nil
:plan plan :metadata metadata :analysis (analysis/resolve-settings analysis)
:preparations [] :attempts [] :remaining (initial-remaining plan)
:termination {:reason :running}})))
(defn- check-open!
"Checks that a constructed or decoded run still accepts evidence."
[run]
(require-valid! (= :running (get-in run [:termination :reason])) "run already terminated" {}))
(defn record-preparation
"Checks and appends new setup evidence without consuming an attempt slot.
The run must come from create-run or decode; earlier evidence is trusted."
[run preparation]
(check-open! run)
(require-valid! (sm/validate schema:preparation preparation) "invalid preparation" {})
(require-valid! (contains? (:remaining run) (:case-id preparation)) "unknown preparation case" {})
(require-valid! (not-any? #(= (:preparation-id preparation) (:preparation-id %))
(:preparations run))
"duplicate preparation" {})
(update run :preparations conj preparation))
(defn record-attempt
"Checks and appends one new execution, consuming its scheduled slot.
The run must come from create-run or decode, and metric entries from metric.
Missing preparation is allowed for failures before scene setup completes.
Earlier attempts are trusted; encode and decode check the complete record."
[run attempt]
(check-open! run)
(let [attempt (-> (merge {:preparation-id nil :metrics {} :trace {}} attempt)
(assoc :ordinal (count (:attempts run))))]
(require-valid! (sm/validate schema:attempt attempt) "invalid attempt" {})
(when-some [id (:preparation-id attempt)]
(let [preparation (some #(when (= id (:preparation-id %)) %) (:preparations run))]
(require-valid! (= (:case-id attempt) (:case-id preparation))
"attempt references an unknown or different preparation" {:preparation-id id})))
(require-valid! (or (= :failed (:outcome attempt)) (some? (:preparation-id attempt)))
"completed attempt needs a preparation" {})
(-> run
(update :attempts conj attempt)
(update :remaining consume-slot attempt))))
(defn finish-run
"Records externally supplied end time and termination details, retaining gaps."
[run ended-at termination]
(check-open! run)
(require-valid! (sm/validate schema:termination termination) "invalid termination" {})
(require-valid! (not= :running (:reason termination)) "termination needs an end reason" {})
(when (= :completed (:reason termination))
(require-valid! (every? #(every? zero? (vals %)) (vals (:remaining run)))
"completed run still has unattempted slots" {}))
(assoc run :ended-at ended-at :termination termination))
(defn check-record
"Validates a supported run or comparison at a Transit boundary."
[record]
(case (:type record)
:run-record (check-run record)
:comparison (do
(when-not (= 2 (:schema-version record))
(throw (ex-info "unsupported Comparison format" {:type ::unsupported-format})))
(require-valid! (sm/validate schema:comparison record) "invalid Comparison" {})
record)
(throw (ex-info "unsupported benchmark format" {:type ::unsupported-format}))))
(defn encode
"Encodes a supported record with transit."
[record]
(codec/encode-str (check-record record)))
(defn decode
"Decodes from transit and validates a supported record."
[text]
(check-record (transit/decode-str text)))

180
frontend/test/benches/render_wasm/runtime/protocol.cljs
View File

@ -18,8 +18,7 @@
- `restore` puts the camera back to the case's initial view, then drains.
Callers run it outside timing.
- `start-camera!`, `preview-view!`, `animate-view!`, `sleep!` and
`finish-camera!` form one Promise-aware camera session. `interact` is a
thin adapter for callers with a predeclared frame vector.
`finish-camera!` form one Promise-aware camera session.
`hooks` supplies clock, scheduling and renderer operations. The browser
supplies real capabilities; tests supply fakes.
@ -45,7 +44,7 @@
Frame types come from `app.common.render-wasm.wasm`: FRAME_TYPE_PARTIAL and
FRAME_TYPE_VIEWPORT_READY continue, FRAME_TYPE_FULL completes, FRAME_TYPE_NONE
or anything else fails the attempt. The previous returned frame type becomes the
next call's flags. `restore` and the final drain of `interact` start with
next call's flags. `restore` and the final camera-session drain start with
the SyncTiles flag immediately (no rAF); a fresh drain can start with
different flags and wait for a frame.
@ -85,7 +84,16 @@
[app.common.render-wasm.wasm :as wasm]))
(defn- partial-error
"Attaches available trace evidence to a rejection without adding clock reads.
Deeper failure evidence takes precedence over a caller's earlier state."
[cause evidence]
(ex-info (or (ex-message cause) "renderer protocol failed")
(assoc (ex-data cause) :partial (merge evidence (:partial (ex-data cause))))
(if (some? (ex-data cause)) (ex-cause cause) cause)))
(defn- next-render-timestamp
"Gets an immediate clock timestamp or awaits the next frame timestamp."
[{:keys [now frame]} immediate?]
(if immediate?
(js/Promise.resolve (now))
@ -105,13 +113,17 @@
:flags flags
:frame-type frame-type
:duration-ms (- ended-ms started-ms)}]
(check)
(try
(check)
(catch :default cause
(throw (partial-error cause {:slices (conj (:slices state) slice)}))))
{:state (update state :slices conj slice)
:frame-type frame-type
:ended-ms ended-ms}))
(defn- valid-frame-type?
"Recognizes the progressive and final renderer frame types."
[frame-type]
(or (= frame-type wasm/FRAME_TYPE_PARTIAL)
(= frame-type wasm/FRAME_TYPE_VIEWPORT_READY)
@ -119,6 +131,7 @@
(defn- viewport-ready-time
"Keeps the first submission boundary that exposes the requested viewport."
[current-ready-ms frame-type ended-ms origin-ms]
(or current-ready-ms
(when (or (= frame-type wasm/FRAME_TYPE_VIEWPORT_READY)
@ -127,6 +140,7 @@
(defn- advance-drain-state
"Updates progressive completion or rejects with the available raw slices."
[{:keys [viewport-ready-ms] :as state}
frame-type
ended-ms
@ -134,7 +148,8 @@
(when-not (valid-frame-type? frame-type)
(throw (ex-info (str "unexpected frame type: " (pr-str frame-type))
{:type ::unexpected-frame-type
:frame-type frame-type})))
:frame-type frame-type
:partial (select-keys state [:slices :viewport-ready-ms])})))
(assoc state
:flags frame-type
:viewport-ready-ms
@ -144,10 +159,12 @@
origin-ms)))
(defn- drain-complete?
"Tests for the renderer's Full submission boundary."
[frame-type]
(= frame-type wasm/FRAME_TYPE_FULL))
(defn- drain-result
"Returns raw slices and completion times from the drain origin."
[{:keys [slices viewport-ready-ms]}
ended-ms
origin-ms]
@ -199,7 +216,9 @@
(if (drain-complete? frame-type)
(drain-result next-state ended-ms origin)
(step next-state false)))))))]
(step next-state false)))))
(.catch (fn [cause]
(throw (partial-error cause (select-keys state [:slices :viewport-ready-ms])))))))]
(step {:flags flags
:slices []
@ -252,41 +271,49 @@
(js/Promise.reject cause))))
(defn preview-view!
"Awaits a session or session promise, then submits one cached preview after
exactly one rAF. The call span includes `_set_view` and cache rendering."
"Awaits a session and submits one cached preview after exactly one rAF.
The call span includes view update and cache rendering. Failures retain
completed previews and authored pauses without adding clock reads."
[session-p view]
(-> (js/Promise.resolve session-p)
(.then (fn [{:keys [hooks] :as session}]
(let [{:keys [now frame check render-from-cache set-view]} hooks]
(check)
(-> (frame)
(.then (fn [timestamp]
(check)
(let [input-ms (now)
call-start (now)]
(set-view view)
(let [cache-start (now)]
(render-from-cache)
(let [cache-end (now)]
(check)
(assoc session
:view view
:last-input-ms input-ms
:active-end-ms (now)
:cached-slices
(conj (:cached-slices session)
{:timestamp timestamp
:duration-ms (- cache-end cache-start)
:view-and-preview-ms (- cache-end call-start)})))))))))))))
(let [{:keys [now frame check render-from-cache set-view]} hooks
evidence (select-keys session [:cached-slices :authored-sleeps])]
(try
(check)
(-> (frame)
(.then (fn [timestamp]
(check)
(let [input-ms (now)
call-start (now)]
(set-view view)
(let [cache-start (now)]
(render-from-cache)
(let [cache-end (now)
slices (conj (:cached-slices session)
{:timestamp timestamp
:duration-ms (- cache-end cache-start)
:view-and-preview-ms (- cache-end call-start)})]
(try
(check)
(catch :default cause
(throw (partial-error cause (assoc evidence :cached-slices slices)))))
(assoc session :view view :last-input-ms input-ms
:active-end-ms (now) :cached-slices slices))))))
(.catch (fn [cause] (throw (partial-error cause evidence)))))
(catch :default cause
(js/Promise.reject (partial-error cause evidence)))))))))
(defn animate-view!
"Submits exactly `steps` serial, linearly interpolated full views."
"Submits exactly `steps` serial, linearly interpolated full views.
Invalid steps retain the session's completed previews and pauses."
[session-p {:keys [to steps]}]
(-> (js/Promise.resolve session-p)
(.then (fn [{from :view :as session}]
(when-not (and (integer? steps) (pos? steps))
(throw (ex-info "camera steps must be a positive integer"
{:type ::invalid-steps :steps steps})))
{:type ::invalid-steps :steps steps
:partial (select-keys session [:cached-slices :authored-sleeps])})))
(reduce (fn [session-p i]
(let [t (/ i steps)]
(preview-view! session-p
@ -297,29 +324,36 @@
(range 1 (inc steps)))))))
(defn sleep!
"Awaits an authored pause inside the active span and records its actual time."
"Awaits an authored pause inside the active span and records its actual time.
Rejections retain earlier completed previews and pauses without new timers."
[session-p requested-ms]
(-> (js/Promise.resolve session-p)
(.then (fn [{:keys [hooks] :as session}]
(let [{:keys [now sleep check]} hooks]
(when-not (and (number? requested-ms)
(js/Number.isFinite requested-ms)
(<= 0 requested-ms))
(throw (ex-info "sleep duration must be a nonnegative finite number"
{:type ::invalid-sleep :requested-ms requested-ms})))
(check)
(let [started-ms (now)]
(-> (sleep requested-ms)
(.then (fn [_]
(check)
(let [ended-ms (now)]
(-> session
(assoc :active-end-ms ended-ms)
(update :authored-sleeps conj
{:requested-ms requested-ms
:actual-ms (- ended-ms started-ms)}))))))))))))
(let [{:keys [now sleep check]} hooks
evidence (select-keys session [:cached-slices :authored-sleeps])]
(try
(when-not (and (number? requested-ms)
(js/Number.isFinite requested-ms)
(<= 0 requested-ms))
(throw (ex-info "sleep duration must be a nonnegative finite number"
{:type ::invalid-sleep :requested-ms requested-ms})))
(check)
(let [started-ms (now)]
(-> (sleep requested-ms)
(.then (fn [_]
(check)
(let [ended-ms (now)]
(-> session
(assoc :active-end-ms ended-ms)
(update :authored-sleeps conj
{:requested-ms requested-ms
:actual-ms (- ended-ms started-ms)})))))
(.catch (fn [cause] (throw (partial-error cause evidence))))))
(catch :default cause
(js/Promise.reject (partial-error cause evidence)))))))))
(defn- finish-interaction
"Ends the camera and returns final metrics, retaining trace evidence on failure."
[{:keys [now check set-view-end] :as hooks}
{:keys [settle-ms started-ms cached-slices last-input-ms active-end-ms authored-sleeps]}]
(check)
@ -345,43 +379,23 @@
:set-view-end-ms set-view-end-ms
:time-to-viewport-ready-ms viewport-ready-ms
:time-to-full-ms full-ms
:last-input-to-full-ms (- (now) last-input-ms)}))))))
:last-input-to-full-ms (- (now) last-input-ms)}))
(.catch (fn [cause]
(throw (partial-error cause {:cached-slices cached-slices
:authored-sleeps authored-sleeps}))))))))
(defn finish-camera!
"Awaits a session, settles, ends the camera and drains through Full."
"Awaits a session, settles, ends the camera and drains through Full.
Failures keep completed cached previews and authored pauses."
[session-p]
(-> (js/Promise.resolve session-p)
(.then (fn [{:keys [hooks settle-ms] :as session}]
((:check hooks))
(-> ((:sleep hooks) settle-ms)
(.then (fn [_]
(finish-interaction hooks session))))))))
(defn interact
"Replays `frames` (a vector of `{:scale :x :y}` views) as one gesture
and resolves the interaction metrics (see the namespace docstring).
The flow is:
interact
├─ start-camera!
├─ preview-view! × N
└─ finish-camera!
├─ settle
├─ set-view-end
└─ drain
Each frame waits for rAF, records the input time, sets the view and
times one cached preview into `:cached-slices`. Afterwards the declared
`settle-ms` elapses, `_set_view_end` is timed on its own, and a SyncTiles
immediate drain runs with its origin at finalization start, so the final
times include `_set_view_end` while reporting it separately."
[hooks
{:keys [frames settle-ms]}]
(-> (reduce preview-view!
(start-camera! {:hooks hooks :view (first frames)}
{:settle-ms settle-ms})
frames)
(finish-camera!)))
(let [evidence (select-keys session [:cached-slices :authored-sleeps])]
(try
((:check hooks))
(-> ((:sleep hooks) settle-ms)
(.then (fn [_] (finish-interaction hooks session)))
(.catch (fn [cause] (throw (partial-error cause evidence)))))
(catch :default cause
(js/Promise.reject (partial-error cause evidence)))))))))

9
frontend/test/benches/render_wasm/scenes/paths.cljs
View File

@ -11,6 +11,7 @@
[app.common.types.path :as path]
[benches.render-wasm.builder :as sb :include-macros true]
[benches.render-wasm.declarations :as decl :include-macros true]
[benches.render-wasm.random :refer [rng-int]]
[benches.render-wasm.runtime.camera :as camera]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -31,10 +32,10 @@
(defn- curved-content
[{:keys [width height]}]
(fn [rng]
(let [x (sb/rng-int rng 0 width)
y (sb/rng-int rng 0 height)
w (sb/rng-int rng 20 100)
h (sb/rng-int rng 20 100)]
(let [x (rng-int rng 0 width)
y (rng-int rng 0 height)
w (rng-int rng 20 100)
h (rng-int rng 20 100)]
(path/from-plain
[{:command :move-to :params {:x x :y y}}
{:command :curve-to

7
frontend/test/benches/render_wasm/scenes/plus.cljs
View File

@ -10,6 +10,7 @@
[app.common.types.path :as path]
[benches.render-wasm.builder :as sb :include-macros true]
[benches.render-wasm.declarations :as decl :include-macros true]
[benches.render-wasm.random :refer [rng-int]]
[benches.render-wasm.runtime.camera :as camera]))
(def ^:private default-params
@ -24,9 +25,9 @@
(defn- plus-content
[{:keys [width height]}]
(fn [rng]
(let [x (sb/rng-int rng 20 width)
y (sb/rng-int rng 20 height)
r (sb/rng-int rng 10 40)]
(let [x (rng-int rng 20 width)
y (rng-int rng 20 height)
r (rng-int rng 10 40)]
(path/from-plain
[{:command :move-to :params {:x (- x r) :y y}}
{:command :line-to :params {:x (+ x r) :y y}}

4
frontend/test/frontend_tests/benches/boolean_test.cljs
View File

@ -12,7 +12,7 @@
[app.common.types.path.segment :as segm]
[app.common.uuid :as uuid]
[benches.render-wasm.builder :as b :include-macros true]
[benches.render-wasm.snapshot :as common]
[benches.render-wasm.snapshot :as snapshot]
[cljs.test :as t :include-macros true]
[frontend-tests.benches.test-helpers :as helpers]))
@ -27,7 +27,7 @@
children (helpers/children-of instance (:id bool))]
(t/is (= :bool (:type bool)))
(t/is (= :difference (:bool-type bool)))
(t/is (= (:id bool) (common/ref-id instance :l-shape)))
(t/is (= (:id bool) (snapshot/ref-id instance :l-shape)))
(t/is (= 2 (count children)))
(t/is (= [(:id (first children)) (:id (second children))] (:shapes bool)))
(t/is (= [(:id bool) (:id bool)]

27
frontend/test/frontend_tests/benches/builder_test.cljs
View File

@ -5,12 +5,15 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.benches.builder-test
"Tests canonical scene construction and the shared seeded number generator.
Fixed random sequences preserve scene draws during generator extraction."
(:require
[app.common.uuid :as uuid]
[benches.render-wasm.builder :as b :include-macros true]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.random :as random]
[benches.render-wasm.scenes.rects]
[benches.render-wasm.snapshot :as common]
[benches.render-wasm.snapshot :as snapshot]
[cljs.test :as t :include-macros true]
[frontend-tests.benches.test-helpers :as helpers]))
@ -27,6 +30,24 @@
(t/is (= (build) (build)))
(t/is (not= (build) (build {:seed 43}))))
(t/deftest shared-generator-retains-scene-draws-and-independent-state
(doseq [[seed expected] [[0 [1144304738 1416247 958946056 627933444 2007157716]]
[42 [2581720956 1925393290 3661312704 2876485805 750819978]]
[4294967295 [3850105811 813802916 3073704848 4054706436 3630262831]]]]
(let [first-source (random/create seed)
second-source (random/create seed)]
(t/is (= expected (mapv #(* 4294967296 %) (repeatedly 5 first-source))))
(t/is (= expected (mapv #(* 4294967296 %) (repeatedly 5 second-source))))
(t/is (every? #(and (<= 0 %) (< % 1)) (repeatedly 1000 first-source)))))
(let [rng (:rng @(b/start {:seed 42}))]
(t/is (= [2581720956 1925393290 3661312704 2876485805 750819978]
(mapv #(* 4294967296 %) (repeatedly 5 rng))))))
(t/deftest shared-generator-rejects-invalid-seeds
(doseq [seed [-1 4294967296 1.5 nil false "42" js/NaN js/Infinity]]
(t/is (= ::random/invalid-seed
(:type (helpers/failure-data #(random/create seed)))))))
(t/deftest rectangle-workload-keeps-default-count
(let [instance (build {:seed 42 :count 1000})
rects (helpers/root-shapes instance)]
@ -146,8 +167,8 @@
(t/deftest built-snapshot-feeds-the-scene-api
(let [instance (b/scene {:seed 1}
(b/rect :hero {}))
order (common/upload-order instance)
hero-id (common/ref-id instance :hero)]
order (snapshot/upload-order instance)
hero-id (snapshot/ref-id instance :hero)]
(t/is (= [uuid/zero hero-id] (mapv :id order)))))
(t/deftest invalid-labels-are-rejected

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

@ -402,7 +402,7 @@
(decl/unregister-scene! :contracts-replacecase))))
(t/deftest invalid-master-seed-is-rejected
(doseq [seed [-1 4294967296 "42"]]
(doseq [seed [-1 4294967296 "42" nil 0.5 js/NaN js/Infinity js/-Infinity]]
(t/is (= ::cases/invalid-master-seed
(:type (failure-data #(cases/collect-cases {:master-seed seed}))))
(str seed))))

102
frontend/test/frontend_tests/benches/fingerprint_test.cljs Normal file
View File

@ -0,0 +1,102 @@
;; 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.fingerprint-test
"Tests content identity with production records, paths and collection types.
Validated scene snapshots retain child order even when maps reorder."
(:require
[app.common.geom.matrix :as matrix]
[app.common.geom.point :as point]
[app.common.transit :as transit]
[app.common.types.objects-map :as objects-map]
[app.common.types.path.impl :as path]
[app.common.types.shape :as shape]
[app.common.uuid :as uuid]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.fingerprint :as fingerprint]
[benches.render-wasm.snapshot :as snapshot]
[cljs.test :as t :include-macros true]
[clojure.string :as str]
[linked.map :as linked-map]
[linked.set :as linked-set]))
(def a #uuid "00000000-0000-0000-0000-000000000001")
(def b #uuid "00000000-0000-0000-0000-000000000002")
(defn- starting-snapshot
"Builds and validates two canonical rectangles under the root frame."
[]
(snapshot/validate!
{:objects {uuid/zero (shape/setup-shape {:id uuid/zero :type :frame :name "Root"
:x 0 :y 0 :width 100 :height 100
:parent-id uuid/zero :frame-id uuid/zero :shapes [a b]})
a (shape/setup-shape {:id a :type :rect :name "A"
:x 0 :y 0 :width 10 :height 10 :parent-id uuid/zero :frame-id uuid/zero})
b (shape/setup-shape {:id b :type :rect :name "B"
:x 20 :y 20 :width 10 :height 10 :parent-id uuid/zero :frame-id uuid/zero})}
:refs {:a a :b b}}))
(t/deftest unordered-representations-have-one-fingerprint
(let [scene (starting-snapshot)
first (assoc scene :extra {:map (array-map :a 1 :b 2)
:compound (array-map [:a 1] {:x 1 :y 2} [:b 2] #{:one :two})
:set (set (range 20))})
second (-> scene
(update :objects #(into {} (reverse (seq %))))
(assoc :refs (array-map :b b :a a)
:extra {:set (set (reverse (range 20)))
:compound (array-map [:b 2] #{:two :one} [:a 1] (array-map :y 2 :x 1))
:map (array-map :b 2 :a 1)}))]
(t/is (= (fingerprint/snapshot-text first) (fingerprint/snapshot-text second)))
(t/is (= (fingerprint/fingerprint first) (fingerprint/fingerprint second)))))
(t/deftest ordered-collections-and-child-order-change-the-fingerprint
(let [scene (starting-snapshot)]
(t/is (not= (fingerprint/fingerprint scene)
(fingerprint/fingerprint (assoc-in scene [:objects uuid/zero :shapes] [b a]))))
(t/is (not= (fingerprint/fingerprint (assoc scene :extra [1 2]))
(fingerprint/fingerprint (assoc scene :extra [2 1]))))
(t/is (not= (fingerprint/fingerprint (assoc scene :extra (into linked-set/empty-linked-set [1 2])))
(fingerprint/fingerprint (assoc scene :extra (into linked-set/empty-linked-set [2 1])))))
(t/is (not= (fingerprint/fingerprint (assoc scene :extra (into linked-map/empty-linked-map [[:a 1] [:b 2]])))
(fingerprint/fingerprint (assoc scene :extra (into linked-map/empty-linked-map [[:b 2] [:a 1]])))))
(t/is (not= (fingerprint/fingerprint (assoc scene :extra (point/point 1 2)))
(fingerprint/fingerprint (assoc scene :extra {:x 1 :y 2}))))))
(t/deftest unrepresentable-transit-content-never-gets-a-misleading-fingerprint
(let [scene (starting-snapshot)]
(t/is (= ::codec/unrepresentable-value
(try
(fingerprint/fingerprint (assoc scene :extra {"__proto__" "value"}))
nil
(catch :default cause (:type (ex-data cause))))))))
(t/deftest objects-map-materializes-before-hashing-and-production-tags-survive
(let [scene (starting-snapshot)
wrapped (update scene :objects objects-map/wrap)
data (assoc scene :extra {:point (point/point 1 2)
:matrix (matrix/matrix)
:path (path/path-data [{:command :move-to :params {:x 1 :y 2}}
{:command :line-to :params {:x 3 :y 4}}])})
text (fingerprint/snapshot-text data)]
(t/is (= (fingerprint/fingerprint scene) (fingerprint/fingerprint wrapped)))
(t/is (not (str/includes? (fingerprint/snapshot-text wrapped) "penpot/objects-map")))
(t/is (str/includes? text "~#shape"))
(t/is (str/includes? text "~#point"))
(t/is (str/includes? text "~#matrix"))
(t/is (str/includes? text "~#penpot/path-data"))
(t/is (= (fingerprint/fingerprint data)
(fingerprint/fingerprint (transit/decode-str (transit/encode-str data)))))))
(t/deftest digest-has-a-fixed-encoding-version-and-known-sha256-vector
;; The verbose Transit map for {:objects {} :refs {}} is canonical text.
(t/is (= "{\"~:objects\":{},\"~:refs\":{}}"
(fingerprint/snapshot-text {:objects {} :refs {}})))
(let [fp (fingerprint/fingerprint {:objects {} :refs {}})]
(t/is (= 1 (:encoding-version fp)))
(t/is (= :sha-256 (:algorithm fp)))
(t/is (= "ceb57067506683f5a0e80615bc9dd6f6d16325e333864da705fa4916fbdfe52d"
(:digest fp)))))

12
frontend/test/frontend_tests/benches/geometry_scenes_test.cljs
View File

@ -14,7 +14,7 @@
[benches.render-wasm.scenes.masks]
[benches.render-wasm.scenes.paths]
[benches.render-wasm.scenes.plus]
[benches.render-wasm.snapshot :as common]
[benches.render-wasm.snapshot :as snapshot]
[cljs.test :as t :include-macros true]
[frontend-tests.benches.test-helpers :as helpers]))
@ -33,8 +33,8 @@
(mapv :command content)))
(t/is (pos? (:width (:selrect first))))
(t/is (pos? (:height (:selrect first))))
(t/is (= (mapv :id shapes) (mapv :id (rest (common/upload-order scene)))))
(t/is (= scene (common/validate! scene)))))
(t/is (= (mapv :id shapes) (mapv :id (rest (snapshot/upload-order scene)))))
(t/is (= scene (snapshot/validate! scene)))))
(t/deftest plus-paths-have-two-crossing-open-lines
(let [build (get-in @decl/registry [:scenes :plus :build])
@ -52,7 +52,7 @@
"the second line is vertical")
(t/is (< (get-in c [:params :y]) (get-in d [:params :y])))
(t/is (seq (:strokes first)))
(t/is (= scene (common/validate! scene)))))
(t/is (= scene (snapshot/validate! scene)))))
(t/deftest mask-child-order-and-descendants-are-reachable
(let [build (get-in @decl/registry [:scenes :masks :build])
@ -61,7 +61,7 @@
group (first groups)
children (helpers/children-of scene (:id group))
mask (first children)
uploaded (common/upload-order scene)]
uploaded (snapshot/upload-order scene)]
(t/is (= 24 (count groups)))
(t/is (= 241 (count (:objects scene))) "root, groups and their nine children")
(t/is (= (:id group) (get-in scene [:refs [:mask 0]])))
@ -74,7 +74,7 @@
(t/is (= (:id group) (:id (second uploaded))))
(t/is (= (:id mask) (:id (nth uploaded 2))))
(t/is (= (count (:objects scene)) (count uploaded)))
(t/is (= scene (common/validate! scene)))))
(t/is (= scene (snapshot/validate! scene)))))
(t/deftest camera-cases-share-each-scene-seed
(doseq [scene-id [:paths :plus :masks]]

293
frontend/test/frontend_tests/benches/lifecycle_test.cljs
View File

@ -8,14 +8,19 @@
"Tests the browser bridge with fake DOM and renderer boundaries.
It covers bridge input, ownership, disposal and `load-scene` with fake
canvases and a fake Emscripten factory. Protocol timing tests use an
injected clock in `frontend-tests.benches.protocol-test`."
canvases and a fake Emscripten factory. Progressive frames use an optional
clock at the browser boundary."
(:require
[app.common.render-wasm.wasm :as wasm]
[app.common.transit :as transit]
[benches.render-wasm.browser.bridge :as browser]
[benches.render-wasm.cases :as cases]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
[cljs.test :as t :include-macros true]))
;; Forward declaration: entry-test helpers below build args against the
@ -193,10 +198,10 @@
(t/is (< current @@#'browser/owner-epoch*) "current owner disposed")))))
(t/deftest bridge-exposes-pilot-entries
(let [keys (js/Object.keys browser/bridge)]
(t/is (some #{"ping"} keys))
(t/is (some #{"loadScene"} keys))
(t/is (some #{"dispose"} keys))))
(doseq [key ["ping" "loadScene" "prepareScene" "runPrepared" "dispose"]]
(t/is (fn? (unchecked-get browser/bridge key))
(str key " is callable through the browser ABI")))
(t/is (= "ok" (unchecked-get (.ping browser/bridge) "status"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Through-entry fake harness.
@ -237,48 +242,76 @@
:remove (fn [] (record! ["remove" id]) nil)}))
(defn- install-fake-dom!
"Installs fake `document`/`window`/`dynamicImport` globals and returns a
`:restore!` thunk that puts the previous values back. Created canvases are
numbered from 1 per installation. The import polyfill mirrors
"Installs fake DOM, import, clock and scenario globals and returns a
`restore!` thunk that restores their previous values. Created canvases are
numbered from 1 per installation.
The import polyfill mirrors
`resources/polyfills/dynamicImport.js`, which ships with the app HTML but
not with the unit-test bundle."
[]
(let [prev-document (unchecked-get js/globalThis "document")
prev-window (unchecked-get js/globalThis "window")
prev-import (unchecked-get js/globalThis "dynamicImport")
next-id (atom 0)
document #js {:createElement (fn [_]
(let [id (swap! next-id inc)]
(record! ["create" id])
(fake-canvas id)))
:body #js {:appendChild (fn [canvas]
(record! ["append" (unchecked-get canvas "id")])
canvas)}
:querySelectorAll (fn [_] #js [])}
window #js {:requestAnimationFrame
(fn [cb]
;; Park the first frame while `__benchGateRaf`
;; is set so a second load can supersede a live,
;; active owner; later frames run synchronously.
(if (and (unchecked-get js/globalThis "__benchGateRaf")
(nil? (unchecked-get js/globalThis "__benchRafCb")))
(unchecked-set js/globalThis "__benchRafCb" cb)
(cb 0))
nil)}
dynamic-import (fn [url] (js/eval (str "import(" (pr-str url) ")")))]
(let [prev-document (unchecked-get js/globalThis "document")
prev-window (unchecked-get js/globalThis "window")
prev-import (unchecked-get js/globalThis "dynamicImport")
prev-performance (unchecked-get js/globalThis "performance")
prev-now (unchecked-get js/globalThis "__benchNow")
prev-script (unchecked-get js/globalThis "__benchRenderScript")
prev-calls (unchecked-get js/globalThis "__benchCalls")
prev-factory (unchecked-get js/globalThis "__benchFactoryCalls")
prev-throw (unchecked-get js/globalThis "__benchThrowIn")
prev-gate (unchecked-get js/globalThis "__benchGateRaf")
prev-raf (unchecked-get js/globalThis "__benchRafCb")
next-id (atom 0)
document #js {:createElement (fn [_]
(let [id (swap! next-id inc)]
(record! ["create" id])
(fake-canvas id)))
:body #js {:appendChild (fn [canvas]
(record! ["append" (unchecked-get canvas "id")])
canvas)}
:querySelectorAll (fn [_] #js [])}
window #js {:requestAnimationFrame
(fn [cb]
;; Park the first frame while `__benchGateRaf`
;; is set so a second load can supersede a live,
;; active owner; later frames run synchronously.
(if (and (unchecked-get js/globalThis "__benchGateRaf")
(nil? (unchecked-get js/globalThis "__benchRafCb")))
(unchecked-set js/globalThis "__benchRafCb" cb)
(if-some [clock (unchecked-get js/globalThis "__benchNow")]
(let [timestamp (+ clock 16)]
(unchecked-set js/globalThis "__benchNow" timestamp)
(cb timestamp))
(cb 0)))
nil)}
performance #js {:now (fn []
(if-some [clock (unchecked-get js/globalThis "__benchNow")]
clock
(.now prev-performance)))}
dynamic-import (fn [url] (js/eval (str "import(" (pr-str url) ")")))]
(unchecked-set js/globalThis "document" document)
(unchecked-set js/globalThis "window" window)
(unchecked-set js/globalThis "performance" performance)
(unchecked-set js/globalThis "dynamicImport" dynamic-import)
(fn restore! []
(unchecked-set js/globalThis "document" prev-document)
(unchecked-set js/globalThis "window" prev-window)
(unchecked-set js/globalThis "performance" prev-performance)
(unchecked-set js/globalThis "__benchNow" prev-now)
(unchecked-set js/globalThis "__benchRenderScript" prev-script)
(unchecked-set js/globalThis "__benchCalls" prev-calls)
(unchecked-set js/globalThis "__benchFactoryCalls" prev-factory)
(unchecked-set js/globalThis "__benchThrowIn" prev-throw)
(unchecked-set js/globalThis "__benchGateRaf" prev-gate)
(unchecked-set js/globalThis "__benchRafCb" prev-raf)
(unchecked-set js/globalThis "dynamicImport" prev-import))))
(def ^:private factory-source
"ES module stubbing the Emscripten factory for entry tests. Records every
renderer call in `globalThis.__benchCalls`; `globalThis.__benchThrowIn`
names one module fn that throws. The instance trap answers `undefined` for
`then` and non-strings: promise assimilation would otherwise treat the
names one module fn that throws. `globalThis.__benchRenderScript` holds
optional [frame-type, duration-ms] pairs that advance `__benchNow`; absent
a script, `_render` immediately returns Full. The instance trap answers
`undefined` for `then` and non-strings: promise assimilation would treat the
instance as a never-settling thenable and hang the load. A real 16 MiB
heap with bump allocation backs `_alloc_bytes`/`HEAPU8`, so the real batch
upload assembles bytes instead of throwing on stub returns."
@ -302,7 +335,14 @@
"_alloc_bytes: function (size) { var p = heapNext; heapNext += ((size + 3) & ~3); return p; },"
"_free_bytes: function () {},"
"_read_error_code: function () { return 0; },"
"_render: function () { push(['render']); return 2; },"
"_render: function (timestamp, flags) {"
"push(['render', timestamp, flags]);"
"var script = globalThis.__benchRenderScript;"
"if (script && script.length) {"
"var next = script.shift(); globalThis.__benchNow += next[1]; return next[0];"
"}"
"return 2;"
"},"
"_clean_up: function () { push(['clean']); return 0; }"
"};"
"var inst = new Proxy(base, {"
@ -333,7 +373,9 @@
(unchecked-set js/globalThis "__benchFactoryCalls" #js [])
(unchecked-set js/globalThis "__benchThrowIn" nil)
(unchecked-set js/globalThis "__benchGateRaf" false)
(unchecked-set js/globalThis "__benchRafCb" nil))
(unchecked-set js/globalThis "__benchRafCb" nil)
(unchecked-set js/globalThis "__benchNow" nil)
(unchecked-set js/globalThis "__benchRenderScript" nil))
(defn- read-calls
"Call log as Clojure data."
@ -341,6 +383,7 @@
(js->clj (unchecked-get js/globalThis "__benchCalls")))
(defn- effect-count
"Counts recorded effects without filtering any returned evidence."
[calls effect]
(count (filter #(= effect (first %)) calls)))
@ -356,15 +399,21 @@
(defn- with-entry-env
"Installs the fake DOM, resets bench globals, then calls `f` with a
`cleanup` thunk that disposes the owner, clears the recording and restores
the globals. Call `cleanup` after asserting, before `done`."
`cleanup` thunk that disposes the owner and restores the previous globals.
Call `cleanup` after asserting, before `done`."
[f]
(let [restore-dom! (install-fake-dom!)]
(let [restore-dom! (install-fake-dom!)
cleanup (fn []
(try
(browser/dispose!)
(finally
(restore-dom!))))]
(reset-bench-globals!)
(f (fn []
(browser/dispose!)
(reset-bench-globals!)
(restore-dom!)))))
(try
(f cleanup)
(catch :default cause
(cleanup)
(throw cause)))))
(t/deftest successful-load-reaches-full
(t/async done
@ -373,7 +422,7 @@
(load-result (scene-args 7 {})
(fn [m]
(t/is (= "ok" (:status m)))
(t/is (= 1 (:render-frames m)))
(t/is (= 1 (count (get-in m [:trace :slices]))))
(t/is (= 1001 (:shapes (:scene m))) "the canonical scene uploads whole")
(let [graphics (:effective-graphics m)]
(t/is (= 1234 (:drawing-buffer-width graphics))
@ -390,6 +439,92 @@
(cleanup)
(done)))))))
(t/deftest successful-load-produces-portable-reports
(t/async done
(with-entry-env
(fn [cleanup]
(load-result
(scene-args 7 {})
(fn [evidence]
(let [case (load-case)
preparation (:preparation evidence)
run (-> (result/create-run {:run-id "load-report" :started-at "start"
:plan {:cases [case] :warmups 0 :repetitions 1}
:metadata {:git {:sha nil :dirty nil}
:build {:functional {:mode :test}}
:environment {} :scored? false}})
(result/record-preparation preparation)
(result/record-attempt (measurement/attempt (:id case) (:preparation-id preparation) false evidence))
(result/finish-run "end" {:reason :completed}))
text (result/encode run)
report (summary/summarize (result/decode text))
comparison (compare/compare-runs run run)
comparison-text (.compare browser/bridge text text (transit/encode-str {}))]
(t/is (= report (transit/decode-str (.summarize browser/bridge text))))
(t/is (= (format/format-run report) (.formatRun browser/bridge text)))
(t/is (= comparison (result/decode comparison-text)))
(t/is (= (format/format-comparison comparison) (.formatComparison browser/bridge comparison-text))))
(cleanup)
(done)))))))
(t/deftest exported-load-scene-retains-progressive-frame-evidence
(t/async done
(with-entry-env
(fn [cleanup]
(unchecked-set js/globalThis "__benchNow" 0)
(unchecked-set js/globalThis "__benchRenderScript"
#js [#js [wasm/FRAME_TYPE_PARTIAL 2]
#js [wasm/FRAME_TYPE_VIEWPORT_READY 3]
#js [wasm/FRAME_TYPE_FULL 5]])
(-> (.loadScene browser/bridge (scene-args 7 {}))
(.then (fn [text]
(t/is (string? text) "the exported loadScene returns Transit")
(let [{:keys [status slices viewport-ready-ms full-ms metrics trace scene]}
(transit/decode-str text)
retained (:slices trace)
render-calls (filterv #(= "render" (first %)) (read-calls))]
(t/is (= "ok" status))
(t/is (= {:shapes 1001 :seed 7} scene)
"the real canonical case prepares and uploads the whole scene")
(t/is (= 3 (count retained)) "all three slices cross Transit")
(t/is (= [wasm/FRAME_TYPE_PARTIAL
wasm/FRAME_TYPE_VIEWPORT_READY
wasm/FRAME_TYPE_FULL]
(mapv :frame-type retained)))
(t/is (= [0 wasm/FRAME_TYPE_PARTIAL wasm/FRAME_TYPE_VIEWPORT_READY]
(mapv :flags retained))
"ViewportReady becomes the next flags and the drain continues to Full")
(t/is (= [16 34 53] (mapv :timestamp retained))
"each continuation waits for the next frame")
(t/is (= [2 3 5] (mapv :duration-ms retained)))
(t/is (= render-calls
(mapv (fn [{:keys [timestamp flags]}]
["render" timestamp flags])
retained))
"decoded slices retain every WASM call's timestamp and flags in order")
(t/is (= slices retained) "raw and trace slices survive Transit together")
(t/is (= 37 viewport-ready-ms
(+ (:timestamp (nth retained 1))
(:duration-ms (nth retained 1))))
"viewport completion ends with the ViewportReady slice")
(t/is (= 58 full-ms
(+ (:timestamp (nth retained 2))
(:duration-ms (nth retained 2))))
"Full completion ends with the final slice")
(t/is (< viewport-ready-ms full-ms))
(t/is (= full-ms (get-in metrics [:first-render-ms :value])))
(t/is (= viewport-ready-ms (get-in metrics [:viewport-ready-ms :value])))
(t/is (= 10
(reduce + 0 (map :duration-ms retained))
(get-in metrics [:renderer-call-total-ms :value]))
"renderer-call total sums the retained calls without frame waits"))
(cleanup)
(done)))
(.catch (fn [cause]
(t/is false (str "exported progressive load failed: " cause))
(cleanup)
(done))))))))
(t/deftest invalid-args-keep-the-current-owner
(t/async done
(with-entry-env
@ -419,8 +554,8 @@
(t/is (= 100 (:settling-requested-ms m)))
(t/is (= [4] (mapv :flags (:slices m))))
(t/is (= [2] (mapv :frame-type (:slices m))))
(t/is (= 2 (effect-count (read-calls) "render"))
"restore and finalization each drain once")
(t/is (= 3 (effect-count (read-calls) "render"))
"setup, restore and finalization each drain once")
(cleanup)
(done)))))))
@ -436,6 +571,72 @@
(cleanup)
(done)))))))
(t/deftest prepared-warm-scene-runs-twice-with-one-context-and-upload
(t/async done
(with-entry-env
(fn [cleanup]
(-> (browser/prepare-scene-request
(scene-args 7 {:id :rects/pan :context :reuse
:operation {:steps 2 :dx 10 :dy 5 :settle-ms 0}}))
(.then (fn [text]
(let [prepared (transit/decode-str text)
prep (:preparation prepared)
request (transit/encode-str {:preparation-id (:preparation-id prep)})]
(t/is (= "ok" (:status prepared)))
(t/is (= 1 (get-in prep [:fingerprint :encoding-version])))
(t/is (seq (get-in prep [:diagnostics :setup-render :slices])))
(-> (browser/run-prepared request)
(.then (fn [first-text]
(let [first-result (transit/decode-str first-text)]
(t/is (= "ok" (:status first-result)))
(t/is (not (contains? (:metrics first-result) :upload-ms)))
(t/is (= prep (:preparation first-result)))
(browser/run-prepared request))))
(.then (fn [second-text]
(let [second-result (transit/decode-str second-text)
calls (read-calls)]
(t/is (= "ok" (:status second-result)))
(t/is (= prep (:preparation second-result)))
(t/is (= 1 (effect-count calls "create")))
(t/is (= 5 (effect-count calls "render")))
(t/is (= 1 (count (filter #(= ["call" "_init_shapes_pool"] %) calls))))
(t/is (= 2 (count (:cached-slices second-result))))
(cleanup)
(done))))))))
(.catch (fn [cause]
(t/is false (str "prepared reuse failed: " cause))
(cleanup)
(done))))))))
(t/deftest fresh-preparation-runs-once-and-saves-structured-metrics
(t/async done
(with-entry-env
(fn [cleanup]
(-> (browser/prepare-scene-request (scene-args 7 {}))
(.then (fn [text]
(let [request (transit/encode-str
{:preparation-id (get-in (transit/decode-str text)
[:preparation :preparation-id])})]
(t/is (zero? (effect-count (read-calls) "render")))
(-> (browser/run-prepared request)
(.then (fn [text]
(let [evidence (transit/decode-str text)]
(t/is (= "ok" (:status evidence)))
(t/is (= (:full-ms evidence) (get-in evidence [:metrics :first-render-ms :value])))
(t/is (contains? (:metrics evidence) :upload-ms))
(t/is (not (contains? (:metrics evidence) :full-ms)))
(t/is (not (contains? evidence :first-render-ms)))
(t/is (not (contains? evidence :render-frames)))
(browser/run-prepared request))))
(.then (fn [text]
(t/is (= "invalid-args" (:phase (transit/decode-str text))))
(cleanup)
(done)))))))
(.catch (fn [cause]
(t/is false (str "fresh preparation failed: " cause))
(cleanup)
(done))))))))
(t/deftest rejected-camera-body-releases-owner
(t/async done
(with-entry-env

64
frontend/test/frontend_tests/benches/protocol_test.cljs
View File

@ -142,6 +142,63 @@
(t/is (= 3 @fired) "guard fires once before and once after the render")
(done)))))))
(t/deftest progressive-failure-retains-completed-call-evidence
(t/async done
(let [clock (fake-clock 0)
calls (atom [])
hooks (drain-hooks {:clock clock :script [1 7] :calls calls})]
(-> (protocol/drain hooks {:flags 0 :origin 0 :immediate true})
(.then (fn [_] (t/is false "unknown frame must fail") (done)))
(.catch (fn [cause]
(t/is (= [1 7] (mapv :frame-type (get-in (ex-data cause) [:partial :slices]))))
(t/is (= [0 0] (mapv :duration-ms (get-in (ex-data cause) [:partial :slices]))))
(done)))))))
(t/deftest camera-failure-retains-completed-previews-and-authored-pauses
(t/async done
(let [clock (fake-clock 0)
calls (atom [])
previews (atom 0)
hooks (assoc (drain-hooks {:clock clock :script [2] :calls calls})
:render-from-cache (fn []
(if (= 1 (swap! previews inc))
((:advance! clock) 3)
(throw (ex-info "preview failed" {})))))
view {:scale 1 :x 0 :y 0}]
(-> (protocol/start-camera! {:hooks hooks :view view} {:settle-ms 0})
(protocol/preview-view! view)
(protocol/sleep! 7)
(protocol/preview-view! (assoc view :x 1))
(.then (fn [_] (t/is false "second preview must fail") (done)))
(.catch (fn [cause]
(t/is (= [3] (mapv :duration-ms (get-in (ex-data cause) [:partial :cached-slices]))))
(t/is (= [{:requested-ms 7 :actual-ms 7}]
(get-in (ex-data cause) [:partial :authored-sleeps])))
(done)))))))
(t/deftest rejected-pause-retains-earlier-camera-evidence
(t/async done
(let [clock (fake-clock 0)
sleeps (atom 0)
hooks (assoc (drain-hooks {:clock clock :script [2] :calls (atom [])})
:render-from-cache (fn [] ((:advance! clock) 3))
:sleep (fn [ms]
(if (= 1 (swap! sleeps inc))
(do ((:advance! clock) ms) (js/Promise.resolve nil))
(js/Promise.reject (ex-info "pause failed" {})))))
view {:scale 1 :x 0 :y 0}]
(-> (protocol/start-camera! {:hooks hooks :view view} {:settle-ms 0})
(protocol/preview-view! view)
(protocol/sleep! 7)
(protocol/sleep! 13)
(.then (fn [_] (t/is false "second pause must fail") (done)))
(.catch (fn [cause]
(t/is (= "pause failed" (ex-message cause)))
(t/is (= [3] (mapv :duration-ms (get-in (ex-data cause) [:partial :cached-slices]))))
(t/is (= [{:requested-ms 7 :actual-ms 7}]
(get-in (ex-data cause) [:partial :authored-sleeps])))
(done)))))))
(t/deftest restore-drains-with-sync-tiles-immediately
(t/async done
(let [clock (fake-clock 500)
@ -166,7 +223,7 @@
(t/is false (str "must resolve, threw: " cause))
(done)))))))
(t/deftest interact-times-gesture-settle-and-final-drain
(t/deftest camera-session-times-gesture-settle-and-final-drain
(t/async done
(let [clock (fake-clock 0)
renders (atom [])
@ -195,7 +252,10 @@
((:advance! clock) 5)
nil)}
frames [{:scale 1 :x 0 :y 0} {:scale 1 :x 100 :y 0}]]
(-> (protocol/interact hooks {:frames frames :settle-ms 100})
(-> (protocol/start-camera! {:hooks hooks :view (first frames)} {:settle-ms 100})
(protocol/preview-view! (first frames))
(protocol/preview-view! (second frames))
(protocol/finish-camera!)
(.then (fn [m]
(t/is (= frames @views) "every gesture frame sets the view")
(t/is (= 2 (count @cached)) "one cached preview per frame")

497
frontend/test/frontend_tests/benches/report_test.cljs Normal file
View File

@ -0,0 +1,497 @@
;; 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.report-test
"Pure tests for raw records, exploratory statistics and saved-run comparisons.
Fixtures use saved case definitions without importing a registry or renderer."
(:require
[app.common.transit :as transit]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.report.analysis :as method]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(def metric-id [:custom/latency "arbitrary metric"])
(def saved-case
"A saved definition that requires no current registration."
{:id :saved/pan :scene :saved :scene-version 4 :scene-seed 42
:params {:count 10} :view {:scale 1 :x 0 :y 0}
:operation {:steps 3} :context :reuse :completion :render-full
:batch-size 1 :preparation {}})
(def metadata
"Functional build facts are separate from ephemeral build provenance."
{:git {:sha "abc" :dirty false}
:build {:functional {:mode :release :features #{:default} :env {"PROFILE" "0"}}
:provenance {:run-marker "first"}}
:environment {:browser "Chromium 1" :node "v22" :playwright "1" :os "Linux" :cpu "CPU"}
:scored? true})
(def preparation
"One content identity and its effective graphics."
{:preparation-id :prep/one :case-id :saved/pan
:fingerprint {:encoding-version 1 :algorithm :sha-256 :digest (apply str (repeat 64 "a"))}
:effective-graphics {:vendor "vendor" :renderer "hardware" :software false :dpr 2}
:diagnostics {:upload-ms 123}})
(defn- entry
"Declares a total duration; overrides supply explicit alternative definitions."
([value] (entry value {}))
([value overrides]
(result/metric (merge {:value value :unit :ms :semantics :duration
:basis {:kind :attempt-total} :zero-policy :positive} overrides))))
(defn- error-data
"Returns boundary error data, allowing tests to assert the refusal reason."
[f]
(try (f) nil (catch :default cause (ex-data cause))))
(defn- run-with
"Creates a raw fixture with warmups and a fixed number of measured slots.
:absent and :failed retain separate outcomes. Optional overrides change facts."
([values] (run-with values {}))
([values {:keys [definition prep facts analysis warmups repetitions]
:or {definition saved-case prep preparation facts metadata warmups 0}}]
(let [id (:id definition)
prep (assoc prep :case-id id)
run (-> (result/create-run {:run-id "run" :started-at "start"
:plan {:cases [definition] :warmups warmups
:repetitions (or repetitions (count values))}
:metadata facts :analysis analysis})
(result/record-preparation prep))
add (fn [run value warmup?]
(result/record-attempt
run {:case-id id :preparation-id (:preparation-id prep) :warmup? warmup?
:outcome (if (= value :failed) :failed :completed)
:metrics (if (#{:absent :failed} value) {} {metric-id (entry value)})
:trace {}}))]
(reduce #(add %1 %2 false)
(reduce #(add %1 %2 true) run (repeat warmups 1000)) values))))
(defn- approximately?
"Compares computed numbers with a tolerance for floating point arithmetic."
[a b]
(< (js/Math.abs (- a b)) 1e-9))
(t/deftest mathematical-vectors
(let [settings (method/resolve-settings {:min-p95 1 :min-p99 1})
stats (method/statistics [1 2 3 4 10] settings)]
(t/is (= 4 (get-in stats [:mean :value])))
(t/is (= 3 (get-in stats [:median :value])))
(t/is (= [1 10] [(get-in stats [:min :value]) (get-in stats [:max :value])]))
(t/is (approximately? (js/Math.sqrt 12.5) (get-in stats [:sample-sd :value])))
(t/is (= 1 (get-in stats [:mad :value])))
(t/is (approximately? 8.8 (get-in stats [:p95 :value])))
(t/is (approximately? 9.76 (get-in stats [:p99 :value])))
(t/is (= 1.75 (method/quantile [4 2 1 3] 0.25)))
(t/is (= 2.5 (method/quantile [1 2 3 4] 0.5)))
(t/is (= [1 4] [(method/quantile [4 1 3 2] 0) (method/quantile [4 1 3 2] 1)]))))
(t/deftest numeric-arguments-throw-while-unavailable-results-retain-reasons
(doseq [probability [-0.1 1.1 js/NaN js/Infinity js/-Infinity nil false "0.5"]]
(t/is (= ::method/invalid-probability
(:type (error-data #(method/quantile [1 2] probability))))))
(doseq [values [[js/NaN] [js/Infinity] [js/-Infinity] [nil] ["1"] 42 {} #{1 2}]]
(t/is (= ::method/invalid-observations
(:type (error-data #(method/quantile values 0.5))))))
(t/is (nil? (method/quantile [] 0.5)))
(t/is (nil? (method/quantile nil 0.5)))
(t/is (= ::method/invalid-settings
(:type (error-data #(method/resolve-settings {:draws 0})))))
(t/is (= {:reason :no-valid-observations} (:median (method/statistics [] method/defaults))))
(t/is (= {:reason :insufficient-observations :minimum 10}
(:median-ci (method/statistics [1] method/defaults)))))
(t/deftest calculated-numbers-and-overflow-have-independent-result-maps
(let [stats (method/statistics [4] method/defaults)
changes (method/changes [1e-308] [1e308] (method/resolve-settings {:draws 5 :min-ci 1}))]
(t/is (= {:value 4} (:median stats)))
(t/is (= {:value 0} (:mad stats)))
(t/is (= {:reason :insufficient-observations :minimum 2} (:sample-sd stats)))
(t/is (= {:value 1e308} (:absolute changes)))
(t/is (= {:reason :undefined-estimate} (:percentage changes)))
(t/is (= {:lower 1e308 :upper 1e308} (:absolute-ci changes)))
(t/is (= {:reason :undefined-bootstrap-estimate} (:percentage-ci changes)))))
(t/deftest empty-singleton-and-support-thresholds
(let [settings (method/resolve-settings nil)]
(t/is (= :no-valid-observations (get-in (method/statistics [] settings) [:median :reason])))
(t/is (= :insufficient-observations (get-in (method/statistics [7] settings) [:sample-sd :reason])))
(t/is (= 0 (get-in (method/statistics [7] settings) [:mad :value])))
(t/is (= :insufficient-observations (get-in (method/statistics (vec (repeat 9 7)) settings) [:median-ci :reason])))
(t/is (= {:lower 7 :upper 7} (:median-ci (method/statistics (vec (repeat 10 7)) settings))))
(t/is (= :insufficient-observations (get-in (method/statistics (vec (repeat 99 7)) settings) [:p95 :reason])))
(t/is (= {:value 7} (:p95 (method/statistics (vec (repeat 100 7)) settings))))
(t/is (= :insufficient-observations (get-in (method/statistics (vec (repeat 499 7)) settings) [:p99 :reason])))
(t/is (= {:value 7} (:p99 (method/statistics (vec (repeat 500 7)) settings))))))
(t/deftest analysis-settings-are-validated-and-recorded
(doseq [override [{:draws 0} {:seed -1} {:seed 4294967296} {:confidence 1}
{:confidence js/NaN} {:min-ci 0} {:method-version 2} {:unknown 1}]]
(t/is (= ::method/invalid-settings (:type (error-data #(method/resolve-settings override))))))
(t/is (= 0 (:seed (method/resolve-settings {:seed 0}))))
(t/is (= method/defaults (:analysis (run-with [1])))))
(t/deftest deterministic-bootstrap-and-independent-difference-vectors
;; Bounds also come from an independent Python Mulberry32 implementation.
(let [settings (method/resolve-settings {:draws 100 :seed 123 :confidence 0.8})
base (vec (range 1 11))
stats (method/statistics base settings)
changes (method/changes base (mapv #(+ 5 %) base) settings)]
(t/is (= stats (method/statistics base settings)))
(t/is (= 5.5 (get-in stats [:median :value])))
(t/is (= {:lower 3.5 :upper 7} (:median-ci stats)))
(t/is (= 5 (get-in changes [:absolute :value])))
(t/is (approximately? 2.45 (get-in changes [:absolute-ci :lower])))
(t/is (= 8 (get-in changes [:absolute-ci :upper])))
(t/is (approximately? 31.201923076923077 (get-in changes [:percentage-ci :lower])))
(t/is (approximately? 215.35714285714295 (get-in changes [:percentage-ci :upper])))
(t/is (not= stats (method/statistics base (assoc settings :seed 0))))))
(t/deftest zero-baseline-percentages-and-undefined-draws
(let [settings (method/resolve-settings {:draws 100 :min-ci 1 :seed 0})]
(t/is (= :zero-baseline (get-in (method/changes [0 0] [1 2] settings) [:percentage :reason])))
(t/is (= :zero-baseline (get-in (method/changes [0 0] [1 2] settings) [:percentage-ci :reason])))
(t/is (= :zero-bootstrap-baseline (get-in (method/changes [0 1] [2 3] settings) [:percentage-ci :reason])))
(t/is (= :no-valid-observations (get-in (method/changes [] [1] settings) [:absolute :reason])))))
(t/deftest partial-chronology-and-distinct-counts
(let [run (run-with [1 :failed] {:repetitions 3 :warmups 1})
ended (result/finish-run run "end" {:reason :interrupted})
observations (summary/observations ended :saved/pan metric-id)]
(t/is (= [0 1 2] (mapv :ordinal (:attempts ended))))
(t/is (= {:warmups 0 :repetitions 1} (get-in ended [:remaining :saved/pan])))
(t/is (= {:valid 1 :invalid 0 :absent 0 :failed 1 :unattempted 1 :warmup 1} (:counts observations)))
(t/is (= [1] (:values observations)))
(t/is (= ::result/invalid-record (:type (error-data #(result/finish-run run "end" {:reason :completed})))))
(t/is (= ::result/invalid-record (:type (error-data #(result/record-attempt ended {})))))))
(t/deftest invalid-missing-and-failed-evidence
(let [run (run-with [1 js/NaN js/Infinity js/-Infinity 0 nil :absent :failed])
obs (summary/observations run :saved/pan metric-id)]
(t/is (= {:valid 1 :invalid 5 :absent 1 :failed 1 :unattempted 0 :warmup 0} (:counts obs)))
(t/is (= [1] (:values obs)))
(t/is (= :below-resolution (:invalid-reason (entry 0))))
(t/is (nil? (:invalid-reason (entry 0 {:zero-policy :allow}))))
(t/is (= :negative (:invalid-reason (entry -1 {:zero-policy :allow}))))
(t/is (= :not-numeric (:invalid-reason (entry "bad"))))
(t/is (= :missing-value (:invalid-reason (entry nil))))))
(t/deftest raw-transit-roundtrip-preserves-dynamic-identities-and-special-values
(let [run (-> (run-with [js/NaN js/Infinity js/-Infinity nil] {:repetitions 5})
(result/record-attempt {:case-id :saved/pan :warmup? false :outcome :failed
:metrics {metric-id (entry 900)}
:trace {:slices [{:duration-ms 0}]}
:failure {:cause [{:message "failure"}]}
:partial {:raw js/NaN}}))
decoded (result/decode (result/encode run))]
(t/is (js/Number.isNaN (get-in decoded [:attempts 0 :metrics metric-id :value])))
(t/is (= js/Infinity (get-in decoded [:attempts 1 :metrics metric-id :value])))
(t/is (= js/-Infinity (get-in decoded [:attempts 2 :metrics metric-id :value])))
(t/is (nil? (get-in decoded [:attempts 3 :metrics metric-id :value])))
(t/is (= {:slices [{:duration-ms 0}]} (get-in decoded [:attempts 4 :trace])))
(t/is (js/Number.isNaN (get-in decoded [:attempts 4 :partial :raw])))
(t/is (= {:cause [{:message "failure"}]} (get-in decoded [:attempts 4 :failure])))
(t/is (= 1 (get-in (summary/observations decoded :saved/pan metric-id) [:counts :failed])))))
(t/deftest unknown-format-and-poisoned-accounting-refuse
(let [run (run-with [1])]
(doseq [bad [(assoc run :schema-version 2) {:schema-version 1}]]
(t/is (= ::result/unsupported-format (:type (error-data #(result/decode (transit/encode-str bad)))))))
(doseq [bad [(assoc-in run [:attempts 0 :ordinal] 3)
(assoc-in run [:attempts 0 :preparation-id] :unknown)
(assoc-in run [:remaining :saved/pan :repetitions] 2)
(assoc-in run [:attempts 0 :metrics metric-id :value] js/NaN)]]
(t/is (= ::result/invalid-record
(:type (error-data #(result/decode (transit/encode-str bad)))))))))
(t/deftest recording-keeps-preparation-links-and-failure-accounting
(let [run (run-with [] {:repetitions 2})
attempt (measurement/attempt :saved/pan :prep/one false
{:status "ok" :metrics {metric-id (entry 4)}})]
(doseq [bad [(assoc preparation :case-id :unknown)
preparation]]
(t/is (= ::result/invalid-record
(:type (error-data #(result/record-preparation run bad))))))
(doseq [bad [(assoc attempt :preparation-id :unknown)
(assoc attempt :preparation-id nil)
(assoc attempt :case-id :unknown)]]
(t/is (= ::result/invalid-record
(:type (error-data #(result/record-attempt run bad))))))
(let [failed (assoc attempt :preparation-id nil :outcome :failed)
saved (-> run
(result/record-attempt failed)
(result/record-attempt attempt)
(result/finish-run "end" {:reason :completed})
result/encode
result/decode)
report (summary/summarize saved)]
(t/is (= {:warmups 0 :repetitions 0} (get-in saved [:remaining :saved/pan])))
(t/is (= {:valid 1 :invalid 0 :absent 0 :failed 1 :unattempted 0 :warmup 0}
(get-in report [:cases 0 :metrics metric-id :counts])))
(t/is (= 4 (get-in report [:cases 0 :metrics metric-id :statistics :median :value])))
(t/is (= ::result/invalid-record
(:type (error-data #(result/record-preparation saved (assoc preparation :preparation-id :prep/two)))))))))
(t/deftest standard-metrics-and-batches-use-one-observation
(let [raw {:full-ms 12 :viewport-ready-ms 10
:slices [{:duration-ms 0} {:duration-ms 2}]
:cached-slices [{:duration-ms 3}] :settling-requested-ms 100}
fresh (measurement/metrics raw true {:upload-ms 99})
warm (measurement/metrics raw false {:upload-ms 99})
batch (entry 2 {:basis {:kind :per-call-average :calls 200}})
run (run-with [2])
run (assoc-in run [:attempts 0 :metrics metric-id] batch)]
(t/is (= 5 (get-in fresh [:renderer-call-total-ms :value])))
(t/is (= 12 (get-in fresh [:first-render-ms :value])) "upload stays outside first render")
(t/is (not (contains? fresh :full-ms)))
(t/is (not (contains? warm :upload-ms)))
(t/is (not (contains? warm :settling-requested-ms)))
(t/is (= 1 (get-in (summary/summarize run) [:cases 0 :metrics metric-id :statistics :count])))
(t/is (str/includes? (format/format-run (summary/summarize run)) ":per-call-average"))
(t/is (js/Number.isNaN (measurement/render-call-total {:slices [{:duration-ms js/NaN}]})))))
(t/deftest render-call-evidence-distinguishes-missing-from-zero
(let [raw [{}
{:slices []}
{:cached-slices []}
{:slices [] :cached-slices []}
{:slices [{:duration-ms 0}] :cached-slices []}
{:slices [] :cached-slices [{:duration-ms 0}]}
{:slices [{:frame-type "full"}]}]
run (reduce (fn [run trace]
(result/record-attempt
run (measurement/attempt
:saved/pan :prep/one false
{:status "ok" :metrics (measurement/metrics trace false {})
:trace trace})))
(run-with [] {:repetitions (count raw)}) raw)
saved (-> (result/finish-run run "end" {:reason :completed})
result/encode result/decode)
metric (get-in (summary/summarize saved) [:cases 0 :metrics :renderer-call-total-ms])]
(t/is (= raw (mapv :trace (:attempts saved))))
(t/is (= {:valid 2 :invalid 4 :absent 1 :failed 0 :unattempted 0 :warmup 0}
(:counts metric)))
(t/is (= 2 (get-in metric [:statistics :count])))
(t/is (= 0 (get-in metric [:statistics :median :value])))
(doseq [ordinal [1 2 3 6]]
(t/is (= :missing-value
(get-in saved [:attempts ordinal :metrics :renderer-call-total-ms :invalid-reason]))))))
(t/deftest report-numbers-keep-integers-readable-and-small-values-precise
(doseq [[value text] [[10000000 "10000000"]
[0.125 "0.125000"]
[0.000000125 "1.25000e-7"]]]
(t/is (str/includes? (format/format-run (summary/summarize (run-with [value])))
(str " median " text " CI ")))))
(t/deftest warmup-order-and-interrupted-warmup-accounting
(let [run (-> (result/create-run {:run-id "warmup" :started-at "start"
:plan {:cases [saved-case] :warmups 3 :repetitions 2}
:metadata metadata})
(result/record-preparation preparation))
attempt (measurement/attempt :saved/pan :prep/one true
{:status "ok" :metrics {metric-id (entry 1)}})
partial (-> run
(result/record-attempt (assoc attempt :outcome :failed))
(result/record-attempt attempt))
ended (result/finish-run partial "end" {:reason :interrupted})
saved (-> ended result/encode result/decode)
case-summary (first (:cases (summary/summarize saved)))
ready (result/record-attempt partial attempt)
completed (result/record-attempt ready (assoc attempt :warmup? false))]
(t/is (= ::result/invalid-record
(:type (error-data #(result/record-attempt partial (assoc attempt :warmup? false))))))
(t/is (= {:warmups 1 :repetitions 2} (:remaining case-summary)))
(t/is (= {:valid 0 :invalid 0 :absent 0 :failed 0 :unattempted 2 :warmup 2}
(get-in case-summary [:metrics metric-id :counts])))
(t/is (= {:warmups 0 :repetitions 1} (get-in completed [:remaining :saved/pan])))
(t/is (= ::result/invalid-record
(:type (error-data #(result/record-attempt ready attempt)))))
(let [reordered (assoc completed :attempts
(mapv (fn [ordinal attempt] (assoc attempt :ordinal ordinal))
(range) (reverse (:attempts completed))))]
(t/is (= ::result/invalid-record
(:type (error-data #(result/decode (transit/encode-str reordered)))))))))
(t/deftest portable-report-roundtrip-does-not-use-registry
(let [run (run-with (vec (range 1 11)))
transported (-> run result/encode result/decode)]
(t/is (= (summary/summarize run) (summary/summarize transported)))
(t/is (str/includes? (format/format-run (summary/summarize transported)) "runtime-helper identity is unverified"))
(t/is (= 99 (get-in (summary/summarize run {:draws 99}) [:analysis :draws])))
(t/is (= method/defaults (:analysis run)))))
(t/deftest all-dynamic-metric-identifiers-remain-distinct
(let [ids [:dynamic/id "duration" 'custom/time [:operation 7] nil false]
run (assoc-in (run-with [1]) [:attempts 0 :metrics]
(into {} (map (fn [id] [id (entry 1)])) ids))
decoded (result/decode (result/encode run))
comparison (compare/compare-runs decoded decoded)]
(t/is (= (set ids) (set (keys (get-in (summary/summarize decoded) [:cases 0 :metrics])))))
(t/is (= (set ids) (set (keys (get-in comparison [:pairs 0 :metrics])))))))
(t/deftest startup-and-incomplete-evidence-retain-unattempted-slots
(let [empty (result/create-run {:run-id "empty" :started-at "start"
:plan {:cases [saved-case] :warmups 0 :repetitions 3}
:metadata metadata})
stopped (result/finish-run empty "end" {:reason :startup-error :failure {:message "cannot launch"}})]
(t/is (empty? (:attempts stopped)))
(t/is (= {:warmups 0 :repetitions 3} (get-in stopped [:remaining :saved/pan])))
(t/is (= stopped (result/decode (result/encode stopped))))))
(t/deftest completed-attempts-exclude-invalid-metrics-individually
(let [run (assoc-in (run-with [1]) [:attempts 0 :metrics :bad] (entry js/NaN))
report (summary/summarize run)]
(t/is (= 1 (get-in report [:cases 0 :metrics metric-id :counts :valid])))
(t/is (= 1 (get-in report [:cases 0 :metrics :bad :counts :invalid])))
(t/is (= :no-valid-observations (get-in report [:cases 0 :metrics :bad :statistics :median :reason])))))
(t/deftest definition-drift-is-visible-and-force-compares-raw-values
(let [run (assoc-in (run-with [1 2]) [:attempts 1 :metrics metric-id :basis]
{:kind :per-call-average :calls 2})
report (summary/summarize run)
forced (compare/compare-runs run run {:force true})]
(t/is (= :inconsistent-metric-definitions (get-in report [:cases 0 :metrics metric-id :statistics :reason])))
(t/is (= ::compare/incompatible (:type (error-data #(compare/compare-runs run run)))))
(t/is (= 0 (get-in forced [:pairs 0 :metrics metric-id :absolute :value])))
(t/is (= 1.5 (get-in forced [:pairs 0 :baseline :metrics metric-id :statistics :median :value])))
(t/is (true? (get-in forced [:pairs 0 :baseline :metrics metric-id :mixed-definitions?])))))
(t/deftest failed-invalid-and-warmup-definitions-do-not-suppress-valid-statistics
(let [run (-> (run-with [1 :failed js/NaN] {:warmups 1})
(assoc-in [:attempts 0 :metrics metric-id] (entry 100 {:unit :seconds}))
(assoc-in [:attempts 2 :metrics metric-id] (entry 100 {:unit :seconds}))
(assoc-in [:attempts 3 :metrics metric-id] (entry js/NaN {:unit :seconds})))
report (summary/summarize run)]
(t/is (= 1 (get-in report [:cases 0 :metrics metric-id :statistics :median :value])))
(t/is (= {:valid 1 :invalid 1 :absent 0 :failed 1 :unattempted 0 :warmup 1}
(get-in report [:cases 0 :metrics metric-id :counts])))))
(t/deftest matching-cases-ignore-provenance-and-repetition-counts
(let [baseline (run-with [1 2 3])
candidate (run-with [2 3 4 5] {:definition (assoc saved-case :scene-version 99)
:analysis {:seed 99}
:facts (-> metadata
(assoc :git {:sha "other" :dirty true})
(assoc-in [:build :provenance :run-marker] "second"))})
comparison (compare/compare-runs baseline (assoc candidate :run-id "other" :started-at "later"))]
(t/is (= 2 (:schema-version comparison)))
(t/is (= method/defaults (:analysis comparison)))
(t/is (empty? (get-in comparison [:pairs 0 :mismatches])))
(t/is (= 1.5 (get-in comparison [:pairs 0 :metrics metric-id :absolute :value])))
(t/is (= comparison (-> comparison result/encode result/decode)))))
(t/deftest strict-and-forced-compatibility
(let [base (run-with [1 2])]
(doseq [[field changed]
[[:fingerprint (run-with [3] {:prep (assoc-in preparation [:fingerprint :digest] (apply str (repeat 64 "b")))})]
[:execution (run-with [3] {:definition (assoc saved-case :operation {:steps 30})})]
[:scored? (run-with [3] {:facts (assoc metadata :scored? false)})]
[:execution (run-with [3] {:definition (assoc saved-case :batch-size 20)})]
[:execution (run-with [3] {:definition (assoc saved-case :completion :call)})]
[:execution (run-with [3] {:definition (assoc saved-case :completion :await)})]
[:execution (run-with [3] {:definition (assoc saved-case :preparation {:version 2})})]
[:environment (run-with [3] {:facts (assoc-in metadata [:environment :browser] "other")})]
[:functional-build (run-with [3] {:facts (assoc-in metadata [:build :functional :features] #{:other})})]
[:warmups (run-with [3] {:warmups 1})]
[:effective-graphics (run-with [3] {:prep (assoc preparation :effective-graphics {:renderer "software" :software true})})]
[:timeout-policy (assoc-in (run-with [3]) [:plan :timeout-policy :attempt-ms] 100)]]]
(let [changed (-> changed result/encode result/decode)
rejected (error-data #(compare/compare-runs base changed))
forced (compare/compare-runs base changed {:force true})
mismatches (get-in forced [:pairs 0 :mismatches])
text (format/format-comparison forced)]
(t/is (= ::compare/incompatible (:type rejected)))
(t/is (:forced? forced))
(t/is (= [field] (mapv :field mismatches)))
(t/is (= (:mismatches rejected) mismatches))
(t/is (every? #(false? (:waived? %)) mismatches))
(t/is (str/includes? text "FORCED COMPARISON"))
(t/is (str/includes? text "MISMATCHES"))
(t/is (str/includes? text (str ":field " (pr-str field))))))))
(t/deftest explicit-pairs-keep-non-case-checks-and-exact-names
(let [base (run-with [1])
other (-> (run-with [2] {:definition (assoc saved-case :id :different/zoom :scene :different
:operation {:steps 8} :batch-size 20
:completion :call :preparation {:version 2})
:prep (assoc-in preparation [:fingerprint :digest] (apply str (repeat 64 "b")))})
result/encode
result/decode)
pairs (compare/selector-pair base other "saved/pan,different/zoom")
comparison (compare/compare-runs base other {:pairs pairs})
execution (first (filter #(= :execution (:field %)) (get-in comparison [:pairs 0 :mismatches])))
execution-keys [:scene :operation :batch-size :completion :preparation]]
(t/is (= [[:saved/pan :different/zoom]] pairs))
(t/is (= 1 (get-in comparison [:pairs 0 :metrics metric-id :absolute :value])))
(t/is (every? :waived? (get-in comparison [:pairs 0 :mismatches])))
(t/is (= {:scene :saved :operation {:steps 3}
:batch-size 1 :completion :render-full :preparation {}}
(select-keys (:baseline execution) execution-keys)))
(t/is (= {:scene :different :operation {:steps 8}
:batch-size 20 :completion :call :preparation {:version 2}}
(select-keys (:candidate execution) execution-keys)))
(t/is (= ::compare/incompatible
(:type (error-data #(compare/compare-runs base (assoc-in other [:metadata :environment :cpu] "other")
{:pairs pairs})))))
(let [unscored (assoc-in other [:metadata :scored?] false)
rejected (error-data #(compare/compare-runs base unscored {:pairs pairs}))
forced (compare/compare-runs base unscored {:pairs pairs :force true})
mismatches (get-in forced [:pairs 0 :mismatches])
text (format/format-comparison forced)]
(t/is (= ::compare/incompatible (:type rejected)))
(t/is (:forced? forced))
(t/is (= (:mismatches rejected) mismatches))
(t/is (= [{:field :scored? :baseline true :candidate false :waived? false}]
(vec (remove :waived? mismatches))))
(t/is (str/includes? text "FORCED COMPARISON"))
(t/is (str/includes? text "MISMATCHES"))
(t/is (str/includes? text ":field :scored?")))
(t/is (= ["saved/pan"] (:available (error-data #(compare/resolve-case base "pan")))))
(t/is (= ::compare/invalid-selector (:type (error-data #(compare/selector-pair base other "saved/pan")))))))
(t/deftest force-preserves-metric-definitions-and-excludes-failed-values
(let [base (run-with [1 :failed])
changed (assoc-in (run-with [2]) [:attempts 0 :metrics metric-id]
(entry 2 {:unit :seconds :basis {:kind :per-call-average :calls 50}}))
comparison (compare/compare-runs base changed {:force true})]
(t/is (= 1 (get-in comparison [:pairs 0 :metrics metric-id :absolute :value])))
(t/is (= :seconds (get-in comparison [:pairs 0 :candidate :metrics metric-id :definitions 0 :unit])))
(t/is (= 1 (get-in comparison [:pairs 0 :baseline :metrics metric-id :counts :failed])))
(t/is (= ::compare/no-shared-metrics
(:type (error-data #(compare/compare-runs base
(assoc-in changed [:attempts 0 :metrics] {:other (entry 2)})
{:force true})))))))
(t/deftest comparison-boundary-validates-nested-evidence
(let [run (run-with [1 2])
comparison (compare/compare-runs run run)
changes-path [:pairs 0 :metrics metric-id]
report-path [:pairs 0 :baseline :metrics metric-id]]
(doseq [changed [(assoc-in comparison (conj changes-path :absolute :value) js/NaN)
(assoc-in comparison (conj changes-path :absolute-ci) {:lower 2 :upper 1})
(assoc-in comparison (conj report-path :counts :valid) -1)
(assoc-in comparison (conj report-path :definitions 0 :basis :calls) 0)
(assoc-in comparison [:baseline :metadata :scored?] :unknown)]]
(t/is (= ::result/invalid-record (:type (error-data #(result/decode (transit/encode-str changed)))))))
(t/is (= ::result/unsupported-format
(:type (error-data #(result/decode (transit/encode-str (assoc comparison :schema-version 1)))))))))
(t/deftest force-keeps-invalid-measurements-unusable
(let [baseline (run-with [js/NaN js/Infinity :absent :failed] {:repetitions 5})
candidate (run-with [2] {:facts (assoc-in metadata [:environment :cpu] "other")})
comparison (compare/compare-runs baseline candidate {:force true})]
(t/is (= {:valid 0 :invalid 2 :absent 1 :failed 1 :unattempted 1 :warmup 0}
(get-in comparison [:pairs 0 :baseline :metrics metric-id :counts])))
(t/is (= :no-valid-observations (get-in comparison [:pairs 0 :metrics metric-id :absolute :reason])))
(t/is (= :no-valid-observations (get-in comparison [:pairs 0 :metrics metric-id :percentage-ci :reason])))
(t/is (= comparison (result/decode (result/encode comparison))))))

86
frontend/test/frontend_tests/benches/scene_snapshot_test.cljs
View File

@ -9,7 +9,7 @@
[app.common.schema :as sm]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[benches.render-wasm.snapshot :as common]
[benches.render-wasm.snapshot :as snapshot]
[cljs.test :as t :include-macros true]))
(defn- sample-snapshot
@ -67,7 +67,7 @@
"Returns the ex-data of the validation failure, or nil when it passes."
[instance]
(try
(common/validate! instance)
(snapshot/validate! instance)
nil
(catch :default cause
(ex-data cause))))
@ -75,14 +75,14 @@
(t/deftest canonical-example-is-valid
(t/testing "validate! returns the same instance"
(let [instance (sample-snapshot)]
(t/is (identical? instance (common/validate! instance)))))
(t/is (identical? instance (snapshot/validate! instance)))))
(t/testing "the envelope schema accepts the example"
(t/is (true? (sm/validate common/schema:snapshot (sample-snapshot))))))
(t/is (true? (sm/validate snapshot/schema:snapshot (sample-snapshot))))))
(t/deftest nested-hierarchy-is-valid
(let [instance (nested-instance)]
(t/is (identical? instance (common/validate! instance)))))
(t/is (identical? instance (snapshot/validate! instance)))))
(t/deftest root-only-instance-is-valid
(let [root (cts/setup-shape {:id uuid/zero :type :frame :name "Root Frame"
@ -90,17 +90,17 @@
:parent-id uuid/zero :frame-id uuid/zero
:shapes []})
instance {:objects {uuid/zero root} :refs {}}]
(t/is (identical? instance (common/validate! instance)))
(t/is (= [uuid/zero] (mapv :id (common/upload-order instance))))))
(t/is (identical? instance (snapshot/validate! instance)))
(t/is (= [uuid/zero] (mapv :id (snapshot/upload-order instance))))))
(t/deftest upload-order-starts-at-root
(let [instance (sample-snapshot)
ids (mapv :id (common/upload-order instance))]
(t/is (= [uuid/zero (common/ref-id instance :rect)] ids))))
ids (mapv :id (snapshot/upload-order instance))]
(t/is (= [uuid/zero (snapshot/ref-id instance :rect)] ids))))
(t/deftest upload-order-is-parent-before-child
(let [instance (nested-instance)
order (common/upload-order instance)
order (snapshot/upload-order instance)
names (mapv :name order)
position (into {} (map-indexed (fn [index shape] [(:id shape) index]) order))]
(t/is (= ["Root Frame" "A" "A1" "A2" "B" "B1"] names))
@ -134,39 +134,39 @@
a-id shape-a
b-id shape-b}
:refs {}}]
(t/is (identical? instance (common/validate! instance)))
(t/is (identical? instance (snapshot/validate! instance)))
(t/is (= ["Root Frame" "Flex" "B" "A"]
(mapv :name (common/upload-order instance))))))
(mapv :name (snapshot/upload-order instance))))))
(t/deftest ref-id-resolves-labels
(let [instance (sample-snapshot)]
(t/is (= (uuid/custom 1 1) (common/ref-id instance :rect)))
(t/is (nil? (common/ref-id instance :missing)))))
(t/is (= (uuid/custom 1 1) (snapshot/ref-id instance :rect)))
(t/is (nil? (snapshot/ref-id instance :missing)))))
(t/deftest missing-root-is-rejected
(let [instance (sample-snapshot)
data (validation-error (update instance :objects dissoc uuid/zero))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= uuid/zero (:id data)))))
(t/deftest non-frame-root-is-rejected
(let [instance (sample-snapshot)
data (validation-error (assoc-in instance [:objects uuid/zero :type] :rect))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= uuid/zero (:id data)))))
(t/deftest root-with-non-zero-parent-id-is-rejected
(let [instance (sample-snapshot)
data (validation-error
(assoc-in instance [:objects uuid/zero :parent-id] (uuid/custom 9 9)))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= uuid/zero (:id data)))))
(t/deftest object-key-must-match-shape-id
(let [instance (sample-snapshot)
rect (get-in instance [:objects (common/ref-id instance :rect)])
rect (get-in instance [:objects (snapshot/ref-id instance :rect)])
data (validation-error (assoc-in instance [:objects (uuid/custom 7 7)] rect))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= (:id rect) (:shape-id data)))))
(t/deftest missing-child-is-rejected
@ -174,32 +174,32 @@
bogus (uuid/custom 3 3)
data (validation-error
(assoc-in instance [:objects uuid/zero :shapes] [bogus]))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= bogus (:child data)))))
(t/deftest child-not-listed-by-parent-is-rejected
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error (assoc-in instance [:objects uuid/zero :shapes] []))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "object is not reachable from the root" (:hint data)))
(t/is (= rect-id (:id data)))))
(t/deftest mismatched-parent-id-is-rejected
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error
(assoc-in instance [:objects rect-id :parent-id] (uuid/custom 9 7)))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "shape :shapes lists a child with a different :parent-id" (:hint data)))
(t/is (= rect-id (:child data)))))
(t/deftest duplicate-child-ids-are-rejected
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error
(assoc-in instance [:objects uuid/zero :shapes] [rect-id rect-id]))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "an object is reachable more than once" (:hint data)))
(t/is (= rect-id (:id data)))))
@ -207,7 +207,7 @@
(let [instance (sample-snapshot)
data (validation-error
(assoc-in instance [:objects uuid/zero :shapes] [uuid/zero]))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "root must not be a descendant of itself" (:hint data)))
(t/is (= uuid/zero (:id data)))))
@ -227,7 +227,7 @@
(assoc (get (sample-snapshot) :objects)
c1-id shape1
c2-id shape2)))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "object is not reachable from the root" (:hint data)))
(t/is (contains? #{c1-id c2-id} (:id data)))))
@ -247,24 +247,24 @@
(assoc-in [:objects a-id] shape-a)
(assoc-in [:objects b-id] shape-b))
data (validation-error instance)]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "shape :shapes lists a child with a different :parent-id" (:hint data)))
(t/is (= a-id (:child data)))))
(t/deftest non-vector-children-are-rejected
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error (assoc-in instance [:objects rect-id :shapes] 5))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= "shape :shapes must be a vector" (:hint data)))
(t/is (= rect-id (:id data)))))
(t/deftest frame-id-mismatch-is-rejected
(let [instance (nested-instance)
a1-id (common/ref-id instance :a1)
a1-id (snapshot/ref-id instance :a1)
data (validation-error
(assoc-in instance [:objects a1-id :frame-id] uuid/zero))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= :invalid-frame (:code data)))
(t/is (= a1-id (:shape-id data)))))
@ -272,45 +272,45 @@
(let [instance (sample-snapshot)
data (validation-error
(assoc-in instance [:refs :rect] (uuid/custom 6 6)))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= :rect (:label data)))))
(t/deftest non-uuid-ref-value-is-rejected
(let [data (validation-error (assoc-in (sample-snapshot) [:refs :rect] "not-a-uuid"))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data)))))
(t/deftest missing-refs-key-is-rejected
(let [data (validation-error (dissoc (sample-snapshot) :refs))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data)))))
(t/deftest non-canonical-shape-is-rejected
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error (assoc-in instance [:objects rect-id] {:id rect-id}))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data)))))
(t/deftest malformed-envelopes-are-rejected
(t/testing "empty objects map"
(let [data (validation-error {:objects {} :refs {}})]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (= uuid/zero (:id data)))))
(t/testing "nil instance"
(let [data (validation-error nil)]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data)))))
(t/testing "nil shape value"
(let [instance (sample-snapshot)
rect-id (common/ref-id instance :rect)
rect-id (snapshot/ref-id instance :rect)
data (validation-error (assoc-in instance [:objects rect-id] nil))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data)))))
(t/testing "nil ref value"
(let [data (validation-error (assoc-in (sample-snapshot) [:refs :rect] nil))]
(t/is (= ::common/invalid-snapshot (:type data)))
(t/is (= ::snapshot/invalid-snapshot (:type data)))
(t/is (some? (::sm/explain data))))))

65
frontend/test/frontend_tests/benches/upload_test.cljs
View File

@ -1,65 +0,0 @@
;; 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.upload-test
"Test routing contract for `benches.render-wasm.browser.upload/upload-scene!`.
Byte layouts are proven by `frontend-tests.render-wasm.serialization-test`
and `process-objects-test`; this suite pins: the order comes from
`snapshot/upload-order`, the batch helper is called exactly once with
the caller's opts, and the prepared vector is returned in order."
(:require
[app.common.render-wasm.api.upload :as upload]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[benches.render-wasm.browser.upload :as bench-upload]
[benches.render-wasm.snapshot :as common]
[cljs.test :as t :include-macros true]))
(defn- sample-snapshot
"Root frame with two rectangles, so order is observable."
[]
(let [r1-id (uuid/custom 11 1)
r2-id (uuid/custom 11 2)
r1 (cts/setup-shape {:id r1-id :type :rect :name "R1"
:x 10 :y 10 :width 100 :height 60
:parent-id uuid/zero :frame-id uuid/zero})
r2 (cts/setup-shape {:id r2-id :type :rect :name "R2"
:x 200 :y 40 :width 80 :height 80
:parent-id uuid/zero :frame-id uuid/zero})
root (cts/setup-shape {:id uuid/zero :type :frame :name "Root Frame"
:x 0 :y 0 :width 1920 :height 1080
:parent-id uuid/zero :frame-id uuid/zero
:shapes [r1-id r2-id]})]
{:objects {uuid/zero root, r1-id r1, r2-id r2}
:refs {:r1 r1-id :r2 r2-id}}))
(t/deftest prepare-scene-derives-upload-order
(let [snapshot (common/validate! (sample-snapshot))]
(t/is (= (common/upload-order snapshot)
(bench-upload/prepare-scene snapshot)))))
(t/deftest upload-scene-uses-snapshot-order-and-caller-opts
(let [snapshot (common/validate! (sample-snapshot))
opts {:include-layout? false :include-fills-strokes? true}
flush-calls (atom [])
orig-flush upload/flush-shapes-batch!
expected (common/upload-order snapshot)]
(set! upload/flush-shapes-batch!
(fn [shapes o] (swap! flush-calls conj {:shapes shapes :opts o}) nil))
(try
(let [result (bench-upload/upload-scene! snapshot opts)
flushed (first @flush-calls)]
(t/testing "exactly one batch upload"
(t/is (= 1 (count @flush-calls))))
(t/testing "caller opts pass through"
(t/is (= opts (:opts flushed))))
(t/testing "shapes follow snapshot upload order"
(t/is (= (mapv :id expected) (mapv :id (:shapes flushed)))))
(t/testing "prepared vector returns in order"
(t/is (= (mapv :id expected) (mapv :id result)))))
(finally
(set! upload/flush-shapes-batch! orig-flush)))))