mirror of
https://github.com/penpot/penpot.git
synced 2026-11-13 13:31:24 +00:00
756541939a
Add a CLI under frontend/performance/benches/render_wasm that builds the renderer, runs seeded scenes (rects, plus, paths, masks) in headless Chromium and saves per-case timings. - build, run: prepare or reuse builds; measure cases with warmups, repetitions, deadlines - ab: build and compare Cargo feature configurations - compare, merge: median changes with bootstrap CIs between saved runs, guarded by scene, build and settings checks - purge: delete managed builds, runs or comparisons - GPU runs through `run-devenv --gpu` Lint, format and pnpm scripts now cover performance/ and its tests. AI-assisted-by: gpt-6.1-sol, deepseek-flash, muse-spark, glm-5.3, gpt6-astra, claude-5.5-sonnet, claude-haiku-5.5
501 lines
22 KiB
Clojure
501 lines
22 KiB
Clojure
;; 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
|
|
[benches.render-wasm.codec :as codec]
|
|
[clojure.string :as str]))
|
|
#?(: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 schema:cause-value
|
|
[:or nil? boolean? keyword? number? string?])
|
|
|
|
(def schema:cause-detail
|
|
"One level of a portable exception description."
|
|
[:map {:closed true}
|
|
[:message string?]
|
|
[:fn {:optional true} schema:cause-value]
|
|
[:code {:optional true} schema:cause-value]
|
|
[:type {:optional true} schema:cause-value]
|
|
[:hint {:optional true} schema:cause-value]])
|
|
|
|
(def ^:private diagnostic-fields
|
|
[[:phase string?]
|
|
[:message string?]
|
|
[:operation {:optional true} keyword?]
|
|
[:path {:optional true} [:string {:max 1024}]]
|
|
[:status {:optional true} [:enum "failed" "stale"]]
|
|
[:cause {:optional true} [:vector schema:cause-detail]]
|
|
[:partial {:optional true} map?]
|
|
[:reason {:optional true} :any]
|
|
[:deadline-exceeded {:optional true} boolean?]
|
|
[:expected-id {:optional true} [:string {:max 1024}]]
|
|
[:actual-id {:optional true} [:string {:max 1024}]]
|
|
[:command {:optional true} [:string {:max 1024}]]
|
|
[:exit-code {:optional true} :int]
|
|
[:pid {:optional true} [:int {:min 1}]]
|
|
[:pgid {:optional true} [:int {:min 1}]]
|
|
[:signals {:optional true} [:vector [:string {:max 1024}]]]
|
|
[:profile-path {:optional true} [:string {:max 1024}]]
|
|
[:fatal {:optional true} boolean?]
|
|
[:unresolved-process {:optional true} boolean?]
|
|
[:signal {:optional true} [:string {:max 1024}]]
|
|
[:endpoint {:optional true} [:string {:max 1024}]]])
|
|
|
|
(def schema:error-entry
|
|
"One failure occurrence with its operation and portable diagnostics."
|
|
(into [:map {:closed true}] diagnostic-fields))
|
|
|
|
(def schema:diagnostic
|
|
"Failure location, message and an optional ordered collection of errors."
|
|
(into [:map]
|
|
(conj diagnostic-fields
|
|
[:errors {:optional true} [:vector {:min 1} schema:error-entry]])))
|
|
|
|
(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 (let [message (ex-message cause)]
|
|
(when (string? message) message)))
|
|
(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
|
|
seen #{}]
|
|
(cond
|
|
(nil? cause) false
|
|
(:fatal (ex-data cause)) true
|
|
(contains? seen cause) false
|
|
:else (recur (ex-cause cause) (conj seen cause)))))
|
|
|
|
(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))
|
|
|
|
(declare combine)
|
|
|
|
(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)
|
|
malformed (and (contains? existing :partial) (not (map? (:partial existing)))
|
|
(map? (:partial data)))
|
|
source (if malformed (combine [{:error cause :partial (:partial existing)}]) cause)
|
|
context (cond-> (merge (ex-data source) data)
|
|
(contains? data :partial)
|
|
(assoc :partial (if (map? (:partial data))
|
|
(merge (:partial data) (when (map? (:partial existing)) (:partial existing)))
|
|
(:partial data))))]
|
|
(ex-info message context (if (and (some? existing) (not malformed)) (ex-cause cause) source))))
|
|
|
|
(defn- merge-error-context
|
|
[outer inner]
|
|
(cond-> (merge outer inner)
|
|
(and (map? (:partial outer)) (map? (:partial inner)))
|
|
(assoc :partial (merge (:partial outer) (:partial inner)))))
|
|
|
|
(defn- get-error-collection
|
|
[cause]
|
|
(loop [current cause
|
|
seen #{}
|
|
context {}]
|
|
(let [data (ex-data current)
|
|
context (merge-error-context context (dissoc data ::errors))]
|
|
(if-let [entries (::errors data)]
|
|
(update entries 0 #(merge-error-context context %))
|
|
(when (and (ex-cause current) (not (contains? seen current)))
|
|
(recur (ex-cause current) (conj seen current) context))))))
|
|
|
|
(defn get-errors
|
|
"Returns failure occurrences in order, retaining their Error objects.
|
|
|
|
Args:
|
|
cause: An Error, including one wrapped with additional context.
|
|
|
|
Returns:
|
|
A flat vector of maps with an Error under :error and available phase,
|
|
operation and path context."
|
|
[cause]
|
|
(or (get-error-collection cause)
|
|
[(assoc (select-keys (ex-data cause) [:phase :operation :path]) :error cause)]))
|
|
|
|
(defn combine
|
|
"Combines failure occurrences into an Error, or returns nil on success.
|
|
|
|
Args:
|
|
entries: Ordered maps with :error and optional :phase, :operation and
|
|
:path. Nil errors represent successful operations. An Error may
|
|
contain a collection from an earlier operation.
|
|
|
|
Returns:
|
|
An Error retaining a flat collection and the first error's message
|
|
and data. Retained Error objects expose their causes. Any fatal
|
|
occurrence makes the combined error fatal."
|
|
[entries]
|
|
(let [sources (filterv #(failure? (:error %)) entries)
|
|
error (:error (first sources))
|
|
entries (reduce (fn [collected {:keys [error] :as entry}]
|
|
(let [context (dissoc entry :error)
|
|
group (get-errors error)
|
|
group (if (seq context)
|
|
(mapv #(merge-error-context context %) group)
|
|
group)]
|
|
(if (empty? collected) group (into collected group))))
|
|
[] sources)]
|
|
(when error
|
|
(ex-info (message-of error)
|
|
(cond-> (merge (select-keys (first entries) [:phase :operation :path])
|
|
(ex-data error)
|
|
{::errors entries})
|
|
(some #(fatal? (:error %)) sources) (assoc :fatal true))
|
|
(if (::errors (ex-data error)) (ex-cause error) error)))))
|
|
|
|
(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 bounded-text
|
|
"Returns text within a size limit, preserving UTF-16 boundaries.
|
|
|
|
Converts `value` to a string and limits it to max-chars UTF-16 code
|
|
units. If conversion fails, it returns 'unrenderable value'. When
|
|
truncating, we check whether the cut would leave a high surrogate
|
|
without its matching low surrogate. If so, we remove that last code unit
|
|
to keep the pair intact.
|
|
|
|
Args:
|
|
value: Value to convert to text.
|
|
max-chars: Positive limit in UTF-16 units.
|
|
|
|
Returns:
|
|
Bounded text, or a fallback string when conversion fails."
|
|
[value max-chars]
|
|
(or (ex/ignoring
|
|
(let [text (str value)]
|
|
(if (<= (count text) max-chars)
|
|
text
|
|
(let [cut (subs text 0 max-chars)
|
|
last (.charCodeAt cut (dec max-chars))]
|
|
(if (and (>= last 0xD800)
|
|
(<= last 0xDBFF)
|
|
(let [nxt (.charCodeAt text max-chars)]
|
|
(and (>= nxt 0xDC00) (<= nxt 0xDFFF))))
|
|
(subs cut 0 (dec max-chars))
|
|
cut)))))
|
|
(subs unrenderable-value 0 (min max-chars (count unrenderable-value)))))
|
|
|
|
(defn terminal-text
|
|
"Returns bounded text with terminal controls escaped.
|
|
|
|
Args:
|
|
value: Value to render as text.
|
|
max-chars: Positive limit in UTF-16 units after escaping.
|
|
|
|
Returns:
|
|
Text with C0, DEL and C1 controls represented as Unicode escapes."
|
|
[value max-chars]
|
|
(bounded-text
|
|
(or (ex/ignoring
|
|
(str/replace (bounded-text value max-chars) #"[\x00-\x1f\x7f-\x9f]"
|
|
(fn [character]
|
|
(str "\\u" (.padStart (.toString (.charCodeAt character 0) 16) 4 "0")))))
|
|
unrenderable-value)
|
|
max-chars))
|
|
|
|
(defn format-value
|
|
"Returns a bounded, readable value with terminal controls escaped.
|
|
|
|
Args:
|
|
value: Value to print. Strings use JSON quoting.
|
|
max-chars: Positive limit in UTF-16 units after escaping.
|
|
|
|
Returns:
|
|
Readable text, or fallback text when printing fails."
|
|
[value max-chars]
|
|
(terminal-text
|
|
(or (ex/ignoring
|
|
(if (string? value)
|
|
(js/JSON.stringify (bounded-text value max-chars))
|
|
(binding [*print-level* 8 *print-length* 32]
|
|
(pr-str value))))
|
|
unrenderable-value)
|
|
max-chars))
|
|
|
|
(defn project-context
|
|
"Returns bounded identity, process and ownership details.
|
|
|
|
Args:
|
|
data: Diagnostic data with available identity or process fields.
|
|
|
|
Returns:
|
|
Bounded text, integer process IDs and exit code, attempted signals,
|
|
and available fatal or unresolved-ownership markers."
|
|
[data]
|
|
(cond-> {}
|
|
(string? (:expected-id data)) (assoc :expected-id (bounded-text (:expected-id data) 1024))
|
|
(string? (:actual-id data)) (assoc :actual-id (bounded-text (:actual-id data) 1024))
|
|
(string? (:command data)) (assoc :command (bounded-text (:command data) 1024))
|
|
(integer? (:exit-code data)) (assoc :exit-code (:exit-code data))
|
|
(and (integer? (:pid data)) (pos? (:pid data))) (assoc :pid (:pid data))
|
|
(and (integer? (:pgid data)) (pos? (:pgid data))) (assoc :pgid (:pgid data))
|
|
(and (vector? (:signals data)) (every? string? (:signals data)))
|
|
(assoc :signals (mapv #(bounded-text % 1024) (:signals data)))
|
|
(string? (:profile-path data)) (assoc :profile-path (bounded-text (:profile-path data) 1024))
|
|
(true? (:fatal data)) (assoc :fatal true)
|
|
(true? (:unresolved-process data)) (assoc :unresolved-process true)
|
|
(string? (:signal data)) (assoc :signal (bounded-text (:signal data) 1024))
|
|
(string? (:endpoint data)) (assoc :endpoint (bounded-text (:endpoint data) 1024))))
|
|
|
|
(declare project-diagnostic)
|
|
|
|
(defn- sanitize-cause-value
|
|
[value]
|
|
(cond
|
|
(or (nil? value) (boolean? value) (keyword? value) (number? value))
|
|
value
|
|
|
|
(string? value)
|
|
(bounded-text value max-cause-chars)
|
|
|
|
:else
|
|
(bounded-text (or (ex/ignoring
|
|
(binding [*print-level* 8 *print-length* 32]
|
|
(pr-str value)))
|
|
unrenderable-value)
|
|
max-cause-chars)))
|
|
|
|
(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 (binding [*print-level* 8 *print-length* 32] (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 []
|
|
seen #{}]
|
|
(if (or (nil? current) (contains? seen 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) (conj seen current))))))
|
|
[{:message unrenderable-cause-text}]))
|
|
|
|
(defn- diagnostic-data
|
|
[phase cause]
|
|
(let [partial (ex/ignoring (:partial (ex-data cause)))]
|
|
(cond-> (merge (project-context (ex-data cause))
|
|
(select-keys (ex-data cause) [:operation])
|
|
{:phase (if (keyword? phase) (name phase) (str phase))
|
|
:message (bounded-text (message-of cause) 1024)
|
|
:cause (describe-cause cause)})
|
|
(contains? (ex-data cause) :partial) (assoc :partial partial)
|
|
(string? (:path (ex-data cause)))
|
|
(assoc :path (bounded-text (:path (ex-data cause)) 1024)))))
|
|
|
|
(defn evidence
|
|
"Returns plain diagnostics, including ordered failure occurrences.
|
|
|
|
Args:
|
|
phase: Failure location for the enclosing operation.
|
|
cause: Error with available operation context and collected failures.
|
|
|
|
Returns:
|
|
Portable diagnostics with bounded cause descriptions. Collected
|
|
errors retain occurrence order and messages within 1024 UTF-16 units."
|
|
[phase cause]
|
|
(let [entries (get-error-collection cause)
|
|
projected (when entries
|
|
(mapv (fn [{:keys [error operation path partial] entry-phase :phase :as entry}]
|
|
(cond-> (merge (diagnostic-data (or entry-phase phase) error)
|
|
(project-context entry)
|
|
(select-keys entry [:reason :deadline-exceeded])
|
|
{:message (bounded-text (message-of error) 1024)})
|
|
operation (assoc :operation operation)
|
|
partial (assoc :partial partial)
|
|
(string? path) (assoc :path (bounded-text path 1024))))
|
|
entries))]
|
|
(project-diagnostic
|
|
(cond-> (diagnostic-data phase cause)
|
|
projected (assoc :errors projected)
|
|
(map? (:partial (first projected))) (assoc :partial (:partial (first projected)))
|
|
(some :unresolved-process projected) (assoc :unresolved-process true)))))
|
|
|
|
(defn- partial-encoding-error
|
|
[path cause]
|
|
{:phase "diagnostic-encoding" :operation :encode-diagnostic
|
|
:path (format-value path 1024)
|
|
:message "Diagnostic partial evidence cannot cross Transit"
|
|
:cause (describe-cause cause)})
|
|
|
|
(defn- project-partial
|
|
[partial]
|
|
(if (map? partial)
|
|
(reduce-kv (fn [[kept rejected] key value]
|
|
(try
|
|
(codec/check-value {key value})
|
|
(codec/encode-str {key value})
|
|
[(assoc kept key value) rejected]
|
|
(catch :default cause
|
|
[kept (conj rejected (partial-encoding-error [:partial key] cause))])))
|
|
[{} []]
|
|
partial)
|
|
[nil [(partial-encoding-error [:partial]
|
|
(ex-info "Diagnostic partial evidence must be a map" {}))]]))
|
|
|
|
(defn- project-entry
|
|
[entry]
|
|
(let [[partial rejected] (when (contains? entry :partial) (project-partial (:partial entry)))
|
|
projected (cond-> (project-context entry)
|
|
(contains? #{"failed" "stale"} (:status entry)) (assoc :status (:status entry))
|
|
(boolean? (:deadline-exceeded entry)) (assoc :deadline-exceeded (:deadline-exceeded entry))
|
|
(keyword? (:operation entry)) (assoc :operation (:operation entry))
|
|
(contains? entry :phase) (assoc :phase (bounded-text (:phase entry) 1024))
|
|
(contains? entry :message) (assoc :message (bounded-text (:message entry) 1024))
|
|
(contains? entry :reason) (assoc :reason (sanitize-cause-value (:reason entry)))
|
|
(contains? entry :cause)
|
|
(assoc :cause (mapv (fn [level]
|
|
(reduce-kv (fn [out key value]
|
|
(assoc out key (sanitize-cause-value value)))
|
|
{} (select-keys level [:message :fn :code :type :hint])))
|
|
(take evidence-cause-depth (:cause entry))))
|
|
(some? partial) (assoc :partial partial)
|
|
(string? (:path entry)) (assoc :path (bounded-text (:path entry) 1024)))]
|
|
[projected rejected]))
|
|
|
|
(defn project-diagnostic
|
|
"Returns bounded diagnostic fields and representable partial evidence.
|
|
|
|
Args:
|
|
evidence: Execution evidence with optional failure details.
|
|
|
|
Returns:
|
|
Diagnostic fields with bounded text. Partial entries that cannot
|
|
cross Transit produce ordered encoding diagnostics. Representable
|
|
partial values retain their raw numeric values."
|
|
[evidence]
|
|
(let [alias? (and (seq (:errors evidence)) (contains? evidence :partial)
|
|
(identical? (:partial evidence) (:partial (first (:errors evidence)))))
|
|
[projected rejected] (project-entry (if alias? (dissoc evidence :partial) evidence))
|
|
entries (mapv project-entry (:errors evidence))
|
|
rejected (into (vec rejected) (mapcat second) entries)
|
|
errors (mapv first entries)
|
|
projected (cond-> projected
|
|
(and alias? (contains? (first errors) :partial))
|
|
(assoc :partial (:partial (first errors))))]
|
|
(cond-> projected
|
|
(seq errors) (assoc :errors errors)
|
|
(seq rejected) (assoc :errors (into (if (seq errors) errors [(dissoc projected :partial)]) rejected)))))))
|