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

♻️ Consolidate error helpers in benchmark runners

Browse Source 
AI-assisted-by: gpt-6.1-sol
This commit is contained in:
Miguel de Benito Delgado 2026-10-30 14:37:25 +01:00
parent 9469c020e0
commit 1a44071d9d
28 changed files with 520 additions and 536 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.clj-kondo/config.edn
View File

@ -9,7 +9,8 @@
app.common.data.macros/get-in clojure.core/get-in
app.common.data.macros/with-open clojure.core/with-open
app.common.data.macros/select-keys clojure.core/select-keys
app.common.logging/with-context clojure.core/do}
app.common.logging/with-context clojure.core/do
benches.render-wasm.errors/attempt clojure.core/do}
:hooks
{:analyze-call

116
frontend/performance/benches/render_wasm/browser/bridge.cljs
View File

@ -35,7 +35,7 @@
[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.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.fingerprint :as fingerprint]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.measurement :as measurement]
@ -267,19 +267,12 @@
accounting; the original failure lives under `:cause` as plain data. Only
the top-level cause decides staleness."
[epoch cause fallback-phase]
(if (fail/stale? cause)
(if (errors/stale? cause)
{:status "stale"}
(let [phase (or (ex/ignoring (:phase (ex-data cause))) fallback-phase "aborted")
message (or (ex/ignoring (ex-message cause)) "unknown failure")
detail (or (ex/ignoring (fail/describe-cause cause))
[{:message fail/unrenderable-cause-text}])
partial (ex/ignoring (:partial (ex-data cause)))
(let [phase (or (ex/ignoring (:phase (ex-data cause))) fallback-phase "aborted")
preparation (get-in @prepared* [:graphics :preparation])]
(dispose-if-current! epoch)
(cond-> (fail/fail-data {:phase phase
:message message
:cause detail})
partial (assoc :partial partial)
(cond-> (errors/fail-data (errors/evidence phase cause))
preparation (assoc :preparation preparation)))))
(defn- guard-current!
@ -289,7 +282,7 @@
never in the message: message text is not a protocol."
[epoch phase]
(when-not (= epoch @owner-epoch*)
(throw (ex-info "superseded" {::fail/stale true :phase phase}))))
(throw (ex-info "superseded" {::errors/stale true :phase phase}))))
(defn- build-canvas!
"Creates the bench canvas with a `width*dpr` backing buffer and an explicit
@ -309,10 +302,10 @@
(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"}))
(errors/fail-data {:phase (if (= :reuse (:context case-desc))
"interact"
"first-render")
:message "disposed or context lost during case"}))
(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
@ -332,11 +325,10 @@
prep (if reuse?
(-> (protocol/restore hooks (:view graphics))
(.catch (fn [cause]
(if (fail/stale? cause)
(if (errors/stale? cause)
(throw cause)
(throw (ex-info "restore failed"
(assoc (ex-data cause) :phase "restore")
(if (some? (ex-data cause)) (ex-cause cause) cause)))))))
(throw (errors/with-context cause "restore failed"
{:phase "restore"}))))))
(js/Promise.resolve nil))
rtx {:case case-desc
:scene (:snapshot graphics)
@ -358,30 +350,26 @@
"Decodes and validates the request before claiming the page. Failure
leaves the current owner untouched."
[request]
(try
(let [params (t/decode-str request)]
(if-not (sm/validate schema:load-scene-args params)
{:error (fail/fail-data {:phase "invalid-args"
:message "load-scene needs a Transit request with case"})}
(let [case-desc (:case params)
scene (decl/registered-scene (:scene case-desc))
local (decl/registered-case (:id case-desc))]
(when (nil? scene)
(throw (ex-info (str "unknown scene: " (:scene case-desc))
{:phase "invalid-args"})))
(when-not (and local
(fn? (:run! local))
(= (:scene local) (:scene case-desc)))
(throw (ex-info (str "missing case body for " (:id case-desc))
{:phase "invalid-args"})))
{:params params
:case-desc case-desc
:local-case local
:scene scene})))
(catch :default cause
{:error (fail/fail-data {:phase "invalid-args"
:message (or (ex-message cause)
"invalid Transit request")})})))
(attempt
(let [params (t/decode-str request)]
(when-not (sm/validate schema:load-scene-args params)
(throw (ex-info "load-scene needs a Transit request with case"
{:phase "invalid-args"})))
(let [case-desc (:case params)
scene (decl/registered-scene (:scene case-desc))
local (decl/registered-case (:id case-desc))]
(when (nil? scene)
(throw (ex-info (str "unknown scene: " (:scene case-desc))
{:phase "invalid-args"})))
(when-not (and local
(fn? (:run! local))
(= (:scene local) (:scene case-desc)))
(throw (ex-info (str "missing case body for " (:id case-desc))
{:phase "invalid-args"})))
{:params params
:case-desc case-desc
:local-case local
:scene scene}))))
(defn- begin-load!
"Claims the page, releases the prior owner and fixes the viewport.
@ -465,7 +453,7 @@
:fingerprint (fingerprint/fingerprint snapshot)
:ordered (snapshot/upload-order snapshot)))
(catch :default cause
(if (fail/stale? cause)
(if (errors/stale? cause)
(throw cause)
(throw (ex-info "scene build failed"
{:phase "scene-build"}
@ -495,7 +483,7 @@
(h/call wasm/internal-module "_set_view_end")
(assoc graphics :upload-ms (- (now) u0) :view view))
(catch :default cause
(if (fail/stale? cause)
(if (errors/stale? cause)
(throw cause)
(throw (ex-info "upload failed"
{:phase "upload"}
@ -520,10 +508,11 @@
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)
(let [parsed (parse-load-request request)]
(if (failure? parsed)
(js/Promise.resolve (errors/fail-data (errors/evidence "invalid-args" parsed)))
(let [{:keys [params case-desc local-case scene]} parsed
{: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)
@ -550,17 +539,14 @@
:graphics (assoc graphics :preparation preparation)})
{:status "ok" :preparation preparation})))
(.catch (fn [cause]
(if (fail/stale? cause)
(if (errors/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))
(errors/with-context cause (errors/message-of cause "setup failed")
{:partial {:setup @available*}})
"aborted"))))))))
(catch :default cause
(js/Promise.resolve (fail/fail-data {:phase "setup" :message (ex-message cause)})))))
(js/Promise.resolve (errors/fail-data (errors/evidence "setup" cause))))))
(defn- execute-prepared
"Runs one body against the owned preparation with a fresh attempt deadline.
@ -571,8 +557,8 @@
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"}))
(js/Promise.resolve (errors/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)))]
@ -592,8 +578,8 @@
(.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")})))))))
(t/encode-str (errors/fail-data {:phase "bridge"
:message (errors/message-of cause "result encoding failed")})))))))
(defn prepare-scene-request
"Accepts a Transit load request and returns a Transit preparation.
@ -612,11 +598,11 @@
[: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"}))))
(js/Promise.resolve (errors/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")}))))))
(js/Promise.resolve (errors/fail-data {:phase "invalid-args"
:message (errors/message-of cause "invalid Transit request")}))))))
(defn load-scene
"Prepares a collected case and runs one attempt, returning Transit evidence.

38
frontend/performance/benches/render_wasm/errors.clj
View File

@ -1,38 +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.errors
"Macro half of `errors.cljs`.")
(defmacro attempt
"Evaluates `body` and returns its value, or the failure it throws.
A thrown value that is not an Error becomes an Error (`as-failure`). A fatal
failure (`fatal?`) is thrown again; with a leading `:catch-fatal` it is
returned like any other failure.
Inside an `^:async` function `body` may use `await`. `failure?` tells a
returned failure from a value.
Examples:
(attempt (parse text))
(attempt (await (open-page owner)))
(attempt :catch-fatal (await (run-session state)))"
[& forms]
(let [catch-fatal? (= :catch-fatal (first forms))
body (if catch-fatal? (rest forms) forms)
thrown (gensym "thrown")
failure (gensym "failure")]
`(try
~@body
(catch :default ~thrown
(let [~failure (benches.render-wasm.errors/as-failure ~thrown)]
~(if catch-fatal?
failure
`(if (benches.render-wasm.errors/fatal? ~failure)
(throw ~failure)
~failure)))))))

