diff --git a/frontend/test/benches/render_wasm/browser.cljs b/frontend/test/benches/render_wasm/browser.cljs index e84412147d..ac09aabc1b 100644 --- a/frontend/test/benches/render_wasm/browser.cljs +++ b/frontend/test/benches/render_wasm/browser.cljs @@ -28,6 +28,7 @@ [app.render-wasm.api.enums] [app.render-wasm.api.webgl :as webgl] [benches.render-wasm.cases] + [benches.render-wasm.failures :as fail] [benches.render-wasm.protocol :as protocol] [benches.render-wasm.scenes.common :as scenes] [benches.render-wasm.scenes.core :as core] @@ -127,9 +128,6 @@ (defonce ^:private canvas* (atom nil)) -(defn- fail-data - [m] - (assoc m :status "failed")) (defn- mark-live! [] @@ -218,16 +216,17 @@ true)) (defn- render-ok - "Maps one drain result to the bridge value. Success keeps the owner live - for explicit disposal. Failures release the owner only if it still is current - (i.e. it owns the page resources) so a stale failure cannot dispose of - resources belonging to a newer owner." + "Maps one drain result to the bridge value. + + Success keeps the owner live for explicit disposal. Failures release the owner + only if it still is current (i.e. it owns the page resources) to avoid + disposing of resources belonging to a newer owner in case of a stale failure." [epoch module-ms graphics-ms upload-ms alive? drain-result snapshot seed ctx width height dpr renderer] (if-not alive? (do (dispose-if-current! epoch) - (fail-data {:phase "first-render" - :message "disposed or context lost during render"})) + (fail/fail-data {:phase "first-render" + :message "disposed or context lost during render"})) (assoc drain-result :status "ok" :module-init-ms module-ms @@ -295,126 +294,6 @@ ;; Public interface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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})))) - -(def ^:private max-cause-depth - "How many cause levels the failure cause keeps: the phase wrapper, the - WASM-error mapping and the original failure." - 3) - -(def ^:private max-cause-chars - "Hard cap for any string in the failure cause, so a hostile value never - bloats the bridge payload." - 500) - -(def ^:private unrenderable-value - "Fallback for a cause value `pr-str` cannot render." - "unrenderable value") - -(def ^:private unrenderable-cause-text - "Fallback message when a cause level cannot be rendered." - "unrenderable cause") - -(defn- truncate-cause-str - "Truncates `s` to `max-cause-chars` without splitting a surrogate pair. - Never throws." - [s] - (try - (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)))) - (catch :default _ - unrenderable-value))) - -(defn- finite-cause-number? - "True for numbers kept as numbers in failure causes. NaN and - infinities travel as truncated strings, never as numbers." - [value] - (and (number? value) - (js/isFinite value))) - -(defn- sanitize-cause-value - "Keeps plain-data leaves as-is, stringifies anything else with `pr-str` - truncation. Never throws." - [value] - (try - (cond - (or (nil? value) (boolean? value) (keyword? value)) - value - - (string? value) - (truncate-cause-str value) - - (finite-cause-number? value) - value - - :else - (truncate-cause-str (pr-str value))) - (catch :default _ - 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] - (try - (let [message (try (ex-message cause) (catch :default _ nil)) - data (try (ex-data cause) (catch :default _ nil)) - 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)) - (catch :default _ - {: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] - (try - (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 (try (ex-cause current) (catch :default _ nil))] - (recur next (inc depth) (conj acc level))))) - (catch :default _ - [{:message unrenderable-cause-text}]))) - (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 @@ -423,7 +302,7 @@ accounting; the original failure lives under `:cause` as plain data. Only the top-level cause decides staleness." [epoch cause fallback-phase] - (if (stale? cause) + (if (fail/stale? cause) {:status "stale"} (let [phase (try (or (:phase (ex-data cause)) fallback-phase @@ -433,13 +312,22 @@ message (try (or (ex-message cause) "unknown failure") (catch :default _ "unknown failure")) - detail (try (describe-cause cause) + detail (try (fail/describe-cause cause) (catch :default _ - [{:message unrenderable-cause-text}]))] + [{:message fail/unrenderable-cause-text}]))] (dispose-if-current! epoch) - (fail-data {:phase phase - :message message - :cause detail})))) + (fail/fail-data {:phase phase + :message message + :cause detail})))) + +(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" {::fail/stale true :phase phase})))) (defn- build-canvas! "Creates the bench canvas with a `width*dpr` backing buffer and an explicit @@ -459,8 +347,8 @@ (if-not alive? (do (dispose-if-current! epoch) - (fail-data {:phase "interact" - :message "disposed or context lost during interaction"})) + (fail/fail-data {:phase "interact" + :message "disposed or context lost during interaction"})) (merge interaction {:status "ok" :module-init-ms module-ms @@ -517,8 +405,8 @@ (try (let [params (t/decode-str request)] (if-not (sm/validate schema:load-scene-args params) - {:error (fail-data {:phase "invalid-args" - :message "load-scene needs a Transit request with seed and case"})} + {:error (fail/fail-data {:phase "invalid-args" + :message "load-scene needs a Transit request with seed and case"})} (let [case-desc (:case params) scene (core/registered-scene (:scene case-desc))] (when (nil? scene) @@ -528,9 +416,9 @@ :case-desc (core/check-collected-case case-desc) :scene scene}))) (catch :default cause - {:error (fail-data {:phase "invalid-args" - :message (or (ex-message cause) - "invalid Transit request")})}))) + {:error (fail/fail-data {:phase "invalid-args" + :message (or (ex-message cause) + "invalid Transit request")})}))) (defn- begin-load! "Claims the page, releases the prior owner, then fixes this attempt's @@ -616,7 +504,7 @@ :snapshot snapshot :ordered (upload/prepare-scene snapshot))) (catch :default cause - (if (stale? cause) + (if (fail/stale? cause) (throw cause) (throw (ex-info "scene build failed" {:phase "scene-build"} @@ -646,7 +534,7 @@ (h/call wasm/internal-module "_set_view_end") (assoc graphics :upload-ms (- (now) u0) :view view)) (catch :default cause - (if (stale? cause) + (if (fail/stale? cause) (throw cause) (throw (ex-info "upload failed" {:phase "upload"} @@ -690,16 +578,16 @@ (terminal-failure epoch cause "aborted"))))))) (catch :default cause (js/Promise.resolve - (fail-data {:phase "setup" :message (ex-message cause)}))))] + (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-data {:phase "bridge" - :message (or (ex-message cause) - "result encoding failed")}))))))) + (fail/fail-data {:phase "bridge" + :message (or (ex-message cause) + "result encoding failed")}))))))) (defn ping "Bridge placeholder that checks the Node/browser boundary." diff --git a/frontend/test/benches/render_wasm/failures.cljs b/frontend/test/benches/render_wasm/failures.cljs new file mode 100644 index 0000000000..def45e6026 --- /dev/null +++ b/frontend/test/benches/render_wasm/failures.cljs @@ -0,0 +1,118 @@ +;; 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.") + +(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] + (try + (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)))) + (catch :default _ + 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] + (try + (cond + (or (nil? value) (boolean? value) (keyword? value)) + value + + (string? value) + (truncate-cause-str value) + + (number? value) + value + + :else + (truncate-cause-str (pr-str value))) + (catch :default _ + 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] + (try + (let [message (try (ex-message cause) (catch :default _ nil)) + data (try (ex-data cause) (catch :default _ nil)) + 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)) + (catch :default _ + {: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] + (try + (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 (try (ex-cause current) (catch :default _ nil))] + (recur next (inc depth) (conj acc level))))) + (catch :default _ + [{:message unrenderable-cause-text}]))) diff --git a/frontend/test/benches/render_wasm/scenes/builder.cljs b/frontend/test/benches/render_wasm/scenes/builder.cljs index 74fd4b60f2..080f20ff39 100644 --- a/frontend/test/benches/render_wasm/scenes/builder.cljs +++ b/frontend/test/benches/render_wasm/scenes/builder.cljs @@ -5,30 +5,30 @@ ;; Copyright (c) KALEIDOS SUBSIDIARY SL (ns benches.render-wasm.scenes.builder - "Scoped construction for renderer benchmark scenes. + "Construction of benchmark scenes. - A scene scope owns one seeded generator, one object map, and one label - map. Shape constructors add themselves to the current parent: `rect`, - `circle`, and the `frame`/`group`/`bool` container scopes. The scope - returns a validated snapshot in the ticket02 contract - `{:objects ... :refs ...}`. + A `scene` consists of one seeded generator, one object map, and one label + map. + + Ancestry and order are implicit in the nesting of calls: shape constructors + add themselves to the current parent, in the sequence they are called. Construction is synchronous by design: the scope and the current parent are carried by dynamic vars, so `let`, `doseq` and functions defined outside the scope all work inside a scene. Scene scopes cannot nest and body exceptions unwind without leaving state behind. A container whose body throws is marked unfinished and `finish!` rejects the instance, so a - caught exception cannot silently produce a half-built scene. + caught exception cannot produce a half-built scene. - Defaults follow the same theme: `*defaults*` maps a shape type to an - attribute generator map, bound by the `scene` macro from the scope + Default attributes follow the same theme: `*defaults*` maps a shape type to + an attribute generator map, bound by the `scene` macro from the scope params. Per-shape attrs are merged over the generated values, so a recipe can override anything locally and rebind `*defaults*` around a section. - Coordinates stay page-absolute: nesting supplies ownership and order, not - translation. Frames keep authored bounds; groups derive bounds from their - children inside out; a masked group takes the geometry of its first child. - Booleans derive content and geometry from their children with the canonical + Coordinates are page-absolute like in penpot. Frames use their state bounds + and groups derive their bounds from their children inside out. + A masked group takes the geometry of its first child. + Booleans derive content and geometry from their children with the standard path engine and inherit style from the head child unless attrs supply it. Masked groups and the frame/group/bool scopes live here; paths ticket07/08." diff --git a/frontend/test/benches/render_wasm/scenes/core.cljs b/frontend/test/benches/render_wasm/scenes/core.cljs index 8ad36912e9..2cddd2d537 100644 --- a/frontend/test/benches/render_wasm/scenes/core.cljs +++ b/frontend/test/benches/render_wasm/scenes/core.cljs @@ -341,17 +341,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn transit-round-trips? - "True when `value` survives the descriptor wire: transit encode then decode - yields an equal value. Namespaced keywords, mixed string/keyword keys and - other tagged values survive. Unhandled values (functions, records, most - host objects) make the writer throw and fail; NaN fails the equality check. - - ±Infinity survives the wire and is accepted. It can enter through open - :params/:operation/:preparation maps or future measurement fields; ticket - 09 gives non-finite measurements explicit invalid-reason forms." + "True when `value` survives Transit encoding and decoding without changing + its wire representation. This permits NaN and infinities while still + rejecting values that Transit cannot encode." [value] (try - (= value (-> value t/encode-str t/decode-str)) + (let [encoded (t/encode-str value)] + (= encoded (-> encoded t/decode-str t/encode-str))) (catch :default _ false))) (defn project-case diff --git a/frontend/test/frontend_tests/benches/contracts_test.cljs b/frontend/test/frontend_tests/benches/contracts_test.cljs index 6bacc691cb..e87683620d 100644 --- a/frontend/test/frontend_tests/benches/contracts_test.cljs +++ b/frontend/test/frontend_tests/benches/contracts_test.cljs @@ -171,8 +171,7 @@ (t/deftest transit-rejects-unencodable-values (t/is (false? (core/transit-round-trips? {:v (fn [] 1)}))) - (t/is (false? (core/transit-round-trips? {:point (->Point 1 2)}))) - (t/is (false? (core/transit-round-trips? {:v js/NaN})))) + (t/is (false? (core/transit-round-trips? {:point (->Point 1 2)})))) (t/deftest transit-wire-preserves-json-lossy-shapes (doseq [value [{:foo 1 "foo" 2} @@ -184,11 +183,21 @@ (t/is (= value (-> value transit/encode-str transit/decode-str)) (pr-str value)))) +(t/deftest transit-wire-preserves-non-finite-numbers + (let [value {:nan js/NaN :positive js/Infinity :negative js/-Infinity} + decoded (-> value transit/encode-str transit/decode-str) + case-desc (assoc (first (rect-cases)) :operation value)] + (t/is (number? (:nan decoded))) + (t/is (js/Number.isNaN (:nan decoded))) + (t/is (= js/Infinity (:positive decoded))) + (t/is (= js/-Infinity (:negative decoded))) + (t/is (core/transit-round-trips? value)) + (t/is (nil? (failure-data #(core/check-collected-case case-desc)))))) + (t/deftest unencodable-collected-values-are-rejected (let [good (first (rect-cases))] (doseq [bad [(assoc good :operation {:run (fn [] 1)}) - (assoc good :operation {:point (->Point 1 2)}) - (assoc-in good [:params :count] js/NaN)]] + (assoc good :operation {:point (->Point 1 2)})]] (t/is (= ::core/non-serializable-case (:type (failure-data #(core/check-collected-case bad)))) (pr-str bad))))) diff --git a/frontend/test/frontend_tests/benches/lifecycle_test.cljs b/frontend/test/frontend_tests/benches/lifecycle_test.cljs index 8014a168f5..00cfa9c223 100644 --- a/frontend/test/frontend_tests/benches/lifecycle_test.cljs +++ b/frontend/test/frontend_tests/benches/lifecycle_test.cljs @@ -148,13 +148,13 @@ nil (catch :default cause cause))] - (t/is (true? (:benches.render-wasm.browser/stale (ex-data thrown))) + (t/is (true? (:benches.render-wasm.failures/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 + {:benches.render-wasm.failures/stale true :phase "upload"}) "upload") after @@#'browser/owner-epoch*] @@ -556,13 +556,28 @@ (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.browser/stale true + {:benches.render-wasm.failures/stale true :phase "upload"})) result (terminate current nested "aborted") m result]