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

🚧 WIP Step 12.2, Fix browser bridge, lifecycle

Browse Source 
AI-assisted-by: muse-spark, glm-5.3
This commit is contained in:
Miguel de Benito Delgado 2026-09-27 18:33:09 +02:00
parent 6b5d50428b
commit b5a369ec8c
2 changed files with 572 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

347
frontend/test/benches/render_wasm/browser.cljs
View File

@ -119,6 +119,49 @@
[s]
(boolean (re-find #"(?i)swiftshader|llvmpipe|software|basic render" (or s ""))))
(defn- teardown-canvas!
"Releases the context after successful initialization, then removes its
canvas. The initializer owns cleanup until it returns a context."
[canvas]
(when (some? canvas)
(when-let [context wasm/gl-context]
(webgl/release-context! wasm/internal-module context wasm/gl-context-handle))
(try
(.remove ^js canvas)
(catch :default _))))
(defn- release-owner-resources!
"Drops the current owner's canvas, GL handles and WASM module binding
without touching the owner epoch. Callers own the epoch: `dispose!` bumps
first, superseding loads already bumped for the new owner."
[]
(teardown-canvas! @canvas*)
(wasm/reset-context-state!)
;; reset-context-state! deliberately preserves loss state for the editor
;; reload path; bench disposal owns it explicitly.
(reset! wasm/context-lost? false)
(set! wasm/internal-module nil)
(reset! canvas* nil))
(defn dispose!
"Closes the current owner: bumps the epoch (running continuations go
stale), releases renderer resources and drops the cached module promise so
a later load re-imports cleanly. Idempotent. Stale callers must not clean
up a newer owner; use `dispose-if-current!` from async continuations."
[]
(swap! owner-epoch* inc)
(release-owner-resources!)
(reset! module-promise* nil)
#js {"status" "disposed"})
(defn- dispose-if-current!
"Disposes only when `epoch` is still current. Stale work returns false
without modifying the newer owner's canvas, GL context or module cache."
[epoch]
(when (= epoch @owner-epoch*)
(dispose!)
true))
(defn- poll-full
"TODO(mem:render-wasm/performance/cljs-rewrite/06-render-and-interaction-protocol):
interim inline drain. Ticket 06 replaces this with `protocol.cljs`; do not
@ -158,39 +201,58 @@
(.requestAnimationFrame js/window (fn [] (step (inc started-frames))))))))
(defn- read-graphics
"Records effective graphics settings from the declared helper authority
plus the observed renderer string."
[width height dpr renderer]
(let [opts webgl/default-context-options]
{"width" width
"height" height
"Records effective graphics settings: requested CSS size and DPR
separately from the observed drawing-buffer size and the context's actual
attributes. Requested defaults live in `webgl/default-context-options`;
what the browser granted comes from `getContextAttributes`."
[canvas ctx width height dpr renderer]
(let [attrs (try
(.getContextAttributes ^js ctx)
(catch :default _ nil))
attr (fn [k]
(when (some? attrs)
(unchecked-get attrs k)))]
{"cssWidth" width
"cssHeight" height
"drawingBufferWidth" (.-width ^js canvas)
"drawingBufferHeight" (.-height ^js canvas)
"dpr" dpr
"webgl2" true
"antialias" (unchecked-get opts "antialias")
"depth" (unchecked-get opts "depth")
"stencil" (unchecked-get opts "stencil")
"alpha" (unchecked-get opts "alpha")
"preserveDrawingBuffer" (unchecked-get opts "preserveDrawingBuffer")
"antialias" (attr "antialias")
"depth" (attr "depth")
"stencil" (attr "stencil")
"alpha" (attr "alpha")
"preserveDrawingBuffer" (attr "preserveDrawingBuffer")
"renderer" renderer
"software" (software-renderer? renderer)}))
(defn- render-ok
[module-ms graphics-ms upload-ms alive? poll snapshot seed width height dpr renderer]
"Maps one poll result to the bridge value. Success keeps the owner live
for explicit disposal. Every failure path releases the owner when it still
owns the realm, so budget exhaustion and context loss never leave a live
canvas behind. Stale results never dispose: a newer owner is live."
[epoch module-ms graphics-ms upload-ms alive? poll snapshot seed canvas ctx width height dpr renderer]
(let [pm (js->clj poll :keywordize-keys true)]
(cond
(:stale pm)
;; dispose! resets loss state, so stale-plus-lost means genuine
;; context loss, not disposal.
;; context loss, not disposal. The loss listener already released the
;; canvas; the dispose call below only matters when loss was recorded
;; without an epoch bump.
(if @wasm/context-lost?
(fail-data {:phase "context-lost"
:message "WebGL context lost during render"})
(do
(dispose-if-current! epoch)
(fail-data {:phase "context-lost"
:message "WebGL context lost during render"}))
#js {"status" "stale"})
;; Safety net: every loss writer bumps the epoch, so staleness
;; normally fires first.
(not alive?)
(fail-data {:phase "first-render"
:message "disposed or context lost during render"})
(do
(dispose-if-current! epoch)
(fail-data {:phase "first-render"
:message "disposed or context lost during render"}))
(:full pm)
(clj->js
@ -202,16 +264,21 @@
"renderFrames" (:frames pm)
"scene" {"shapes" (count (:objects snapshot))
"seed" seed}
"effectiveGraphics" (read-graphics width height dpr renderer)})
"effectiveGraphics" (read-graphics canvas ctx width height dpr renderer)})
:else
(fail-data {:phase "first-render"
:message "Full not reached in budget"
:detail pm}))))
(do
(dispose-if-current! epoch)
(fail-data {:phase "first-render"
:message "Full not reached in budget"
:detail pm})))))
(defn- install-listeners!
"Wires context lost/restored handling for `canvas`, epoch-guarded: a stale
canvas (removed but not yet GC'd) must not kill the live owner."
canvas (removed but not yet GC'd) must not kill the live owner. On loss the
current owner releases its canvas and GL resources itself: the poll loop
only observes staleness afterwards, so a `render-ok` cleanup there would
always miss."
[canvas epoch]
(.addEventListener
canvas "webglcontextlost"
@ -219,6 +286,8 @@
(fn [e]
(.preventDefault ^js e)
(when (= installed @owner-epoch*)
(release-owner-resources!)
(reset! module-promise* nil)
(reset! wasm/context-lost? true)
(swap! owner-epoch* inc)))))
(.addEventListener
@ -232,28 +301,54 @@
;; Public interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn dispose!
"Closes the current owner: bumps the epoch (in-flight continuations go
stale), tears down WASM context state and drops the module handle so a
later load re-imports cleanly. Idempotent."
[]
(swap! owner-epoch* inc)
(wasm/reset-context-state!)
;; reset-context-state! deliberately preserves loss state for the editor
;; reload path; bench disposal owns it explicitly.
(reset! wasm/context-lost? false)
(set! wasm/internal-module nil)
(reset! module-promise* nil)
(when-let [canvas @canvas*]
(.remove ^js canvas)
(reset! canvas* nil))
#js {"status" "disposed"})
(defn- stale?
"True when `cause` is the superseded-owner marker from `guard-current!`."
[cause]
(true? (::stale (ex-data cause))))
(defn- guard-current!
"Throws the stale marker when `epoch` no longer owns the realm. Every
async step calls it first with its own phase so the terminal handler can
tell superseded work from genuine failures. The marker lives in `ex-data`,
never in the message: message text is not a protocol."
[epoch phase]
(when-not (= epoch @owner-epoch*)
(throw (ex-info "superseded" {::stale true :phase phase}))))
(defn- terminal-failure
"Maps a chain rejection to the bridge value. Stale work resolves to the
stale marker without touching the newer owner; any other failure releases
the owner when it still owns the realm and resolves to a failure map, so
the bridge promise never rejects."
[epoch cause fallback-phase]
(if (stale? cause)
#js {"status" "stale"}
(let [phase (or (:phase (ex-data cause))
fallback-phase
"aborted")]
(dispose-if-current! epoch)
(fail-data {:phase phase :message (or (ex-message cause) "unknown failure")}))))
(defn- build-canvas!
"Creates the bench canvas with a `width*dpr` backing buffer and an explicit
CSS size, so the drawn scene fills exactly the reported viewport."
[width height dpr]
(let [canvas (.createElement js/document "canvas")]
(aset canvas "width" (* width dpr))
(aset canvas "height" (* height dpr))
(aset (.-style ^js canvas) "width" (str width "px"))
(aset (.-style ^js canvas) "height" (str height "px"))
canvas))
;; TODO: remove in Ticket 06
(defn load-rects
"Loads the `:rects/load` scene and renders it to Full. Takes plain data:
`{\"seed\" int, \"view\" {scale x y viewport?}?, \"module-url\"?, \"wasm-url\"?}`.
Viewport defaults to 1920x1080@2. Always resolves (failure maps included)."
Viewport defaults to 1920x1080@2. Always resolves (failure maps included).
The chain is flat: one `.then` per phase (module, graphics, scene, upload,
drain) plus a terminal `.catch`, so every rejection carries its phase to a
single ownership-aware handler."
[args]
(try
(let [params (js->clj (or args #js {}) :keywordize-keys true)
@ -268,105 +363,119 @@
(fail-data {:phase "invalid-args"
:message "load-rects needs {seed int, view?}"}))
(let [epoch (swap! owner-epoch* inc)]
;; Supersede: drop the previous owner's canvas now; its
;; continuations go stale through the epoch bump above.
;; The old GL context frees with the removed canvas.
(when-let [old @canvas*]
(.remove ^js old))
;; Supersede: the epoch bump above already retired the previous
;; owner's continuations. Release its canvas and GL resources now
;; with the production teardown path, and drop the cached module
;; promise so this owner measures a fresh instantiation.
(release-owner-resources!)
(reset! module-promise* nil)
(let [viewport (core/resolve-viewport view)
width (:width viewport)
height (:height viewport)
dpr (:dpr viewport)
;; Epoch-only until mark-live!: liveness requires an
;; initialized context, which does not exist yet.
current? (fn [] (= epoch @owner-epoch*))
live? (fn [] (and (= epoch @owner-epoch*) (wasm/live?)))]
(-> (ensure-module! (or (:module-url params) "./render-wasm.js")
(or (:wasm-url params) "./render-wasm.wasm"))
(.then
(fn [{:keys [module factory-ms]}]
(when-not (current?)
(throw (ex-info "stale" {})))
(set! wasm/internal-module module)
(let [module-ms factory-ms
canvas (doto (.createElement js/document "canvas")
(aset "width" (* width dpr))
(aset "height" (* height dpr)))
_ (.appendChild (.-body js/document) canvas)
_ (reset! canvas* canvas)
g0 (now)
ctx (webgl/init-context!
canvas
{:module module
:context-id "webgl2"
:css-width width
:css-height height
:dpr dpr
:flags 0
:browser (sr/translate-browser :chrome)
:params {}})]
(if (nil? ctx)
(do
(dispose!)
(fail-data {:phase "graphics-init"
:message "WebGL2 context unavailable"}))
(do
(set! wasm/gl-context-handle (:handle ctx))
(set! wasm/gl-context (:context ctx))
(set! wasm/canvas canvas)
(mark-live!)
;; Mirror the editor DOM sizing choice.
(h/call wasm/internal-module "_resize_viewbox" width height)
(install-listeners! canvas epoch)
(let [graphics-ms (- (now) g0)
renderer (renderer-string (:context ctx))
;; Generation, validation and order derivation
;; stay outside timers. rects/build fills
;; workload defaults; only the seed varies per
;; attempt.
snapshot (-> (rects/build {:seed seed})
(scenes/validate!))
ordered (upload/prepare-scene snapshot)]
(when-not (current?)
(throw (ex-info "stale" {})))
;; Editor order: view before pool. The timed window
;; covers view, pool, loading lifecycle, batch and
;; tile preparation.
(.catch (fn [cause]
(throw (ex-info (str "module init failed: "
(or (ex-message cause) cause))
{:phase "module-init"}
cause))))
(.then (fn [installed]
(guard-current! epoch "module-init")
installed))
(.then (fn [{:keys [module factory-ms]}]
(guard-current! epoch "graphics-init")
(set! wasm/internal-module module)
(let [canvas (build-canvas! width height dpr)]
(.appendChild (.-body js/document) canvas)
(reset! canvas* canvas)
(let [g0 (now)
ctx (try
(webgl/init-context!
canvas
{:module module
:context-id "webgl2"
:css-width width
:css-height height
:dpr dpr
:flags 0
:browser (sr/translate-browser :chrome)
:params {}})
(catch :default cause
(throw (ex-info "graphics init failed"
{:phase "graphics-init"}
cause))))]
(if (nil? ctx)
(throw (ex-info "WebGL2 context unavailable"
{:phase "graphics-init"}))
(do
(set! wasm/gl-context-handle (:handle ctx))
(set! wasm/gl-context (:context ctx))
(set! wasm/canvas canvas)
(mark-live!)
(try
(h/call wasm/internal-module "_resize_viewbox" width height)
(catch :default cause
(throw (ex-info "resize viewbox failed"
{:phase "graphics-init"}
cause))))
(install-listeners! canvas epoch)
{:module-ms factory-ms
:graphics-ms (- (now) g0)
:renderer (renderer-string (:context ctx))
:canvas canvas
:ctx ctx}))))))
(.then (fn [g]
(guard-current! epoch "scene-build")
(try
(let [snapshot (-> (rects/build {:seed seed})
(scenes/validate!))]
(assoc g
:snapshot snapshot
:ordered (upload/prepare-scene snapshot)))
(catch :default cause
(throw (ex-info "scene build failed"
{:phase "scene-build"}
cause))))))
(.then (fn [g]
(guard-current! epoch "upload")
(try
(let [u0 (now)]
(h/call wasm/internal-module "_set_view"
(:scale view) (- (:x view)) (- (:y view)))
(h/call wasm/internal-module "_init_shapes_pool"
(count (:objects snapshot)))
(count (:objects (:snapshot g))))
(h/call wasm/internal-module "_begin_loading")
(try
(serialize-shape/serialize-shapes-batch!
ordered
(:ordered g)
{:include-layout? false
:include-fills-strokes? true})
(finally
(h/call wasm/internal-module "_end_loading")))
(h/call wasm/internal-module "_set_view_end")
(let [upload-ms (- (now) u0)
r0 (now)]
(-> (poll-full epoch 0 r0)
(.then
(fn [poll]
(render-ok module-ms graphics-ms upload-ms
(live?) poll snapshot seed
width height dpr renderer))
(fn [_]
(dispose!)
(fail-data {:phase "first-render"
:message "render threw"})))))))))))
(fn [result]
result)
(fn [cause]
(if (= "stale" (ex-message cause))
#js {"status" "stale"}
(do
(dispose!)
(fail-data {:phase "aborted"
:message (ex-message cause)}))))))))))
(assoc g :upload-ms (- (now) u0)))
(catch :default cause
(if (stale? cause)
(throw cause)
(throw (ex-info "upload failed"
{:phase "upload"}
cause)))))))
(.then (fn [g]
(guard-current! epoch "first-render")
(let [{:keys [module-ms graphics-ms renderer canvas ctx snapshot upload-ms]} g
r0 (now)]
(-> (poll-full epoch 0 r0)
(.then (fn [poll]
(render-ok epoch module-ms graphics-ms upload-ms
(live?) poll snapshot seed
canvas (:context ctx)
width height dpr renderer)))
(.catch (fn [cause]
(terminal-failure epoch cause "first-render")))))))
(.catch (fn [cause]
(terminal-failure epoch cause "aborted"))))))))
(catch :default cause
(js/Promise.resolve
(fail-data {:phase "setup" :message (ex-message cause)})))))

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