206
frontend/performance/benches/render_wasm/errors.cljc Normal file
View File

@ -0,0 +1,206 @@
;; 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.errors
"Failure values and plain diagnostics for renderer benchmarks.
A step that can fail returns its value or an Error. `attempt` catches thrown
values and `failure?` identifies the returned Error. Fatal failures mark
writes to the owner's record or log and propagate to a boundary that uses
`:catch-fatal`.
`evidence` and `describe-cause` produce diagnostics for saved records and
Transit responses."
#?(:cljs (:require-macros
[app.common.exceptions :as ex]
[benches.render-wasm.errors])))
#?(:clj
(defmacro attempt
"Evaluates `body` and returns its value, or the failure it throws.
A thrown value becomes an Error through `as-failure`. Fatal failures
propagate unless a leading `:catch-fatal` requests them as values.
Inside an `^:async` function, `body` may use `await`.
Examples:
(attempt (parse text))
(attempt (await (open-page owner)))
(attempt :catch-fatal (await (run-session state)))"
[& forms]
(let [catch-fatal? (= :catch-fatal (first forms))
body (if catch-fatal? (rest forms) forms)
thrown (gensym "thrown")
failure (gensym "failure")]
`(try
~@body
(catch :default ~thrown
(let [~failure (benches.render-wasm.errors/as-failure ~thrown)]
~(if catch-fatal?
failure
`(if (benches.render-wasm.errors/fatal? ~failure)
(throw ~failure)
~failure))))))))
#?(:cljs
(do
(def ^:private fatal-cause-depth 8)
(def ^:private evidence-cause-depth 3)
(def ^:private max-cause-chars 500)
(def ^:private unrenderable-value "unrenderable value")
(def ^:private unrenderable-cause-text "unrenderable cause")
(defn failure?
"True when `x` is an Error."
[x]
(instance? js/Error x))
(defn message-of
"Returns the error message or string form of `cause`, with a fallback
when formatting fails. The default fallback is unknown failure."
([cause]
(message-of cause "unknown failure"))
([cause fallback]
(or (ex/ignoring (ex-message cause))
(ex/ignoring (str cause))
fallback)))
(defn fatal-error
"Returns an exception that `fatal?` recognizes, with `data` and `cause`."
[message data cause]
(ex-info message (assoc data :fatal true) cause))
(defn fatal?
"True when `cause` or one of its causes has the ex-data `:fatal` marker."
[cause]
(loop [cause cause
depth 0]
(cond
(nil? cause) false
(:fatal (ex-data cause)) true
(>= depth fatal-cause-depth) false
:else (recur (ex-cause cause) (inc depth)))))
(defn as-failure
"Returns an Error for `thrown`. Errors pass through; other values supply
the message and the `:thrown` ex-data."
[thrown]
(if (failure? thrown)
thrown
(ex-info (if (string? thrown)
thrown
(str "non-error value thrown: " (or (ex/ignoring (pr-str thrown)) "unprintable value")))
{:thrown thrown})))
(defn with-data
"Adds default ex-data to an Error, keeping its message and using it as
the cause. Existing keys win. Other values pass through."
[x data]
(if (failure? x)
(ex-info (message-of x) (merge data (ex-data x)) x)
x))
(defn with-context
"Returns an exception with `message` and added diagnostic context.
New fields override existing fields; existing partial measurements win
over earlier measurements in `data`. An exception with ex-data keeps
its underlying cause. Other values become the cause."
[cause message data]
(let [existing (ex-data cause)
context (cond-> (merge existing data)
(contains? data :partial)
(assoc :partial (merge (:partial data) (:partial existing))))]
(ex-info message context (if (some? existing) (ex-cause cause) cause))))
(defn stale?
"True when the exception's own data marks superseded work."
[cause]
(true? (::stale (ex-data cause))))
(defn fail-data
"Marks diagnostic data with the failed status."
[data]
(assoc data :status "failed"))
(defn- truncate-cause-str
"Bounds text to 500 UTF-16 units, preserving surrogate pairs.
Returns a fallback string when conversion fails."
[s]
(or (ex/ignoring
(let [text (str s)]
(if (<= (count text) max-cause-chars)
text
(let [cut (subs text 0 max-cause-chars)
last (.charCodeAt cut (dec max-cause-chars))]
(if (and (>= last 0xD800)
(<= last 0xDBFF)
(let [nxt (.charCodeAt text max-cause-chars)]
(and (>= nxt 0xDC00) (<= nxt 0xDFFF))))
(subs cut 0 (dec max-cause-chars))
cut)))))
unrenderable-value))
(defn- sanitize-cause-value
[value]
(cond
(or (nil? value) (boolean? value) (keyword? value) (number? value))
value
(string? value)
(truncate-cause-str value)
:else
(truncate-cause-str (or (ex/ignoring (pr-str value)) unrenderable-value))))
(defn- describe-cause-level
[cause]
(or (ex/ignoring
(let [message (ex/ignoring (ex-message cause))
data (ex/ignoring (ex-data cause))
text (cond
(string? message) message
(string? cause) cause
(nil? cause) "unknown failure"
:else (pr-str cause))
out {:message (sanitize-cause-value text)}]
(if (map? data)
(reduce (fn [m k]
(if (contains? data k)
(assoc m k (sanitize-cause-value (get data k)))
m))
out
[:fn :code :type :hint])
out)))
{:message unrenderable-cause-text}))
(defn describe-cause
"Returns up to three cause levels as plain data. Each level keeps a
bounded message and available :fn, :code, :type and :hint details.
Unprintable values produce fallback strings."
[cause]
(or (ex/ignoring
(loop [current cause
depth 0
acc []]
(if (or (nil? current) (>= depth evidence-cause-depth))
(if (seq acc)
acc
[{:message "unknown failure"}])
(let [level (describe-cause-level current)
next (ex/ignoring (ex-cause current))]
(recur next (inc depth) (conj acc level))))))
[{:message unrenderable-cause-text}]))
(defn evidence
"Returns plain diagnostics for `phase`, including available partial
measurements and a bounded description of the cause."
[phase cause]
(let [partial (ex/ignoring (:partial (ex-data cause)))]
(cond-> {:phase (if (keyword? phase) (name phase) (str phase))
:message (message-of cause)
:cause (describe-cause cause)}
partial (assoc :partial partial))))))

74
frontend/performance/benches/render_wasm/errors.cljs
View File

@ -1,74 +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.errors
"Failure values for the benchmark harness.
A step that can fail returns its value or an Error. `attempt` turns a thrown
value into that Error and `failure?` tells the two apart:
(let [page (attempt (await (open-page owner)))]
(if (failure? page)
(record-failure page)
(use page)))
A fatal failure marks a write to the caller's own record or log. It cannot
be recorded in that record, so `attempt` throws it again and only a boundary
that owns the record or reports to the user catches it with `:catch-fatal`.
This namespace has no Node or browser dependencies."
(:require-macros
[app.common.exceptions :as ex]))
(def ^:private max-cause-depth 8)
(defn failure?
"True when `x` is an Error."
[x]
(instance? js/Error x))
(defn message-of
"Returns the message of an Error or the string form of another value."
[cause]
(or (ex-message cause) (str cause)))
(defn fatal-error
"Returns an exception that `fatal?` recognizes. `data` is its ex-data map and
`cause` the original failure."
[message data cause]
(ex-info message (assoc data :fatal true) cause))
(defn fatal?
"True when `cause` or one of its causes has the ex-data `:fatal` marker."
[cause]
(loop [cause cause
depth 0]
(cond
(nil? cause) false
(:fatal (ex-data cause)) true
(>= depth max-cause-depth) false
:else (recur (ex-cause cause) (inc depth)))))
(defn as-failure
"Returns `thrown` when it is an Error. Otherwise returns an Error whose
message is the string `thrown` or the printed value, with the value in the
`:thrown` ex-data."
[thrown]
(if (failure? thrown)
thrown
(ex-info (if (string? thrown)
thrown
(str "non-error value thrown: " (or (ex/ignoring (pr-str thrown)) "unprintable value")))
{:thrown thrown})))
(defn with-data
"Returns `x` when it is not a failure. For a failure returns an exception
with the same message, `x` as its cause and `data` merged under the ex-data
of `x`, so keys already present on `x` win."
[x data]
(if (failure? x)
(ex-info (message-of x) (merge data (ex-data x)) x)
x))

111
frontend/performance/benches/render_wasm/failures.cljs
View File

@ -1,111 +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.failures
"Helpers for browser failures."
(:require-macros
[app.common.exceptions :as ex]))
(def ^:const max-cause-depth
"How many cause levels the failure cause keeps: the phase wrapper, the
WASM-error mapping and the original failure."
3)
(def ^:const max-cause-chars
"Hard cap for any string in the failure cause, to avoid bloating the bridge
payload."
500)
(def ^:const unrenderable-value
"Fallback for a cause value `pr-str` cannot render."
"unrenderable value")
(def ^:const unrenderable-cause-text
"Fallback message when a cause level cannot be rendered."
"unrenderable cause")
(defn stale?
"True when `cause` is the superseded-owner marker from `guard-current!`."
[cause]
(true? (::stale (ex-data cause))))
(defn fail-data
[m]
(assoc m :status "failed"))
(defn- truncate-cause-str
"Truncates `s` to `max-cause-chars` without splitting a unicode surrogate pair.
Never throws."
[s]
(or (ex/ignoring
(let [text (str s)]
(if (<= (count text) max-cause-chars)
text
;; check whether truncating the string at max-cause-chars would split a
;; Unicode character represented by a surrogate pair (e.g. some emoji)
(let [cut (subs text 0 max-cause-chars)
last (.charCodeAt cut (dec max-cause-chars))]
(if (and (>= last 0xD800)
(<= last 0xDBFF)
(let [nxt (.charCodeAt text max-cause-chars)]
(and (>= nxt 0xDC00) (<= nxt 0xDFFF))))
(subs cut 0 (dec max-cause-chars))
cut)))))
unrenderable-value))
(defn- sanitize-cause-value
"Keeps Transit numbers and other plain-data leaves as-is, stringifies
anything else with `pr-str` truncation. Never throws."
[value]
(cond
(or (nil? value) (boolean? value) (keyword? value) (number? value))
value
(string? value)
(truncate-cause-str value)
:else
(truncate-cause-str (or (ex/ignoring (pr-str value)) unrenderable-value))))
(defn- describe-cause-level
"Plain-data projection of one `ex-cause` link. Keeps `:message` plus the
allowlisted WASM details, sanitized. Never throws."
[cause]
(or (ex/ignoring
(let [message (ex/ignoring (ex-message cause))
data (ex/ignoring (ex-data cause))
text (cond
(string? message) message
(string? cause) cause
(nil? cause) "unknown failure"
:else (pr-str cause))
out {:message (sanitize-cause-value text)}]
(if (map? data)
(reduce (fn [m k]
(if (contains? data k)
(assoc m k (sanitize-cause-value (get data k)))
m))
out
[:fn :code :type :hint])
out)))
{:message unrenderable-cause-text}))
(defn describe-cause
"Walks at most `max-cause-depth` cause levels, projecting each with
`describe-cause-level`. Always returns plain data, never throws."
[cause]
(or (ex/ignoring
(loop [current cause
depth 0
acc []]
(if (or (nil? current) (>= depth max-cause-depth))
(if (seq acc)
acc
[{:message "unknown failure"}])
(let [level (describe-cause-level current)
next (ex/ignoring (ex-cause current))]
(recur next (inc depth) (conj acc level))))))
[{:message unrenderable-cause-text}]))

20
frontend/performance/benches/render_wasm/node/artifacts.cljs
View File