@ -7,19 +7,27 @@
(ns frontend-tests.benches.lifecycle-test
"Boundary-fake coverage for the ticket-05 browser lifecycle.
Full load/render runs headless in the pilot (real WASM + DOM). Here every
DOM/FFI boundary is faked or avoided: bridge arg validation (seeds, views,
viewports), viewport resolution, disposal state reset, epoch bumps,
context-loss flags and bridge shape. No canvas, rAF or module import is
exercised: partial-init rendering, live context loss and stale-callback
races run headless in the pilot; exhaustive stale-callback unit coverage
belongs to ticket 06's protocol-test with its injected clock."
Full load/render runs headless in the pilot (real WASM + DOM). Here the
DOM/FFI boundary is faked: bridge arg validation (seeds, views, viewports,
non-finite numbers), viewport resolution, disposal state reset, epoch
bumps, owner-guard and terminal-failure mapping, context-loss flags, bridge
shape, and through-entry `load-rects` scenarios (happy path, rejected
import, post-registration failure, overlapping loads) against fake canvases
and a fake Emscripten factory. GL init/release unit behavior lives in
`frontend-tests.render-wasm.webgl-test`; live context loss and
blocked-page cancellation belong to ticket 15's failure verification;
exhaustive stale-callback coverage belongs to ticket 06's protocol-test
with its injected clock."
(:require
[app.common.render-wasm.wasm :as wasm]
[benches.render-wasm.browser :as browser]
[benches.render-wasm.scenes.core :as core]
[cljs.test :as t :include-macros true]))
;; Partial-init unwinding of `init-context!` is covered in
;; `frontend-tests.render-wasm.webgl-test`, which also pins the success,
;; nil-context and registration-failure cases.
(defn- expect-failed-args
"Calls `load-rects` with `args` (never touching DOM/FFI: validation runs
first) and asserts a failure map. Calls `done` when finished."
@ -60,6 +68,21 @@
true
done)))
(t/deftest non-finite-view-values-fail-before-timers
(t/async done
(expect-failed-args #js {"seed" 42
"view" #js {"scale" js/Infinity "x" 0 "y" 0}}
true
(fn []
(expect-failed-args #js {"seed" 42
"view" #js {"scale" 1 "x" js/NaN "y" 0}}
true
(fn []
(expect-failed-args #js {"seed" 42
"view" #js {"scale" 1 "x" 0 "y" js/Infinity}}
true
done)))))))
(t/deftest viewport-defaults-apply-at-use
(t/is (= {:width 1920 :height 1080 :dpr 2}
(core/resolve-viewport {:scale 1 :x 0 :y 0})))
@ -71,11 +94,22 @@
(set! wasm/internal-module #js {})
(set! wasm/context-initialized? true)
(reset! wasm/context-lost? true)
(let [result (browser/dispose!)]
(t/is (= "disposed" (unchecked-get result "status")))
(t/is (nil? wasm/internal-module))
(t/is (false? wasm/context-initialized?))
(t/is (false? @wasm/context-lost?)))
(set! wasm/gl-context-handle 7)
(set! wasm/gl-context #js {})
(set! wasm/canvas #js {})
(let [removed (atom false)
fake #js {:remove (fn [] (reset! removed true))}]
(reset! @#'browser/canvas* fake)
(let [result (browser/dispose!)]
(t/is (= "disposed" (unchecked-get result "status")))
(t/is (nil? wasm/internal-module))
(t/is (false? wasm/context-initialized?))
(t/is (false? @wasm/context-lost?))
(t/is (nil? wasm/gl-context-handle))
(t/is (nil? wasm/gl-context))
(t/is (nil? wasm/canvas))
(t/is (nil? @@#'browser/canvas*))
(t/is (true? @removed) "canvas is removed from the DOM")))
(t/testing "double dispose is idempotent"
(let [result (browser/dispose!)]
(t/is (= "disposed" (unchecked-get result "status")))
@ -85,8 +119,306 @@
(browser/dispose!)
(t/is (< before @@#'browser/owner-epoch*)))))
(t/deftest stale-work-never-disposes-the-newer-owner
(let [guard @#'browser/guard-current!
terminate @#'browser/terminal-failure
epoch @@#'browser/owner-epoch*]
(t/testing "guard passes for the current owner"
(t/is (nil? (guard epoch "module-init"))))
(t/testing "guard throws stale once superseded"
(browser/dispose!)
(let [thrown (try
(guard epoch "module-init")
nil
(catch :default cause
cause))]
(t/is (true? (:benches.render-wasm.browser/stale (ex-data thrown)))
"the marker lives in ex-data, never in message text")))
(t/testing "terminal stale resolves without disposal"
(let [before @@#'browser/owner-epoch*
result (terminate epoch
(ex-info "superseded"
{:benches.render-wasm.browser/stale true
:phase "upload"})
"upload")
after @@#'browser/owner-epoch*]
(t/is (= "stale" (unchecked-get result "status")))
(t/is (= before after) "no epoch bump: the newer owner is untouched")))
(t/testing "terminal failure keeps its phase and disposes the current owner"
(let [current @@#'browser/owner-epoch*
result (terminate current (ex-info "upload failed" {:phase "upload"}) "aborted")]
(t/is (= "failed" (unchecked-get result "status")))
(t/is (= "upload" (unchecked-get result "phase")))
(t/is (< current @@#'browser/owner-epoch*) "current owner disposed")))
(t/testing "phaseless failures use the fallback phase"
(set! wasm/internal-module nil)
(let [current @@#'browser/owner-epoch*
result (terminate current (ex-info "boom" {}) "aborted")]
(t/is (= "failed" (unchecked-get result "status")))
(t/is (= "aborted" (unchecked-get result "phase")))
(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 #{"loadRects"} keys))
(t/is (some #{"dispose"} keys))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Through-entry fake harness.
;;
;; TODO(mem:render-wasm/performance/cljs-rewrite/06-render-and-interaction-protocol):
;; shared entry-test harness. Ticket 06 replaces `load-rects` with the generic
;; case-descriptor entry: keep this section (fake DOM, fake Emscripten factory,
;; call recording) and repoint the bridge calls below; only call shapes and
;; result assertions change. The DOM/module boundary the fakes cover does not
;; change with the entry.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- record!
"Appends `event` (a vector) to the shared call log."
[event]
(.push (unchecked-get js/globalThis "__benchCalls") (clj->js event)))
(defn- fake-canvas
"Numbered fake canvas identified by `id`. Removal and context loss are
recorded in the shared call log."
[id]
(let [lose-ext #js {:loseContext (fn [] (record! ["lose" id]) nil)}
context #js {:getExtension (fn [name]
(when (= name "WEBGL_lose_context")
lose-ext))}]
#js {:id id
:width 0
:height 0
:style #js {}
:getContext (fn [_ _] context)
:getContextAttributes (fn [] nil)
:addEventListener (fn [_ _] nil)
: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
`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,
;; polling 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) ")")))]
(unchecked-set js/globalThis "document" document)
(unchecked-set js/globalThis "window" window)
(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 "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
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."
(str "export default function (opts) {"
"globalThis.__benchFactoryCalls.push(opts || null);"
"var rec = globalThis.__benchCalls;"
"function push(e) { rec.push(e); }"
"var GL = {"
"registerContext: function () { push(['register']); return 7; },"
"makeContextCurrent: function () {},"
"deleteContext: function (h) { push(['delete', h]); }"
"};"
"var heapBuf = new ArrayBuffer(16777216);"
"var heapNext = 1024;"
"var base = {"
"GL: GL,"
"HEAPU8: new Uint8Array(heapBuf),"
"HEAPU32: new Uint32Array(heapBuf),"
"HEAP32: new Int32Array(heapBuf),"
"HEAPF32: new Float32Array(heapBuf),"
"_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; },"
"_clean_up: function () { push(['clean']); return 0; }"
"};"
"var inst = new Proxy(base, {"
"get: function (t, p) {"
"if (typeof p !== 'string') return undefined;"
"if (p === 'then') return undefined;"
"if (p in t) return t[p];"
"return function () {"
"push(['call', p]);"
"if (globalThis.__benchThrowIn === p) throw new Error('fake ' + p + ' failure');"
"return 0;"
"};"
"}"
"});"
"return Promise.resolve(inst);"
"}"))
(defn- factory-url
"Data-URL Emscripten factory for entry tests. Fully hermetic: no
filesystem or network access."
[]
(str "data:text/javascript," (js/encodeURIComponent factory-source)))
(defn- reset-bench-globals!
"Resets the recording and scenario flags the fake factory reads."
[]
(unchecked-set js/globalThis "__benchCalls" #js [])
(unchecked-set js/globalThis "__benchFactoryCalls" #js [])
(unchecked-set js/globalThis "__benchThrowIn" nil)
(unchecked-set js/globalThis "__benchGateRaf" false)
(unchecked-set js/globalThis "__benchRafCb" nil))
(defn- read-calls
"Call log as Clojure data."
[]
(js->clj (unchecked-get js/globalThis "__benchCalls")))
(defn- effect-count
[calls effect]
(count (filter #(= effect (first %)) calls)))
(defn- load-result
"Calls `browser/load-rects` with `args` and delivers the plain-data result
to `k`. A rejected bridge (a broken always-resolve contract) arrives as a
`threw` map so the test fails with the cause attached."
[args k]
(-> (browser/load-rects args)
(.then (fn [result] (k (js->clj result :keywordize-keys true))))
(.catch (fn [cause] (k {:status "threw" :cause (str cause)})))))
(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`."
[f]
(let [restore-dom! (install-fake-dom!)]
(reset-bench-globals!)
(f (fn []
(browser/dispose!)
(reset-bench-globals!)
(restore-dom!)))))
(t/deftest successful-load-reaches-full
(t/async done
(with-entry-env
(fn [cleanup]
(load-result #js {"seed" 7
"module-url" (factory-url)
"wasm-url" "./fake.wasm"}
(fn [m]
(t/is (= "ok" (:status m)))
(t/is (= 1 (:renderFrames m)))
(t/is (= 1001 (:shapes (:scene m))) "the canonical scene uploads whole")
(let [calls (read-calls)]
(t/is (= 1 (effect-count calls "create")) "one canvas per load")
(t/is (zero? (effect-count calls "remove")) "success keeps the owner live"))
(cleanup)
(done)))))))
(t/deftest rejected-import-resolves-module-init-failure
(t/async done
;; Needs the entry env for the import polyfill, even though the import
;; itself fails before touching the DOM.
(with-entry-env
(fn [cleanup]
(load-result #js {"seed" 7
"module-url" "data:text/javascript,this is not valid javascript((("}
(fn [m]
(t/is (= "failed" (:status m)))
(t/is (= "module-init" (:phase m)))
(cleanup)
(done)))))))
(t/deftest set-browser-failure-releases-registered-context
(t/async done
(with-entry-env
(fn [cleanup]
(unchecked-set js/globalThis "__benchThrowIn" "_set_browser")
(load-result #js {"seed" 7
"module-url" (factory-url)
"wasm-url" "./fake.wasm"}
(fn [m]
(t/is (= "failed" (:status m)))
(t/is (= "graphics-init" (:phase m)))
(let [calls (read-calls)]
(t/is (= 1 (effect-count calls "register")))
(t/is (= 1 (effect-count calls "clean")) "renderer state is released")
(t/is (some #{["delete" 7]} calls) "the registered handle is deleted")
(t/is (= 1 (effect-count calls "lose")) "the browser context is released")
(t/is (= 1 (effect-count calls "remove")) "the canvas is removed"))
(t/is (nil? @@#'browser/canvas*) "no owner left behind")
(cleanup)
(done)))))))
(t/deftest overlapping-load-keeps-the-newer-owner
(t/async done
(with-entry-env
(fn [cleanup]
(unchecked-set js/globalThis "__benchGateRaf" true)
(let [args (fn [seed] #js {"seed" seed
"module-url" (factory-url)
"wasm-url" "./fake.wasm"})
first-load (browser/load-rects (args 7))]
;; Microtasks drain before this macrotask: the first load parked on
;; its first poll frame with a live canvas. Macrotask ordering
;; (never wall timing) sequences the assertions.
(js/setTimeout
(fn []
(t/is (some? (unchecked-get js/globalThis "__benchRafCb"))
"first load is polling")
(let [second-load (browser/load-rects (args 8))]
(js/setTimeout
(fn []
;; The second load completed; release the parked frame so
;; the first load observes its superseded epoch.
(if-some [parked (unchecked-get js/globalThis "__benchRafCb")]
(parked 0)
(t/is false "first load never parked on a poll frame"))
(-> (js/Promise.all #js [first-load second-load])
(.then (fn [results]
(let [[stale ok] (js->clj results :keywordize-keys true)]
(t/is (= "stale" (:status stale)) "superseded load resolves stale")
(t/is (= "ok" (:status ok)) "newer owner completes")
(t/is (= 8 (:seed (:scene ok))) "the completer is the second load")
(let [calls (read-calls)]
(t/is (= 1 (effect-count calls "remove")) "superseded canvas is removed")
(t/is (some #{["remove" 1]} calls))
(t/is (nil? (some #{["remove" 2]} calls)) "newer canvas survives"))
(t/is (some? @@#'browser/canvas*) "the newer owner stays live")
(t/is (true? wasm/context-initialized?)))
(cleanup)
(done)))
(.catch (fn [cause]
(t/is false (str "must resolve, threw: " cause))
(cleanup)
(done)))))
0)))
0))))))