@ -17,6 +17,7 @@
[app.common.transit :as transit]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.node.files :as files]
[benches.render-wasm.node.time :as time]
[clojure.string :as str]))
(def schema:build
@ -68,21 +69,14 @@
(defn- check-id
[id]
(when-not (and (string? id) (re-matches #"[A-Za-z0-9][A-Za-z0-9_-]{0,127}" id))
(when-not (files/valid-id? id)
(throw (ex-info "invalid renderer build id" {:type ::invalid-id :id id})))
id)
(defn- contained?
[root file]
(let [relative (path/relative root file)]
(and (not (path/isAbsolute relative))
(not= relative "..")
(not (str/starts-with? relative (str ".." path/sep))))))
(defn- checked-path
[root file]
(let [resolved (fs/realpathSync file)]
(when-not (contained? root resolved)
(when-not (files/contained? root resolved)
(throw (ex-info "renderer artifact path escapes its managed directory"
{:type ::unsafe-path :path file})))
resolved))
@ -104,8 +98,8 @@
(defn inside-builds?
"Checks the whole builds tree, resolving symlink ancestors of both paths."
[frontend-root output-path]
(contained? (files/get-real-path (path/join (managed-root frontend-root) "builds"))
(files/get-real-path output-path)))
(files/contained? (files/get-real-path (path/join (managed-root frontend-root) "builds"))
(files/get-real-path output-path)))
(defn- build-reference
[root id manifest]
@ -131,7 +125,7 @@
"
[root selection provenance]
(let [id (str (random-uuid))
now (.toISOString (js/Date.))
now (time/now)
manifest {:type :renderer-build
:id id
:status :building
@ -172,7 +166,7 @@
{:type ::terminal-build
:id (:id build)
:status (:status current)})))
(let [manifest (assoc manifest :updated-at (.toISOString (js/Date.)))]
(let [manifest (assoc manifest :updated-at (time/now))]
(files/atomic-write (:manifest-path build) (codec/encode-str manifest))
(assoc build :manifest manifest)))))

5
frontend/performance/benches/render_wasm/node/browser.cljs
View File

@ -15,8 +15,7 @@
["path" :as path]
["playwright" :as playwright]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt]]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.errors :as errors :refer [attempt]]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.options :as options]
[benches.render-wasm.node.process :as process]))
@ -265,7 +264,7 @@
(throw (ex-info "browser shutdown failed after startup error"
{:type ::startup-cleanup
:endpoint @(:address endpoint) :user-data-dir user-data-dir
:startup-failure (failures/describe-cause cause)}
:startup-failure (errors/describe-cause cause)}
cleanup-cause))))
(throw (ex-info (errors/message-of cause)
(assoc (ex-data cause) :endpoint @(:address endpoint) :user-data-dir user-data-dir)

5
frontend/performance/benches/render_wasm/node/build.cljs
View File

@ -17,8 +17,7 @@
["path" :as path]
["url" :as url]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.catalog :as catalog]
@ -148,7 +147,7 @@
(artifacts/load-build root (:id ready))))
(catch :default cause
(let [build @build-ref
failure {:phase @phase :cause (failures/describe-cause cause)}
failure {:phase @phase :cause (errors/describe-cause cause)}
saved (when (= :building (get-in build [:manifest :status]))
(attempt :catch-fatal
(artifacts/write-manifest

2
frontend/performance/benches/render_wasm/node/commands.cljs
View File

@ -9,7 +9,7 @@
(:require
[app.common.schema :as sm]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.feature-comparison :as feature-comparison]

15
frontend/performance/benches/render_wasm/node/compare.cljs
View File

@ -7,20 +7,13 @@
(ns benches.render-wasm.node.compare
"Offline comparison of two saved schema:run records.
Inputs are user file paths resolved from the caller's cwd. The namespace
depends only on record decoding and the shared report pipeline; it starts no
build, host, browser or renderer."
Inputs are user file paths resolved from the caller's cwd."
(:require
["fs" :as fs]
["path" :as path]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.result :as result]))
(defn- read-run
[file]
(result/decode (fs/readFileSync (path/resolve file) "utf8")))
(defn execute
"Reads and compares two saved run files.
@ -38,8 +31,8 @@
differences and formatted text."
[baseline-path candidate-path {:keys [cases allow-build-differences
allow-scene-differences allow-all-differences]}]
(let [baseline (read-run baseline-path)
candidate (read-run candidate-path)
(let [baseline (runs/get-record baseline-path)
candidate (runs/get-record candidate-path)
comparison (result/check-record
(compare/compare-runs
baseline candidate

97
frontend/performance/benches/render_wasm/node/feature_comparison.cljs
View File

@ -11,22 +11,21 @@
["node:timers/promises" :as timers]
["path" :as path]
[app.common.schema :as sm]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.catalog :as catalog]
[benches.render-wasm.node.files :as files]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.outcome :as outcome]
[benches.render-wasm.node.process :as process]
[benches.render-wasm.node.run :as run]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.node.time :as time]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.result :as result]
[clojure.set :as set]))
(def ^:private record-file "feature-comparison.transit")
(def ^:private warnings
["Timing values do not determine success."
"Intervals are exploratory; the comparison records no p-value verdicts."])
@ -37,17 +36,13 @@
:create-run-home runs/create-home
:execute-run run/execute})
(defn- now
[]
(.toISOString (js/Date.)))
(defn- invalid-home
[message data]
(throw (ex-info message (assoc data :type ::invalid-home))))
(defn- check-id
[id]
(when-not (and (string? id) (re-matches #"[A-Za-z0-9][A-Za-z0-9_-]{0,127}" id))
(when-not (files/valid-id? id)
(invalid-home "invalid feature comparison id" {:id id}))
id)
@ -65,21 +60,17 @@
(when (artifacts/inside-builds? root dir)
(invalid-home "feature comparison cannot use a directory inside builds" {:path dir}))
(try
(fs/mkdirSync dir #js {:recursive true})
(fs/writeFileSync (path/join dir "feature-comparison.log") "" #js {:encoding "utf8" :flag "wx"})
(files/create-home dir "feature-comparison")
(catch :default cause
(invalid-home "cannot create feature comparison home"
{:path dir :cause (errors/message-of cause)})))
{:dir dir
:log-path (path/join dir "feature-comparison.log")
:record-path (path/join dir record-file)}))
(throw (ex-info "cannot create feature comparison home"
{:type ::invalid-home :path dir :cause (errors/message-of cause)}
cause))))))
(defn write-record
"Validates schema:feature-comparison and atomically replaces the saved file."
[home record]
(let [record (result/check-record record)]
(files/atomic-write (:record-path home) (result/encode record))
record))
(files/atomic-write (:record-path home) (result/encode record))
record)
(defn- permissions
[options]
@ -87,22 +78,6 @@
:allow-scene-differences (boolean (:allow-scene-differences options))
:allow-all-differences (boolean (:allow-all-differences options))})
(defn- signal-name
[signal]
(when (and signal (.-aborted ^js signal))
(let [reason (.-reason ^js signal)]
(cond
(string? reason) reason
(keyword? reason) (name reason)
:else (or (:signal (ex-data reason)) "SIGINT")))))
(defn- failure-evidence
[phase cause]
(cond-> {:phase (name phase)
:message (errors/message-of cause)
:cause (failures/describe-cause cause)}
(:log-path (ex-data cause)) (assoc :tail-log (:log-path (ex-data cause)))))
(defn- storage-error
[cause log-path]
(errors/fatal-error "cannot persist feature comparison"
@ -135,7 +110,7 @@
(defn- persist
[state update]
(let [next (assoc (update @(:record-ref state)) :updated-at (now))
(let [next (assoc (update @(:record-ref state)) :updated-at (time/now))
saved (try
(write-record (:home state) next)
(catch :default cause
@ -167,7 +142,7 @@
(fn [record]
(change-config record slug
#(-> % (assoc :status :failed
:failure (failure-evidence phase cause))
:failure (errors/evidence phase cause))
(dissoc :reason))))))
(defn- interrupt-config
@ -205,7 +180,7 @@
(defn- finish
[state status exit-code causes]
(let [record (persist state #(assoc % :status status :ended-at (now)))]
(let [record (persist state #(assoc % :status status :ended-at (time/now)))]
{:comparison record
:home (:home state)
:log-path (get-in state [:home :log-path])
@ -238,15 +213,6 @@
:build (select-keys build [:id :manifest-path :log-path]))
(dissoc :failure :reason))))))
(defn- load-run
[path]
(when-not (and (string? path) (fs/existsSync path))
(throw (ex-info "run record is missing" {:type ::missing-run :path path})))
(let [record (result/decode (fs/readFileSync path "utf8"))]
(when-not (= :run-record (:type record))
(throw (ex-info "expected a saved run record" {:type ::invalid-run :path path})))
record))
(defn- stop-outcome
[slug reason cause]
{:stop? true
@ -260,20 +226,20 @@
(defn- interrupt-configuration
[state slug signal phase cause]
(interrupt-config state slug signal (when cause (failure-evidence phase cause)))
(interrupt-config state slug signal (when cause (errors/evidence phase cause)))
(cond-> {:interrupted? true :signal signal}
cause (assoc :error cause)))
(defn- fail-or-interrupt
[state slug phase cause]
(if-let [signal (signal-name (:signal state))]
(if-let [signal (process/signal-name (:signal state))]
(interrupt-configuration state slug signal phase cause)
(fail-configuration state slug phase (str (name phase) " failure") cause)))
(defn- begin-configuration
[state configuration]
(let [slug (:slug configuration)]
(if-let [signal (signal-name (:signal state))]
(if-let [signal (process/signal-name (:signal state))]
{:configuration configuration
:outcome (interrupt-configuration state slug signal nil nil)}
(do
@ -311,7 +277,7 @@
:build-timeout-ms (get-in state [:options :build-timeout-ms])
:signal (:signal state)
:on-created (partial record-created-build state slug)})))
signal (signal-name (:signal state))]
signal (process/signal-name (:signal state))]
(cond
(failure? built)
(assoc flow :outcome (fail-or-interrupt state slug :build built))
@ -334,7 +300,7 @@
:filter (get-in state [:options :filter])})
(:cases state)))
(errors/with-data {:log-path (:log-path selected)}))
signal (signal-name (:signal state))
signal (process/signal-name (:signal state))
step (cond
(failure? mismatch?) (fail-or-interrupt state slug :catalog mismatch?)
signal (interrupt-configuration state slug signal nil nil)
@ -371,7 +337,7 @@
[slug home response]
(or (some #(when (errors/fatal? %) %) (:errors response))
(attempt
(when-not (= (get-in response [:run :run-id]) (:run-id (load-run (:record-path home))))
(when-not (= (get-in response [:run :run-id]) (:run-id (runs/get-record (:record-path home))))
(throw (ex-info "saved run identity disagrees with execution result"
{:type ::invalid-run :configuration slug}))))))
@ -393,10 +359,10 @@
(defn- get-run-failure
[{:keys [run evidence-error gpu-failure error]}]
(cond
evidence-error (failure-evidence :run-evidence evidence-error)
evidence-error (errors/evidence :run-evidence evidence-error)
gpu-failure gpu-failure
(map? (get-in run [:termination :failure])) (get-in run [:termination :failure])
error (failure-evidence :run error)))
error (errors/evidence :run error)))
(defn- classify-run
[signal evidence]
@ -446,7 +412,7 @@
[state flow response]
(let [slug (get-in flow [:configuration :slug])
facts (get-run-evidence slug (:run-home flow) response)
evidence (classify-run (signal-name (:signal state)) facts)]
evidence (classify-run (process/signal-name (:signal state)) facts)]
(record-run-result state slug evidence)
(config-run-outcome slug evidence)))
@ -511,8 +477,7 @@
(defn- save-comparison
[path comparison log-path]
(let [record (result/check-record comparison)
text (result/encode record)]
(let [text (result/encode comparison)]
(try
(files/atomic-write path text)
(catch :default cause
@ -540,8 +505,8 @@
(let [record @(:record-ref state)
baseline-config (config-by-slug record (:from edge))
candidate-config (config-by-slug record (:to edge))
baseline (load-run (get-in baseline-config [:run :record-path]))
candidate (load-run (get-in candidate-config [:run :record-path]))
baseline (runs/get-record (get-in baseline-config [:run :record-path]))
candidate (runs/get-record (get-in candidate-config [:run :record-path]))
facts (edge-facts baseline candidate edge)
comparison (compare/compare-runs baseline candidate (get-comparison-options record facts))
path (path/join (get-in state [:home :dir])
@ -559,13 +524,13 @@
(cond
(and (failure? result) (errors/fatal? result))
(do
(mark-edge state edge :failed {:failure (failure-evidence :comparison-storage result)})
(mark-edge state edge :failed {:failure (errors/evidence :comparison-storage result)})
(mark-edges-unattempted state "not attempted after comparison storage failure")
(throw result))
(failure? result)
(do
(mark-edge state edge :failed {:failure (failure-evidence :comparison result)})
(mark-edge state edge :failed {:failure (errors/evidence :comparison result)})
(or error result))
(pos? (:unacknowledged result))
@ -584,7 +549,7 @@
(defn- ^:async analyze-edges
[state edges error]
(await (timers/setImmediate))
(if-let [signal (signal-name (:signal state))]
(if-let [signal (process/signal-name (:signal state))]
(do
(mark-edges-unattempted state (str "interrupted by " signal))
{:interrupted signal :error error})
@ -601,7 +566,7 @@
(defn- ^:async run-edges
[state error]
(if-let [signal (signal-name (:signal state))]
(if-let [signal (process/signal-name (:signal state))]
(interrupt-comparison state signal error)
(do
(create-comparison-directory state)
@ -614,7 +579,7 @@
(defn- ^:async run-comparisons
[state configurations]
(if-let [signal (signal-name (:signal state))]
(if-let [signal (process/signal-name (:signal state))]
(interrupt-comparison state signal nil)
(if-let [[configuration & pending] (seq configurations)]
(let [step (await (execute-config state configuration))]
@ -638,7 +603,7 @@
:cases (:cases prepared)
:signal signal
:services services
:record-ref (atom (initial-record prepared comparison-id (now)))
:record-ref (atom (initial-record prepared comparison-id (time/now)))
:saved-ref (atom nil)})
(defn- initialize-comparison

31
frontend/performance/benches/render_wasm/node/files.cljs
View File

@ -5,10 +5,37 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.node.files
"Small filesystem helpers shared by benchmark storage writers."
"Filesystem paths and storage for benchmark artifacts."
(:require
["fs" :as fs]
["path" :as path]))
["path" :as path]
[clojure.string :as str]))
(defn valid-id?
"True for IDs of up to 128 letters, digits, underscores or hyphens,
starting with a letter or digit."
[id]
(and (string? id)
(boolean (re-matches #"[A-Za-z0-9][A-Za-z0-9_-]{0,127}" id))))
(defn contained?
"True when `file` is `root` or a path below it."
[root file]
(let [relative (path/relative root file)]
(and (not (path/isAbsolute relative))
(not= relative "..")
(not (str/starts-with? relative (str ".." path/sep))))))
(defn create-home
"Creates `dir` and its parents, reserves an empty log, and returns the
directory, log path and record path. `stem` names the .log and .transit files."
[dir stem]
(let [log-path (path/join dir (str stem ".log"))]
(fs/mkdirSync dir #js {:recursive true})
(fs/writeFileSync log-path "" #js {:encoding "utf8" :flag "wx"})
{:dir dir
:log-path log-path
:record-path (path/join dir (str stem ".transit"))}))
(defn get-real-path
"Resolves symlink ancestors even when the final path does not exist yet."

2
frontend/performance/benches/render_wasm/node/outcome.cljs
View File

@ -11,7 +11,7 @@
(a vector, primary failure first) and `:log-path`. Exit code 130 and 143
mark an interruption and no failure replaces them."
(:require
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]))
[benches.render-wasm.errors :as errors :refer [attempt failure?]]))
(defn interruption-code
"Returns the exit code for the interrupting signal name: 143 for SIGTERM,

10
frontend/performance/benches/render_wasm/node/process.cljs
View File

@ -14,6 +14,16 @@
(def default-termination-grace-ms 5000)
(defn signal-name
"Returns the signal name for an aborted AbortSignal, defaulting to SIGINT."
[signal]
(when (and signal (.-aborted ^js signal))
(let [reason (.-reason ^js signal)]
(cond
(string? reason) reason
(keyword? reason) (name reason)
:else (or (:signal (ex-data reason)) "SIGINT")))))
(defn deadline
"Returns an absolute Date.now() timestamp, in milliseconds. All commands
in a preparation can share it, including commands waiting for a lock.

30
frontend/performance/benches/render_wasm/node/run.cljs
View File

@ -22,8 +22,7 @@
[app.common.schema :as sm]
[app.common.transit :as transit]
[benches.render-wasm.declarations :as declarations]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.browser :as browser]
@ -34,6 +33,7 @@
[benches.render-wasm.node.process :as process]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.node.server :as server]
[benches.render-wasm.node.time :as time]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
[benches.render-wasm.result :as result]
@ -64,20 +64,11 @@
:hint "invalid run options"
:type ::invalid-options))
(defn- now
[]
(.toISOString (js/Date.)))
(defn- cause-evidence
"Plain failure evidence for a rejected browser, server or persistence action."
[cause fallback-phase]
(let [data (ex-data cause)
phase (or (:phase data) (name fallback-phase))]
(cond-> {:status "failed"
:phase (if (keyword? phase) (name phase) (str phase))
:message (errors/message-of cause)
:cause (failures/describe-cause cause)}
(:partial data) (assoc :partial (:partial data)))))
(errors/fail-data
(errors/evidence (or (:phase (ex-data cause)) fallback-phase) cause)))
(defn- failure-evidence
"Projects a bridge failure response into diagnostics evidence."
@ -92,11 +83,8 @@
(defn- interruption
[signal]
(when (and signal (.-aborted ^js signal))
(let [reason (.-reason ^js signal)
data (ex-data reason)]
{:signal (if (string? reason) reason (or (:signal data) "SIGINT"))
:cause reason})))
(when-let [name (process/signal-name signal)]
{:signal name :cause (.-reason ^js signal)}))
(defn- interrupted?
[state]
@ -202,7 +190,7 @@
(record-screenshot-status state (:id case)
{:file file :status :failed
:message (errors/message-of shot)
:cause (failures/describe-cause shot)})
:cause (errors/describe-cause shot)})
(write-log state log/warn (str "Screenshot failed for "
(result/case-name (:id case)) ": "
(errors/message-of shot) "\n")))
@ -597,7 +585,7 @@
(when (:screenshots (:opts state))
(swap! (:run-ref state) update-in [:metadata :diagnostics :screenshots]
complete-screenshots (:cases state)))
(swap! (:run-ref state) result/finish-run (now) termination)
(swap! (:run-ref state) result/finish-run (time/now) termination)
(persist state)
@(:run-ref state)))
@ -679,7 +667,7 @@
[root run-id selected-build cases opts]
(result/create-run
{:run-id run-id
:started-at (now)
:started-at (time/now)
:plan {:cases cases
:warmups (:warmups opts)
:repetitions (:repetitions opts)

2
frontend/performance/benches/render_wasm/node/runner.cljs
View File

@ -9,7 +9,7 @@
(:require
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.compare :as compare]
[benches.render-wasm.node.log :as log]

34
frontend/performance/benches/render_wasm/node/runs.cljs
View File

@ -26,7 +26,7 @@
(defn- check-id
[id]
(when-not (and (string? id) (re-matches #"[A-Za-z0-9][A-Za-z0-9_-]{0,127}" id))
(when-not (files/valid-id? id)
(invalid-home "invalid run id" {:id id}))
id)
@ -48,26 +48,26 @@
uses the frontend root regardless of cwd."
[{:keys [root run-id output-dir remove]}]
(check-id run-id)
(let [dir (check-output-dir
(or output-dir (path/join (artifacts/managed-root root) "runs" run-id)))
record-path (path/join dir "run.transit")
log-path (path/join dir "run.log")]
(let [dir (check-output-dir
(or output-dir (path/join (artifacts/managed-root root) "runs" run-id)))]
(when (and remove (artifacts/inside-builds? root dir))
(invalid-home "--remove cannot use an output directory inside builds" {:path dir}))
(try
(fs/mkdirSync dir #js {:recursive true})
(assoc (files/create-home dir "run") :run-id run-id)
(catch :default cause
(invalid-home "cannot create run home"
{:path dir :cause (errors/message-of cause)})))
(try
(fs/writeFileSync log-path "" #js {:encoding "utf8" :flag "wx"})
(catch :default cause
(invalid-home "cannot create run log"
{:path log-path :cause (errors/message-of cause)})))
{:dir dir
:record-path record-path
:log-path log-path
:run-id run-id}))
(throw (ex-info "cannot create run home"
{:type ::invalid-home :path dir :cause (errors/message-of cause)}
cause))))))
(defn get-record
"Reads and validates a saved run record from a path relative to cwd."
[file]
(when-not (and (string? file) (fs/existsSync file))
(throw (ex-info "run record is missing" {:type ::missing-run :path file})))
(let [record (result/decode (fs/readFileSync file "utf8"))]
(when-not (= :run-record (:type record))
(throw (ex-info "expected a saved run record" {:type ::invalid-run :path file})))
record))
(defn write-record!
"Validates schema:run and atomically replaces the saved file."

12
frontend/performance/benches/render_wasm/node/server.cljs
View File

@ -10,6 +10,7 @@
["fs" :as fs]
["http" :as http]
["path" :as path]
[benches.render-wasm.node.files :as files]
[benches.render-wasm.node.options :as options]
[clojure.string :as str]))
@ -26,13 +27,6 @@
(def ^:private owners (js/WeakMap.))
(defn- contained?
[root file]
(let [relative (path/relative root file)]
(and (not (path/isAbsolute relative))
(not= relative "..")
(not (str/starts-with? relative (str ".." path/sep))))))
(defn- request-file
[root url]
(let [pathname (js/decodeURIComponent (first (str/split url #"[?#]" 2)))]
@ -44,10 +38,10 @@
(throw (ex-info "forbidden request path" {:status 403})))
(let [relative (if (= pathname "/") "index.html" (subs pathname 1))
file (path/resolve root relative)]
(when-not (contained? root file)
(when-not (files/contained? root file)
(throw (ex-info "forbidden request path" {:status 403})))
(let [resolved (fs/realpathSync file)]
(when-not (contained? root resolved)
(when-not (files/contained? root resolved)
(throw (ex-info "forbidden artifact symlink" {:status 403})))
resolved))))

12
frontend/performance/benches/render_wasm/node/time.cljs Normal file
View File

@ -0,0 +1,12 @@
;; 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.node.time)
(defn now
"Returns the current UTC time as an ISO 8601 string."
[]
(.toISOString (js/Date.)))

8
frontend/performance/benches/render_wasm/runtime/protocol.cljs
View File

@ -81,16 +81,16 @@
- `:last-input-to-full-ms` from the clock read before the last view update
to the clock read after the final drain promise resolves."
(:require
[app.common.render-wasm.wasm :as wasm]))
[app.common.render-wasm.wasm :as wasm]
[benches.render-wasm.errors :as errors]))
(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)))
(errors/with-context cause (errors/message-of cause "renderer protocol failed")
{:partial evidence}))
(defn- next-render-timestamp
"Gets an immediate clock timestamp or awaits the next frame timestamp."

5
frontend/test/performance_tests/render_wasm/compare_test.cljs
View File

@ -236,6 +236,11 @@
(make-run "baseline" :case/load 10))
candidate (write-run (path/join @temporary-root "candidate.transit")
(make-run "candidate" :case/load 12))]
(let [file (path/join @temporary-root "comparison.transit")
record (:comparison (compare/execute baseline candidate {}))]
(fs/writeFileSync file (result/encode record))
(t/is (thrown-with-msg? js/Error #"expected a saved run record"
(compare/execute baseline file {}))))
(doseq [selector ["case/load" "case/load,other/load,third/load" ""]]
(t/is (= ::report-compare/invalid-selector
(:type (ex-data (failure #(compare/execute baseline candidate

53
frontend/test/performance_tests/render_wasm/errors_test.cljs
View File

@ -6,7 +6,8 @@
(ns performance-tests.render-wasm.errors-test
(:require
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors :refer [attempt failure?]]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
@ -77,3 +78,53 @@
(t/deftest message-of-falls-back-to-the-string-form
(t/is (= "boom" (errors/message-of (ex-info "boom" {}))))
(t/is (= "text" (errors/message-of "text"))))
(t/deftest context-keeps-deeper-measurements-and-native-cause-details
(let [native (ex-info "render failed" {:fn "_render" :code 17})
cause (ex-info "interact failed" {:phase "interact" :partial {:slices [1 2]}} native)
error (errors/with-context cause "setup failed"
{:phase "setup" :partial {:slices [1] :setup {:upload-ms 3}}})
result (errors/evidence :setup error)]
(t/is (= {:phase "setup" :partial {:slices [1 2] :setup {:upload-ms 3}}}
(ex-data error)))
(t/is (= "setup failed" (:message result)))
(t/is (some #(= {:message "render failed" :fn "_render" :code 17} %)
(:cause result)))))
(t/deftest context-keeps-native-errors-as-diagnostic-causes
(let [error (errors/with-context (js/Error. "device lost") "restore failed" {:phase "restore"})]
(t/is (some #(= "device lost" (:message %)) (errors/describe-cause error)))))
(t/deftest hostile-cause-renders-plain-data
(let [hostile (ex-info "boom"
{:fn (fn [] 1) :code #js {:evil 1} :type :wasm-error
:hint (str (apply str (repeat 499 "x")) "😀")}
(js/Error. "inner boom"))
result (errors/evidence :aborted hostile)
decoded (-> result transit/encode-str transit/decode-str)
outer (first (:cause decoded))]
(t/is (= "aborted" (:phase decoded)))
(t/is (= "boom" (:message decoded)))
(t/is (string? (:fn outer)))
(t/is (string? (:code outer)))
(t/is (= (apply str (repeat 499 "x")) (:hint outer)))
(t/is (some #(= "inner boom" (:message %)) (:cause decoded)))))
(t/deftest unprintable-values-produce-portable-diagnostics
(let [evil (js-obj)]
(js/Object.defineProperty evil "evil"
#js {:enumerable true
:get (fn [] (throw (js/Error. "evil")))})
(let [data (errors/evidence :upload (ex-info "evil boom" {:fn evil}))
cause (errors/evidence :upload evil)
decoded (-> [data cause] transit/encode-str transit/decode-str)]
(t/is (= "unrenderable value" (get-in decoded [0 :cause 0 :fn])))
(t/is (= "unrenderable cause" (get-in decoded [1 :cause 0 :message]))))))
(t/deftest non-finite-failure-details-cross-transit-as-numbers
(let [failure (ex-info "bad measurement" {:code js/NaN :hint js/Infinity :type js/-Infinity})
decoded (-> (errors/evidence :render failure) transit/encode-str transit/decode-str)
detail (first (:cause decoded))]
(t/is (js/Number.isNaN (:code detail)))
(t/is (= js/Infinity (:hint detail)))
(t/is (= js/-Infinity (:type detail)))))

36
frontend/test/performance_tests/render_wasm/feature_comparison_test.cljs
View File

@ -584,6 +584,25 @@
(t/is (= phase (get-in record [:configurations 0 :failure :phase])))
(t/is (str/includes? (get-in record [:configurations 0 :failure :message]) message)))))
(t/deftest ^:async run-failure-saves-partial-measurements-and-nested-causes
(create-frontend-root)
(let [partial {:slices [{:duration-ms 3}]}
cause (ex-info "run rejected" {:partial partial}
(ex-info "render failed" {:fn "_render" :code 17}))
prepared (comparison-prepared ["a"] {})
outcome (await (feature-comparison/execute
(frontend-root) prepared nil
{:services (comparison-services
{:prepare-build (build-service {})
:execute-run (fn [& _] (js/Promise.reject cause))})}))
failure (get-in (saved-comparison outcome) [:configurations 0 :failure])]
(t/is (= {:phase "run"
:message "run rejected"
:partial partial}
(select-keys failure [:phase :message :partial])))
(t/is (some #(= {:message "render failed" :fn "_render" :code 17} %)
(:cause failure)))))
(t/deftest ^:async unavailable-or-mismatched-run-evidence-stops-later-configurations
(create-frontend-root)
(doseq [[kind message] [[:missing "run record is missing"]
@ -637,9 +656,13 @@
(t/deftest ^:async pre-aborted-comparison-preserves-all-work-as-unattempted
(create-frontend-root)
(doseq [[signal code] [["SIGINT" 130] ["SIGTERM" 143]]]
(doseq [[reason signal code] [["SIGINT" "SIGINT" 130]
["SIGTERM" "SIGTERM" 143]
[:SIGTERM "SIGTERM" 143]
[(ex-info "stopped" {:signal "SIGTERM"}) "SIGTERM" 143]
[(js/Error. "stopped") "SIGINT" 130]]]
(let [controller (js/AbortController.)
_ (.abort controller signal)
_ (.abort controller reason)
prepared (comparison-prepared ["a" "b"] {:output-dir (path/join @temporary-root (str (random-uuid)))})
outcome (await (feature-comparison/execute
(frontend-root) prepared (.-signal controller)
@ -648,7 +671,6 @@
record (saved-comparison outcome)]
(t/is (= code (:exit-code outcome)))
(t/is (= :interrupted (:status record)))
(t/is (some? (:ended-at record)))
(t/is (every? #(= :unattempted (:status %)) (concat (:configurations record) (:edges record))))
(t/is (every? #(= (str "interrupted by " signal) (:reason %))
(concat (:configurations record) (:edges record)))))))
@ -759,8 +781,10 @@
(t/is (= (path/join (frontend-root) "target" "performance" "render-wasm"
"feature-comparisons" "comparison-a")
(:dir home)))
(t/is (fs/existsSync (:dir home)))
(t/is (not (fs/existsSync (:record-path home)))))
(t/is (= "" (fs/readFileSync (:log-path home) "utf8"))))
(doseq [id [nil "" "../escape" "a/b" "a\\b"]]
(t/is (thrown-with-msg? js/Error #"invalid feature comparison id"
(feature-comparison/create-home (frontend-root) id nil))))
(let [existing (path/join @temporary-root "existing")]
(fs/mkdirSync existing)
(t/is (thrown-with-msg? js/Error #"already exists"
@ -825,8 +849,6 @@
(doseq [slug ["0" "1"]
phase ["built" "running" "completed"]]
(t/is (str/includes? text (str "Configuration " slug " " phase "\n")))))
(t/is (every? #(= :completed (:status %)) (:configurations record)))
(t/is (every? #(= :completed (:status %)) (:edges record)))
(t/is (= ["a"] (get-in record [:configurations 1 :effective-features])))
(t/is (= :comparison (:type comparison)))
(t/is (= {:from "0"

93
frontend/test/performance_tests/render_wasm/lifecycle_test.cljs
View File

@ -16,6 +16,7 @@
[benches.render-wasm.browser.bridge :as browser]
[benches.render-wasm.cases :as cases]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
@ -98,15 +99,16 @@
(t/async done
(expect-failed-args (scene-args 42 {:id :rects/missing}) true done)))
(t/deftest wrong-scene-body-fails-before-claim
(t/deftest ^:async wrong-scene-body-rejects-the-load-request
(let [id :rects/wrong-scene
descriptor (load-case)]
(decl/register-case! {:id id :scene :other :ns "lifecycle-test"
:run! (fn [_] nil)})
(try
(let [request (transit/encode-str {:case (assoc descriptor :id id)})
parsed (@#'browser/parse-load-request request)]
(t/is (= "invalid-args" (get-in parsed [:error :phase]))))
result (transit/decode-str (await (browser/prepare-scene-request request)))]
(t/is (= "failed" (:status result)))
(t/is (= "invalid-args" (:phase result))))
(finally
(decl/unregister-case! id)))))
@ -171,13 +173,13 @@
nil
(catch :default cause
cause))]
(t/is (true? (:benches.render-wasm.failures/stale (ex-data thrown)))
(t/is (errors/stale? 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.failures/stale true
{::errors/stale true
:phase "upload"})
"upload")
after @@#'browser/owner-epoch*]
@ -757,92 +759,13 @@
(cleanup)
(done)))))))
(t/deftest hostile-cause-renders-plain-data
(let [terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
hostile (ex-info "boom"
{:fn (fn [] 1)
:code #js {:evil 1}
:type :wasm-error
:hint (apply str (repeat 1000 "x"))}
(js/Error. "inner boom"))
result (terminate current hostile "aborted")
m result
cause (:cause m)]
(t/is (= "failed" (:status m)))
(t/is (= "aborted" (:phase m)))
(t/is (= "boom" (:message m)) "top message stays as-is")
(t/is (vector? cause) "cause is plain-data vector")
(t/is (decl/transit-round-trips? cause) "hostile values become strings")
(t/is (every? (fn [entry]
(every? (fn [[_ v]]
(or (not (string? v)) (<= (count v) 500)))
entry))
cause)
"strings truncated to the hard cap")
(let [outer (first cause)]
(t/is (string? (:fn outer)) "function value stringified")
(t/is (string? (:code outer)) "host object value stringified")
(t/is (= 500 (count (:hint outer))) "long hint truncated"))
(t/is (some #(and (string? (:message %))
(re-find #"inner boom" (:message %)))
cause)
"inner message preserved"))
(t/testing "values pr-str cannot render fall back to plain strings"
(let [evil (js-obj)
_ (js/Object.defineProperty
evil "evil"
#js {:enumerable true
:get (fn [] (throw (js/Error. "evil")))})
terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
hostile (ex-info "evil boom" {:fn evil} (js/Error. "inner"))
result (terminate current hostile "aborted")
m result
cause (:cause m)
outer (first cause)]
(t/is (= "failed" (:status m)))
(t/is (decl/transit-round-trips? cause) "throwing value still crosses the wire")
(t/is (= "unrenderable value" (:fn outer))
"stringification failure falls back")))
(t/testing "causes pr-str cannot render fall back to plain strings"
(let [evil (js-obj)
_ (js/Object.defineProperty
evil "evil"
#js {:enumerable true
:get (fn [] (throw (js/Error. "evil")))})
terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
result (terminate current evil "aborted")
m result
cause (:cause m)]
(t/is (= "failed" (:status m)))
(t/is (decl/transit-round-trips? cause) "throwing cause still crosses the wire")
(t/is (= "unrenderable cause" (:message (first cause)))
"level fallback holds"))))
(t/deftest non-finite-failure-details-cross-transit-as-numbers
(let [terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
failure (ex-info "bad measurement"
{:code js/NaN
:hint js/Infinity
:type js/-Infinity})
result (terminate current failure "aborted")
decoded (-> result transit/encode-str transit/decode-str)
detail (first (:cause decoded))]
(t/is (number? (:code detail)))
(t/is (js/Number.isNaN (:code detail)))
(t/is (= js/Infinity (:hint detail)))
(t/is (= js/-Infinity (:type detail)))))
(t/deftest nested-stale-marker-does-not-resolve-stale
(let [terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
nested (ex-info "upload failed"
{:phase "upload"}
(ex-info "superseded"
{:benches.render-wasm.failures/stale true
{::errors/stale true
:phase "upload"}))
result (terminate current nested "aborted")
m result]

20
frontend/test/performance_tests/render_wasm/protocol_test.cljs
View File

@ -9,6 +9,7 @@
Browser entry tests cover load and warm pan with a fake module."
(:require
[app.common.render-wasm.wasm :as wasm]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.runtime.protocol :as protocol]
[cljs.test :as t :include-macros true]))
@ -154,6 +155,25 @@
(t/is (= [0 0] (mapv :duration-ms (get-in (ex-data cause) [:partial :slices]))))
(done)))))))
(t/deftest ^:async unreadable-error-message-keeps-render-evidence
(let [clock (fake-clock 0)
calls (atom [])
hooks (drain-hooks {:clock clock :script [1] :calls calls})
render (:render hooks)
cause (ex-info "unreadable" {} (js/Error. "device lost"))
_ (js/Object.defineProperty cause "message"
#js {:get (fn [] (throw (js/Error. "message getter failed")))})
hooks (assoc hooks :render (fn [timestamp flags]
(if (seq @calls)
(throw cause)
(render timestamp flags))))
result (try
(await (protocol/drain hooks {:flags 0 :origin 0 :immediate true}))
nil
(catch :default error error))]
(t/is (= [1] (mapv :frame-type (get-in (ex-data result) [:partial :slices]))))
(t/is (some #(= "device lost" (:message %)) (errors/describe-cause result)))))
(t/deftest camera-failure-retains-completed-previews-and-authored-pauses
(t/async done
(let [clock (fake-clock 0)

8
frontend/test/performance_tests/render_wasm/run_test.cljs
View File

@ -556,12 +556,16 @@
(t/deftest ^:async interruption-before-an-attempt-preserves-unspent-slots
(doseq [context [:fresh :reuse]
method [:launch :new-page :prepare]
[signal code] [["SIGINT" 130] ["SIGTERM" 143]]]
[reason signal code] [["SIGINT" "SIGINT" 130]
["SIGTERM" "SIGTERM" 143]
[:SIGTERM "SIGTERM" 143]
[(ex-info "stopped" {:signal "SIGTERM"}) "SIGTERM" 143]
[(js/Error. "stopped") "SIGINT" 130]]]
(let [controller (js/AbortController.)
base (fake-browser {})
stop (^:async fn [& _]
(let [cause (ex-info "interrupted setup" {:signal signal :phase :preparation})]
(.abort controller cause)
(.abort controller reason)
(throw cause)))
fake (assoc base :service (assoc (:service base) method stop))
opts (assoc (options fake (output-dir)) :warmups 1 :repetitions 2)

8
frontend/test/performance_tests/render_wasm/runs_test.cljs
View File

@ -100,6 +100,14 @@
(t/is (thrown-with-msg? js/Error #"nonempty path"
(runs/check-output-dir " "))))
(t/deftest home-creation-reports-an-invalid-parent
(let [parent (path/join @temporary-root "file")
dir (path/join parent "run")]
(fs/writeFileSync parent "occupied")
(let [error (failure #(runs/create-home {:root @temporary-root
:run-id "run-6" :output-dir dir}))]
(t/is (= "ENOTDIR" (.-code (or (ex-cause error) error)))))))
(t/deftest explicit-home-creates-missing-parents
(let [out (path/join @temporary-root "missing" "parents" "run")
home (runs/create-home {:root @temporary-root :run-id "nested"