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

🚧 WIP 29.5, refactor error handling

Browse Source 
AI-assisted-by: claude-haiku-5.5
This commit is contained in:
Miguel de Benito Delgado 2026-10-30 13:59:15 +01:00
parent 1edba96b17
commit 9469c020e0
20 changed files with 896 additions and 687 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,6 +18,8 @@
objects.
Failures retain their phase, cause and available partial evidence."
(:require-macros
[app.common.exceptions :as ex])
(:require
[app.common.render-wasm.helpers :as h]
[app.common.render-wasm.serialize-shape :as serialize-shape]
@ -143,12 +145,10 @@
(defn- graphics-string
[context parameter]
(try
(let [ext (.getExtension ^js context "WEBGL_debug_renderer_info")]
(if (some? ext)
(str (.getParameter ^js context (unchecked-get ext parameter)))
"unknown"))
(catch :default _ "unknown")))
(or (ex/ignoring
(when-let [ext (.getExtension ^js context "WEBGL_debug_renderer_info")]
(str (.getParameter ^js context (unchecked-get ext parameter)))))
"unknown"))
(defn- renderer-string
"Reads the unmasked WebGL renderer identity."
@ -167,9 +167,7 @@
(when (some? canvas)
(when-let [context wasm/gl-context]
(webgl/release-context! wasm/internal-module context wasm/gl-context-handle))
(try
(.remove ^js canvas)
(catch :default _))))
(ex/ignoring (.remove ^js canvas))))
(defn- release-owner-resources!
"Drops the current owner's canvas, GL handles and WASM module binding
@ -213,9 +211,7 @@
not the canvas attributes. What the browser granted comes from
`getContextAttributes`."
[ctx width height dpr renderer]
(let [attrs (try
(.getContextAttributes ^js ctx)
(catch :default _ nil))
(let [attrs (ex/ignoring (.getContextAttributes ^js ctx))
attr (fn [k]
(when (some? attrs)
(unchecked-get attrs k)))
@ -273,18 +269,11 @@
[epoch cause fallback-phase]
(if (fail/stale? cause)
{:status "stale"}
(let [phase (try (or (:phase (ex-data cause))
fallback-phase
"aborted")
(catch :default _
(or fallback-phase "aborted")))
message (try (or (ex-message cause) "unknown failure")
(catch :default _
"unknown failure"))
detail (try (fail/describe-cause cause)
(catch :default _
[{:message fail/unrenderable-cause-text}]))
partial (try (:partial (ex-data cause)) (catch :default _ nil))
(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)))
preparation (get-in @prepared* [:graphics :preparation])]
(dispose-if-current! epoch)
(cond-> (fail/fail-data {:phase phase

9
frontend/performance/benches/render_wasm/declarations.cljs
View File

@ -19,6 +19,8 @@
Collection validates every declaration, derives each scene seed and
returns plain data."
(:require-macros
[app.common.exceptions :as ex])
(:require
[app.common.schema :as sm]
[app.common.transit :as t]
@ -340,10 +342,9 @@
its wire representation. This permits NaN and infinities while still
rejecting values that Transit cannot encode."
[value]
(try
(let [encoded (t/encode-str value)]
(= encoded (-> encoded t/decode-str t/encode-str)))
(catch :default _ false)))
(true? (ex/ignoring
(let [encoded (t/encode-str value)]
(= encoded (-> encoded t/decode-str t/encode-str))))))
(defn project-case
"Plain-data projection of a registered case: internal keys (`:ns`, `:run!`)

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

@ -0,0 +1,38 @@
;; 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)))))))

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

@ -0,0 +1,74 @@
;; 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))

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

@ -5,7 +5,9 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.failures
"Helpers for browser 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
@ -38,81 +40,72 @@
"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)))
(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]
(try
(cond
(or (nil? value) (boolean? value) (keyword? value))
value
(cond
(or (nil? value) (boolean? value) (keyword? value) (number? value))
value
(string? value)
(truncate-cause-str value)
(string? value)
(truncate-cause-str value)
(number? value)
value
:else
(truncate-cause-str (pr-str value)))
(catch :default _
unrenderable-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]
(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})))
(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]
(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}])))
(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}]))

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

@ -7,12 +7,15 @@
(ns benches.render-wasm.node.browser
"Owns Chromium through process/run from spawn, then attaches Playwright by CDP.
Shutdown stops the owned process group before disconnecting the client."
(:require-macros
[app.common.exceptions :as ex])
(:require
["fs" :as fs]
["os" :as os]
["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.identity :as identity]
[benches.render-wasm.node.options :as options]
@ -158,19 +161,17 @@
(when (or page context)
(let [deadline (process/deadline process/default-termination-grace-ms)
page-failure
(try
(when (and page (not (.isClosed ^js page)))
(await (within #(.close ^js page)
{:deadline deadline :phase :browser-page-close})))
nil
(catch :default cause cause))
(attempt :catch-fatal
(when (and page (not (.isClosed ^js page)))
(await (within #(.close ^js page)
{:deadline deadline :phase :browser-page-close})))
nil)
context-failure
(try
(when context
(await (within #(.close ^js context)
{:deadline deadline :phase :browser-context-close})))
nil
(catch :default cause cause))]
(attempt :catch-fatal
(when context
(await (within #(.close ^js context)
{:deadline deadline :phase :browser-context-close})))
nil)]
(when-let [cause (or page-failure context-failure)]
(throw cause)))))
@ -179,21 +180,12 @@
close failure does not mask process/disconnect/profile failures because the
group kill releases the same resources."
[{:keys [user-data-dir] :as owner}]
(try
(await (close-page owner))
(catch :default _ nil))
(let [process-failure (try
(await (stop-process owner))
nil
(catch :default cause cause))
disconnect-failure (try
(await (disconnect owner))
nil
(catch :default cause cause))
profile-failure (try
(fs/rmSync user-data-dir #js {:recursive true :force true})
nil
(catch :default cause cause))]
(ex/ignoring (await (close-page owner)))
(let [process-failure (attempt :catch-fatal (await (stop-process owner)) nil)
disconnect-failure (attempt :catch-fatal (await (disconnect owner)) nil)
profile-failure (attempt :catch-fatal
(fs/rmSync user-data-dir #js {:recursive true :force true})
nil)]
(when-let [cause (or process-failure disconnect-failure profile-failure)]
(throw cause))))
@ -275,7 +267,7 @@
:endpoint @(:address endpoint) :user-data-dir user-data-dir
:startup-failure (failures/describe-cause cause)}
cleanup-cause))))
(throw (ex-info (or (ex-message cause) (str cause))
(throw (ex-info (errors/message-of cause)
(assoc (ex-data cause) :endpoint @(:address endpoint) :user-data-dir user-data-dir)
cause)))))))
@ -310,14 +302,10 @@
(transit/decode-str (await (within #(evaluate page "buildIdentity") bounds))))
page-own
(catch :default cause
(try
(await (close-page page-own))
(catch :default _ nil))
(ex/ignoring (await (close-page page-own)))
(throw cause))))
(catch :default cause
(try
(await (close-page {:context context}))
(catch :default _ nil))
(ex/ignoring (await (close-page {:context context})))
(throw cause)))))
(defn connected?

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

@ -17,6 +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.identity :as identity]
[benches.render-wasm.node.artifacts :as artifacts]
@ -38,7 +39,7 @@
(if (contains? #{:process-timeout :process-cancelled} (:type (ex-data cause)))
(throw cause)
(do
(log/warn (str "Git provenance unavailable: " (or (ex-message cause) (str cause))))
(log/warn (str "Git provenance unavailable: " (errors/message-of cause)))
{:sha nil :dirty nil})))))
(defn- check-profile-marks
@ -67,7 +68,8 @@
(300000), AbortSignal :signal, and optional :on-created callback. The callback
runs once after directory, log and initial manifest creation. CLI callers
print the ID there. Storage errors have no recorded ID. Later errors carry
:build-id and :phase. A retry always creates a new attempt."
:build-id and :phase. An error also carries :manifest-error and is fatal when
the failed manifest cannot be saved. A retry always creates a new attempt."
[{:keys [root features selection build-timeout-ms signal on-created]
:or {build-timeout-ms options/default-build-timeout-ms}}]
(when-not (and (js/Number.isSafeInteger build-timeout-ms) (pos? build-timeout-ms))
@ -145,18 +147,17 @@
(reset! build-ref ready)
(artifacts/load-build root (:id ready))))
(catch :default cause
(let [build @build-ref
failure {:phase @phase :cause (failures/describe-cause cause)}
manifest-error
(when (= :building (get-in build [:manifest :status]))
(try
(artifacts/write-manifest build (assoc (:manifest build) :status :failed :failure failure))
nil
(catch :default save-cause
(or (ex-message save-cause) (str save-cause)))))]
(throw (ex-info "renderer build preparation failed"
(cond-> {:type ::preparation-failed :build-id (:id build)
:phase @phase :log-path (or (:log-path (ex-data cause)) (:log-path build))
:reason (str/join " -> " (keep :message (:cause failure)))}
manifest-error (assoc :manifest-error manifest-error))
cause))))))))
(let [build @build-ref
failure {:phase @phase :cause (failures/describe-cause cause)}
saved (when (= :building (get-in build [:manifest :status]))
(attempt :catch-fatal
(artifacts/write-manifest
build (assoc (:manifest build) :status :failed :failure failure))))
manifest-error (when (failure? saved) (errors/message-of saved))
data (cond-> {:type ::preparation-failed :build-id (:id build)
:phase @phase :log-path (or (:log-path (ex-data cause)) (:log-path build))
:reason (str/join " -> " (keep :message (:cause failure)))}
manifest-error (assoc :manifest-error manifest-error))]
(throw (if manifest-error
(errors/fatal-error "renderer build preparation failed" data cause)
(ex-info "renderer build preparation failed" data cause)))))))))

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

@ -9,75 +9,116 @@
(: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.node.artifacts :as artifacts]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.feature-comparison :as feature-comparison]
[benches.render-wasm.node.feature-plan :as feature-plan]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.options :as options]
[benches.render-wasm.node.outcome :as outcome]
[benches.render-wasm.node.process :as process]
[benches.render-wasm.node.run :as run]))
(defn- ^:async run-command
[root options]
(defn- ^:async with-interruption
"Calls `(f signal)` with an AbortSignal that SIGINT and SIGTERM abort, and
returns its outcome. A failure becomes an outcome with exit code 1. After an
interruption the exit code is 130 or 143 and only fatal failures stay in
the errors: the others come from the aborted work."
[f]
(let [controller (js/AbortController.)
signal (.-signal controller)
interrupted (atom nil)
remove-signals (process/on-signals
(fn [name]
(fn [signal-name]
(when-not (.-aborted signal)
(reset! interrupted name)
(reset! interrupted signal-name)
(.abort controller
(ex-info "run interrupted"
{:type ::interrupted :signal name})))))]
(ex-info "interrupted"
{:type ::interrupted :signal signal-name})))))]
(try
(await (run/run root (select-keys options (sm/keys run/schema:run-options)) signal))
(catch :default cause
{:error cause :log-path (:log-path (ex-data cause))
:exit-code (case @interrupted "SIGINT" 130 "SIGTERM" 143 1)})
(let [result (attempt :catch-fatal (await (f signal)))
finished (if (failure? result) (outcome/failed result {}) result)]
(cond-> finished
@interrupted (-> (update :errors #(filterv errors/fatal? %))
(assoc :exit-code (outcome/interruption-code @interrupted)))))
(finally
(remove-signals)))))
(defn- ^:async build-command
(defn- run-command
[root options]
(let [controller (js/AbortController.)
remove-signals (process/on-signals #(.abort controller %))]
(try
(with-interruption
#(run/run root (select-keys options (sm/keys run/schema:run-options)) %)))
(defn- build-command
[root options]
(with-interruption
(^:async fn [signal]
(await (build/prepare {:root root
:features {:default-features? (:default-features options)
:features (or (:features options) [])}
:build-timeout-ms (:build-timeout-ms options)
:signal (.-signal controller)
:signal signal
:on-created (fn [build]
(log/result (str "Build " (:id build)))
(log/result (str "Output " (:dir build))))}))
{:exit-code 0}
(finally (remove-signals)))))
{:exit-code 0})))
(defn- ^:async ab-command
(defn- ab-command
[root options]
(let [controller (js/AbortController.)
signal (.-signal controller)
interrupted (atom nil)
remove-signals (process/on-signals
(fn [name]
(when-not (.-aborted signal)
(reset! interrupted name)
(.abort controller name))))]
(try
(with-interruption
(^:async fn [signal]
(let [prepared (await (feature-plan/prepare root options signal))]
(if (:dry-run options)
(do
(log/result (feature-plan/format-plan prepared))
{:exit-code 0})
(let [result (await (feature-comparison/execute root prepared signal {}))]
(cond-> result
@interrupted (assoc :exit-code (case @interrupted "SIGTERM" 143 130))))))
(catch :default cause
{:error cause :log-path (:log-path (ex-data cause))
:exit-code (case @interrupted "SIGINT" 130 "SIGTERM" 143 1)})
(finally
(remove-signals)))))
(await (feature-comparison/execute root prepared signal {})))))))
(defn- ^:async run-request
"Runs the validated command and returns its outcome."
[request]
(let [{:keys [command options]} (transit/decode-str request)
_ (when (and (:require-gpu options)
(or (= command "run")
(and (= command "ab") (not (:dry-run options))))
(not= "1" (.-PENPOT_GPU (.-env js/process))))
(throw (ex-info "--require-gpu needs PENPOT_GPU=1. Start the container with ./manage.sh run-devenv --gpu and use pnpm run render-bench."
{:type ::gpu-required})))
root (artifacts/frontend-root)]
(log/configure {:level (options/console-level options)
:color (options/color-mode options)})
(case command
"purge"
(do
(artifacts/purge root (cond (:only-builds options) :builds
(:only-runs options) :runs
(:only-comparisons options) :comparisons
:else :all))
{:exit-code 0})
"build"
(await (build-command root options))
"run"
(await (run-command root options))
"ab"
(await (ab-command root options)))))
(defn- log-failures
"Prints each failure of `result`. Only the first prints a log tail."
[result]
(binding [log/*log-path* (:log-path result)]
(doseq [[index cause] (map-indexed vector (:errors result))]
(let [data (ex-data cause)]
(log/error {:message (errors/message-of cause)
:fields (filterv (comp some? second)
[[:type (:type data)] [:phase (:phase data)]
[:build (:build-id data)] [:reason (:reason data)]
[:manifest-error (:manifest-error data)]])
:tail-log (:log-path data)
:tail? (zero? index)})))))
(defn ^:async execute
"Accepts a validated Transit command from the CLI and returns its exit code.
@ -85,44 +126,7 @@
Execution errors are printed here before returning a numeric exit code."
[request]
(log/configure {})
(let [outcome
(try
(let [{:keys [command options]} (transit/decode-str request)
_ (when (and (:require-gpu options)
(or (= command "run")
(and (= command "ab") (not (:dry-run options))))
(not= "1" (.-PENPOT_GPU (.-env js/process))))
(throw (ex-info "--require-gpu needs PENPOT_GPU=1. Start the container with ./manage.sh run-devenv --gpu and use pnpm run render-bench."
{:type ::gpu-required})))
root (artifacts/frontend-root)]
(log/configure {:level (options/console-level options)
:color (options/color-mode options)})
(case command
"purge"
(do
(artifacts/purge root (cond (:only-builds options) :builds
(:only-runs options) :runs
(:only-comparisons options) :comparisons
:else :all))
{:exit-code 0})
"build"
(await (build-command root options))
"run"
(await (run-command root options))
"ab"
(await (ab-command root options))))
(catch :default cause
{:error cause :log-path (:log-path (ex-data cause)) :exit-code 1}))]
(when-let [cause (or (:error outcome) (:storage-error outcome))]
(let [data (ex-data cause)]
(binding [log/*log-path* (:log-path outcome)]
(log/error {:message (or (ex-message cause) (str cause))
:fields (filterv (comp some? second)
[[:type (:type data)] [:phase (:phase data)]
[:build (:build-id data)] [:reason (:reason data)]
[:manifest-error (:manifest-error data)]])
:tail-log (:tail-log outcome)}))))
(:exit-code outcome)))
(let [result (attempt :catch-fatal (await (run-request request)))
finished (if (failure? result) (outcome/failed result {}) result)]
(log-failures finished)
(:exit-code finished)))

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

@ -11,12 +11,14 @@
["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.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.run :as run]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.report.compare :as compare]
@ -67,7 +69,7 @@
(fs/writeFileSync (path/join dir "feature-comparison.log") "" #js {:encoding "utf8" :flag "wx"})
(catch :default cause
(invalid-home "cannot create feature comparison home"
{:path dir :cause (or (ex-message cause) (str cause))})))
{:path dir :cause (errors/message-of cause)})))
{:dir dir
:log-path (path/join dir "feature-comparison.log")
:record-path (path/join dir record-file)}))
@ -94,66 +96,18 @@
(keyword? reason) (name reason)
:else (or (:signal (ex-data reason)) "SIGINT")))))
(defn- signal-exit
[signal]
(if (= "SIGTERM" signal) 143 130))
(defn- message-of
[cause]
(or (ex-message cause) (str cause)))
(defn- with-log-path
[cause log-path]
(ex-info (message-of cause)
(assoc (ex-data cause) :log-path (or (:log-path (ex-data cause)) log-path))
cause))
(defn- failure-evidence
[phase cause]
(cond-> {:phase (name phase)
:message (message-of cause)
: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]
(ex-info "cannot persist feature comparison"
{:type ::storage-error :fatal true :cause (message-of cause) :log-path log-path}
cause))
(defn- fatal?
"True when cause or one of its causes cannot be recorded in the saved
comparison: it has `:fatal` ex-data or comes from the log sink."
([cause]
(fatal? cause 0))
([cause depth]
(let [data (ex-data cause)]
(cond
(nil? cause) false
(or (:fatal data) (= ::log/storage-error (:type data))) true
(>= depth 8) false
:else (fatal? (ex-cause cause) (inc depth))))))
(defn- attempt
"Returns the result of calling f, or {:error cause} when f throws.
Rethrows fatal errors."
[f]
(try
(f)
(catch :default cause
(if (fatal? cause)
(throw cause)
{:error cause}))))
(defn- ^:async attempt-async
"Like `attempt` for a function f that returns a promise or a value."
[f]
(try
(await (f))
(catch :default cause
(if (fatal? cause)
(throw cause)
{:error cause}))))
(errors/fatal-error "cannot persist feature comparison"
{:type ::storage-error :cause (errors/message-of cause) :log-path log-path}
cause))
(defn- change-config
[record slug f]
@ -250,15 +204,13 @@
(mark-edges-unattempted state pending reason))))
(defn- finish
[state status exit-code error interrupted?]
[state status exit-code causes]
(let [record (persist state #(assoc % :status status :ended-at (now)))]
{:comparison record
:home (:home state)
:log-path (get-in state [:home :log-path])
:tail-log (:log-path (ex-data error))
:exit-code exit-code
:error error
:interrupted? interrupted?}))
:errors (vec (remove nil? causes))
:exit-code exit-code}))
(defn- finish-root
[state error]
@ -266,15 +218,15 @@
completed (and (every? #(= :completed (:status %)) (:configurations record))
(every? #(= :completed (:status %)) (:edges record)))]
(if completed
(finish state :completed 0 error false)
(finish state :failed 1 error false))))
(finish state :completed 0 [error])
(finish state :failed 1 [error]))))
(defn- interrupt-comparison
[state signal error]
(let [reason (str "interrupted by " signal)]
(mark-configs-unattempted state (:configurations @(:record-ref state)) reason)
(mark-edges-unattempted state reason)
(finish state :interrupted (signal-exit signal) error true)))
(finish state :interrupted (outcome/interruption-code signal) [error])))
(defn- record-created-build
[state slug build]
@ -286,17 +238,6 @@
:build (select-keys build [:id :manifest-path :log-path]))
(dissoc :failure :reason))))))
(defn- ^:async prepare-build
[state slug selection]
(attempt-async
(^:async fn []
{:build (await ((:prepare-build (:services state))
{:root (:root state)
:selection selection
:build-timeout-ms (get-in state [:options :build-timeout-ms])
:signal (:signal state)
:on-created (partial record-created-build state slug)}))})))
(defn- load-run
[path]
(when-not (and (string? path) (fs/existsSync path))
@ -363,87 +304,84 @@
(if (:outcome flow)
flow
(let [{:keys [slug selection]} (:configuration flow)
prepared (await (prepare-build state slug selection))
built (attempt
(await ((:prepare-build (:services state))
{:root (:root state)
:selection selection
: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))]
(cond
(:error prepared)
(assoc flow :outcome (fail-or-interrupt state slug :build (:error prepared)))
(failure? built)
(assoc flow :outcome (fail-or-interrupt state slug :build built))
signal
(assoc flow :outcome (interrupt-configuration state slug signal nil nil))
:else (accept-build state flow (:build prepared))))))
(defn- collect-build-cases
[state selected]
(let [result (attempt
#(let [collected ((:collect-catalog (:services state))
selected
{:master-seed (get-in state [:options :seed])
:filter (get-in state [:options :filter])})]
{:mismatch (not= collected (:cases state))}))]
(cond-> result
(:error result) (update :error with-log-path (:log-path selected)))))
:else (accept-build state flow built)))))
(defn- check-catalog
[state flow]
(if (:outcome flow)
flow
(let [slug (get-in flow [:configuration :slug])
result (collect-build-cases state (:build flow))
signal (signal-name (:signal state))
outcome (cond
(:error result) (fail-or-interrupt state slug :catalog (:error result))
signal (interrupt-configuration state slug signal nil nil)
(:mismatch result)
(fail-configuration state slug :catalog "catalog mismatch"
(ex-info "build catalog disagrees with the prepared cases"
{:type ::catalog-mismatch
:log-path (get-in flow [:build :log-path])
:configuration slug})))]
(cond-> flow outcome (assoc :outcome outcome)))))
(defn- create-config-home
[state slug]
(attempt
#(do {:home ((:create-run-home (:services state))
{:root (:root state) :run-id (str (random-uuid))
:output-dir (path/join (get-in state [:home :dir]) "configs" slug)})})))
(let [slug (get-in flow [:configuration :slug])
selected (:build flow)
mismatch? (-> (attempt
(not= ((:collect-catalog (:services state))
selected
{:master-seed (get-in state [:options :seed])
:filter (get-in state [:options :filter])})
(:cases state)))
(errors/with-data {:log-path (:log-path selected)}))
signal (signal-name (:signal state))
step (cond
(failure? mismatch?) (fail-or-interrupt state slug :catalog mismatch?)
signal (interrupt-configuration state slug signal nil nil)
mismatch?
(fail-configuration state slug :catalog "catalog mismatch"
(ex-info "build catalog disagrees with the prepared cases"
{:type ::catalog-mismatch
:log-path (:log-path selected)
:configuration slug})))]
(cond-> flow step (assoc :outcome step)))))
(defn- allocate-run
[state flow]
(if (:outcome flow)
flow
(let [slug (get-in flow [:configuration :slug])
result (create-config-home state slug)]
(if-let [cause (:error result)]
(assoc flow :outcome (fail-configuration state slug :run-home "run-home failure" cause))
(assoc flow :run-home (:home result))))))
(let [slug (get-in flow [:configuration :slug])
home (attempt
((:create-run-home (:services state))
{:root (:root state) :run-id (str (random-uuid))
:output-dir (path/join (get-in state [:home :dir]) "configs" slug)}))]
(if (failure? home)
(assoc flow :outcome (fail-configuration state slug :run-home "run-home failure" home))
(assoc flow :run-home home)))))
(defn- ^:async execute-run
[state flow]
(attempt-async
#((:execute-run (:services state))
(:root state) (:run-home flow) (:build flow) (:cases state)
(select-keys (:options state) (sm/keys run/schema:run-options))
(:signal state))))
(attempt
(await ((:execute-run (:services state))
(:root state) (:run-home flow) (:build flow) (:cases state)
(select-keys (:options state) (sm/keys run/schema:run-options))
(:signal state)))))
(defn- get-evidence-error
[slug home response]
(or (:storage-error response)
(:error (attempt
#(when-not (= (get-in response [:run :run-id])
(:run-id (load-run (:record-path home))))
(throw (ex-info "saved run identity disagrees with execution result"
{:type ::invalid-run :configuration slug})))))))
(or (some #(when (errors/fatal? %) %) (:errors response))
(attempt
(when-not (= (get-in response [:run :run-id]) (:run-id (load-run (:record-path home))))
(throw (ex-info "saved run identity disagrees with execution result"
{:type ::invalid-run :configuration slug}))))))
(defn- get-run-evidence
[slug home response]
(let [run (:run response)
home (or (:home response) home)
evidence-error (get-evidence-error slug home response)
error (when-let [cause (or evidence-error (:error response))]
(with-log-path cause (:log-path home)))]
error (errors/with-data (or evidence-error (first (:errors response)))
{:log-path (:log-path home)})]
{:run run
:home home
:evidence-error evidence-error
@ -512,6 +450,15 @@
(record-run-result state slug evidence)
(config-run-outcome slug evidence)))
(defn- get-missing-run-cause
"Returns why execution produced no run record, or nil when it produced one."
[response home]
(-> (cond
(failure? response) response
(nil? (:run response)) (or (first (:errors response))
(ex-info "run executor returned no record" {:type ::missing-run})))
(errors/with-data {:log-path (:log-path home)})))
(defn- ^:async run-configuration
[state flow]
(if (:outcome flow)
@ -525,14 +472,10 @@
:log-path (:log-path home)}))))
(log/info (str "Configuration " slug " running"))
(let [response (await (execute-run state flow))
outcome (if (:run response)
(finish-config-run state flow response)
(fail-configuration state slug :run "run failure"
(with-log-path
(or (:error response)
(ex-info "run executor returned no record" {:type ::missing-run}))
(:log-path home))))]
(assoc flow :outcome outcome)))))
cause (get-missing-run-cause response home)]
(assoc flow :outcome (if cause
(fail-configuration state slug :run "run failure" cause)
(finish-config-run state flow response)))))))
(defn- ^:async execute-config
[state configuration]
@ -589,39 +532,41 @@
:on-unallowed-difference :record))
(defn- analyze-edge
"Returns the path of the saved comparison and its count of unacknowledged
differences, or the failure, fatal failures included."
[state edge]
(try
(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]))
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])
"comparisons"
(str (:from edge) "__" (:to edge) ".transit"))]
(save-comparison path comparison (get-in state [:home :log-path]))
{:path path
:unacknowledged (unacknowledged-count comparison)})
(catch :default cause
(if (fatal? cause)
{:storage-error cause}
{:error cause}))))
(attempt
:catch-fatal
(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]))
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])
"comparisons"
(str (:from edge) "__" (:to edge) ".transit"))]
(save-comparison path comparison (get-in state [:home :log-path]))
{:path path
:unacknowledged (unacknowledged-count comparison)})))
(defn- record-edge-outcome
"Records the result of analyzing an edge and returns the first error seen so
far. Throws a fatal failure after the edge and the remaining edges are
recorded."
[state edge result error]
(cond
(:storage-error result)
(and (failure? result) (errors/fatal? result))
(do
(mark-edge state edge :failed {:failure (failure-evidence :comparison-storage (:storage-error result))})
(mark-edge state edge :failed {:failure (failure-evidence :comparison-storage result)})
(mark-edges-unattempted state "not attempted after comparison storage failure")
{:storage (:storage-error result)})
(throw result))
(:error result)
(failure? result)
(do
(mark-edge state edge :failed {:failure (failure-evidence :comparison (:error result))})
{:error (or error (:error result))})
(mark-edge state edge :failed {:failure (failure-evidence :comparison result)})
(or error result))
(pos? (:unacknowledged result))
(do
@ -629,12 +574,12 @@
" has " (:unacknowledged result) " unacknowledged differences"))
(mark-edge state edge :failed {:path (:path result)
:failure {:unacknowledged-differences (:unacknowledged result)}})
{:error error})
error)
:else
(do
(mark-edge state edge :completed {:path (:path result)})
{:error error})))
error)))
(defn- ^:async analyze-edges
[state edges error]
@ -644,10 +589,7 @@
(mark-edges-unattempted state (str "interrupted by " signal))
{:interrupted signal :error error})
(if-let [[edge & pending] (seq edges)]
(let [outcome (record-edge-outcome state edge (analyze-edge state edge) error)]
(if (:storage outcome)
outcome
(analyze-edges state pending (:error outcome))))
(analyze-edges state pending (record-edge-outcome state edge (analyze-edge state edge) error))
{:done true :error error})))
(defn- create-comparison-directory
@ -663,26 +605,27 @@
(interrupt-comparison state signal error)
(do
(create-comparison-directory state)
(let [outcome (await (analyze-edges state (:edges @(:record-ref state)) error))]
(let [analyzed (attempt :catch-fatal
(await (analyze-edges state (:edges @(:record-ref state)) error)))]
(cond
(:interrupted outcome) (interrupt-comparison state (:interrupted outcome) (:error outcome))
(:storage outcome) (finish state :failed 1 (:storage outcome) false)
:else (finish-root state (:error outcome)))))))
(failure? analyzed) (finish state :failed 1 [analyzed error])
(:interrupted analyzed) (interrupt-comparison state (:interrupted analyzed) (:error analyzed))
:else (finish-root state (:error analyzed)))))))
(defn- ^:async run-comparisons
[state configurations]
(if-let [signal (signal-name (:signal state))]
(interrupt-comparison state signal nil)
(if-let [[configuration & pending] (seq configurations)]
(let [outcome (await (execute-config state configuration))]
(let [step (await (execute-config state configuration))]
(cond
(:interrupted? outcome)
(interrupt-comparison state (:signal outcome) (:error outcome))
(:interrupted? step)
(interrupt-comparison state (:signal step) (:error step))
(:stop? outcome)
(:stop? step)
(do
(mark-configs-unattempted state pending (:reason outcome))
(run-edges state (:error outcome)))
(mark-configs-unattempted state pending (:reason step))
(run-edges state (:error step)))
:else (run-comparisons state pending)))
(run-edges state nil))))
@ -709,34 +652,26 @@
(reset! (:saved-ref state) saved))))
(defn- publish-status
[outcome]
(try
(log/result (str "Status " (cond
(:interrupted? outcome) "interrupted"
(zero? (:exit-code outcome)) "completed"
:else "failed")))
outcome
(catch :default cause
(assoc outcome :error (or (:error outcome) cause)
:storage-error cause
:exit-code (if (:interrupted? outcome) (:exit-code outcome) 1)))))
[result]
(outcome/publish result
#(log/result (str "Status " (case (:exit-code result)
0 "completed"
(130 143) "interrupted"
"failed")))))
(defn- ^:async execute-comparison
[state]
(let [home (:home state)]
(binding [log/*log-path* (:log-path home)]
(let [outcome (try
(initialize-comparison state)
(await (run-comparisons state (:configurations @(:record-ref state))))
(catch :default cause
{:comparison @(:saved-ref state)
:home home
:log-path (:log-path home)
:tail-log (:log-path (ex-data cause))
:exit-code 1
:error cause
:interrupted? false}))]
(publish-status outcome)))))
(let [result (attempt :catch-fatal
(initialize-comparison state)
(await (run-comparisons state (:configurations @(:record-ref state)))))]
(publish-status
(if (failure? result)
(outcome/failed result {:comparison @(:saved-ref state)
:home home
:log-path (:log-path home)})
result))))))
(defn ^:async execute
"Executes a prepared feature comparison and owns builds, runs and reports.
@ -745,18 +680,14 @@
- settings: accepts an optional :services map with :prepare-build, :collect-catalog,
:create-run-home and :execute-run overrides.
Operational failures are returned as :error. The saved record reflects the
last successful atomic write."
Returns the comparison record, home, log path, exit code and the failures
in :errors. The saved record reflects the last successful atomic write."
[root prepared signal settings]
(let [services (merge default-services (:services settings))
comparison-id (str (random-uuid))
home (attempt #(create-home root comparison-id (:output-dir prepared)))]
(if-let [cause (:error home)]
{:comparison nil
:home nil
:exit-code 1
:error cause
:interrupted? false}
home (attempt (create-home root comparison-id (:output-dir prepared)))]
(if (failure? home)
(outcome/failed home {:comparison nil :home nil})
(await
(execute-comparison
(create-comparison-state root prepared signal services home comparison-id))))))

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

@ -47,8 +47,11 @@
So: quiet mode still records detailed diagnostics in files.
Also, the console renderer adds headings, prefixes, and colors."
(:require-macros
[app.common.exceptions :as ex])
(:require
["fs" :as fs]
[benches.render-wasm.errors :as errors]
[clojure.string :as str]))
;; Each high-level task binds its own path and awaits its work inside that scope:
@ -102,8 +105,9 @@
(fs/appendFileSync *log-path* (str text "\n") "utf8")
nil
(catch :default cause
(ex-info "cannot append benchmark log"
{:type ::storage-error :log-path *log-path*} cause))))
(errors/fatal-error "cannot append benchmark log"
{:type ::storage-error :log-path *log-path*}
cause))))
enabled (case level
:debug (= :debug console-level)
:info (contains? #{:info :debug} console-level)
@ -126,18 +130,17 @@
(defn- get-tail
[path]
(when path
(try
(let [fd (fs/openSync path "r")]
(try
(let [size (.-size (fs/fstatSync fd))
length (min size 8192)
buffer (js/Buffer.alloc length)
read (fs/readSync fd buffer 0 length (- size length))]
(->> (str/split-lines (.toString buffer "utf8" 0 read))
(remove str/blank?)
(take-last 20)))
(finally (fs/closeSync fd))))
(catch :default _ nil))))
(ex/ignoring
(let [fd (fs/openSync path "r")]
(try
(let [size (.-size (fs/fstatSync fd))
length (min size 8192)
buffer (js/Buffer.alloc length)
read (fs/readSync fd buffer 0 length (- size length))]
(->> (str/split-lines (.toString buffer "utf8" 0 read))
(remove str/blank?)
(take-last 20)))
(finally (fs/closeSync fd)))))))
(defn error
"Prints a terminal failure with ordered fields and an optional bounded log tail."

45
frontend/performance/benches/render_wasm/node/outcome.cljs Normal file
View File

@ -0,0 +1,45 @@
;; 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.outcome
"Result of a benchmark command.
An outcome is a map with `:exit-code`. A command that failed adds `:errors`
(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?]]))
(defn interruption-code
"Returns the exit code for the interrupting signal name: 143 for SIGTERM,
130 otherwise."
[signal-name]
(case signal-name "SIGTERM" 143 130))
(defn failed
"Returns an outcome with exit code 1 for `cause`. The log path comes from
the ex-data of `cause`. `data` adds more keys."
[cause data]
(merge {:errors [cause]
:exit-code 1
:log-path (:log-path (ex-data cause))}
data))
(defn add-error
"Appends `cause` to the errors of `outcome`. An exit code that is not an
interruption becomes 1."
[outcome cause]
(-> outcome
(update :errors (fnil conj []) cause)
(update :exit-code #(if (contains? #{130 143} %) % 1))))
(defn publish
"Calls `f` to print a result of `outcome`. A failure of `f` is added to the
errors of the returned outcome."
[outcome f]
(let [published (attempt :catch-fatal (f))]
(cond-> outcome
(failure? published) (add-error published))))

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

@ -13,6 +13,8 @@
slot. Browser failures leave the current case's remaining slots unattempted
and continue with the next case in a new browser. The run record is atomically
replaced after every preparation, attempt and diagnostic change."
(:require-macros
[app.common.exceptions :as ex])
(:require
["module" :as node-module]
["os" :as os]
@ -20,6 +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.measurement :as measurement]
[benches.render-wasm.node.artifacts :as artifacts]
@ -27,6 +30,7 @@
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.catalog :as catalog]
[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.runs :as runs]
[benches.render-wasm.node.server :as server]
@ -64,10 +68,6 @@
[]
(.toISOString (js/Date.)))
(defn- message-of
[cause]
(or (ex-message cause) (str cause)))
(defn- cause-evidence
"Plain failure evidence for a rejected browser, server or persistence action."
[cause fallback-phase]
@ -75,7 +75,7 @@
phase (or (:phase data) (name fallback-phase))]
(cond-> {:status "failed"
:phase (if (keyword? phase) (name phase) (str phase))
:message (message-of cause)
:message (errors/message-of cause)
:cause (failures/describe-cause cause)}
(:partial data) (assoc :partial (:partial data)))))
@ -102,29 +102,38 @@
[state]
(some? (interruption (:signal state))))
(defn- keep-sink-failure
"Remembers the first failed write to the run record or log. The failure stays
in the outcome even when a later write succeeds."
[state cause]
(swap! (:sink-failure-ref state) #(or % cause))
cause)
(defn- write-log
[state output text]
(try
(output text)
(catch :default cause
(reset! (:storage-error-ref state) cause)
(throw cause))))
(throw (keep-sink-failure
state
(if (errors/fatal? cause)
cause
(errors/fatal-error "cannot write the run log" {} cause)))))))
(defn- warn-safely
"Appends runner diagnostics without replacing an error already under handling."
[state text]
(try
(write-log state log/warn text)
(catch :default _
nil)))
(ex/ignoring (write-log state log/warn text))
nil)
(defn- persist
[state]
(try
(runs/write-record! (:home state) @(:run-ref state))
(catch :default cause
(reset! (:storage-error-ref state) cause)
(throw cause))))
(throw (keep-sink-failure
state
(errors/fatal-error "cannot save the run record" {:log-path (get-in state [:home :log-path])} cause))))))
(defn- record-preparation
[state preparation]
@ -133,15 +142,15 @@
(write-log state log/debug (str "Prepared " (result/case-name (:case-id preparation)))))
(defn- record-attempt
[state attempt]
(swap! (:run-ref state) result/record-attempt attempt)
[state measured]
(swap! (:run-ref state) result/record-attempt measured)
(persist state)
(let [remaining (get-in @(:run-ref state) [:remaining (:case-id attempt)])
(let [remaining (get-in @(:run-ref state) [:remaining (:case-id measured)])
total (+ (:warmups (:opts state)) (:repetitions (:opts state)))
index (- total (:warmups remaining) (:repetitions remaining))]
(write-log state (if (= :failed (:outcome attempt)) log/warn log/info)
(str " attempt " index "/" total " " (name (:outcome attempt))
(when (:warmup? attempt) " (warmup)")))))
(write-log state (if (= :failed (:outcome measured)) log/warn log/info)
(str " attempt " index "/" total " " (name (:outcome measured))
(when (:warmup? measured) " (warmup)")))))
(defn- record-failure
[state case-id stage evidence]
@ -186,19 +195,20 @@
(let [{:keys [file path]} (runs/screenshot-path (:home state) (:id case))
opts (:opts state)
bounds {:deadline (process/deadline (:startup-timeout-ms opts))
:signal (:signal state) :phase :screenshot}]
(try
(await ((get-in state [:services :screenshot]) page path bounds))
(record-screenshot-status state (:id case) {:file file :status :ok})
(write-log state log/debug (str "Screenshot " file))
(catch :default cause
:signal (:signal state) :phase :screenshot}
shot (attempt (await ((get-in state [:services :screenshot]) page path bounds)))]
(if (failure? shot)
(do
(record-screenshot-status state (:id case)
{:file file :status :failed
:message (message-of cause)
:cause (failures/describe-cause cause)})
:message (errors/message-of shot)
:cause (failures/describe-cause shot)})
(write-log state log/warn (str "Screenshot failed for "
(result/case-name (:id case)) ": "
(message-of cause) "\n")))))))
(errors/message-of shot) "\n")))
(do
(record-screenshot-status state (:id case) {:file file :status :ok})
(write-log state log/debug (str "Screenshot " file)))))))
(defn- case-slots
"Returns each scheduled slot in order: all warmups, then measured slots.
@ -213,44 +223,41 @@
(defn- ^:async prepare-case
[state case page deadline]
(try
(let [opts (:opts state)
build-id (:id (:selected-build state))
request (transit/encode-str
{:case case
:preparation-id (str (random-uuid))
:timeout-ms (:timeout-ms opts)
:module-url (renderer-url build-id "render-wasm.js")
:wasm-url (renderer-url build-id "render-wasm.wasm")})
response (await ((get-in state [:services :prepare])
page request
{:deadline deadline :signal (:signal state) :phase :preparation}))]
(if (= "ok" (:status response))
{:preparation (:preparation response)}
{:failure (failure-evidence response :preparation)}))
(catch :default cause
{:failure (cause-evidence cause :preparation)})))
(let [opts (:opts state)
build-id (:id (:selected-build state))
response (attempt
(await ((get-in state [:services :prepare])
page
(transit/encode-str
{:case case
:preparation-id (str (random-uuid))
:timeout-ms (:timeout-ms opts)
:module-url (renderer-url build-id "render-wasm.js")
:wasm-url (renderer-url build-id "render-wasm.wasm")})
{:deadline deadline :signal (:signal state) :phase :preparation})))]
(cond
(failure? response) {:failure (cause-evidence response :preparation)}
(= "ok" (:status response)) {:preparation (:preparation response)}
:else {:failure (failure-evidence response :preparation)})))
(defn- ^:async run-attempt
"Returns the bridge evidence of one attempt, or the failure."
[state page preparation-id deadline]
(try
(let [request (transit/encode-str
{:preparation-id preparation-id
:timeout-ms (max 1 (process/remaining deadline))})]
{:evidence (await ((get-in state [:services :run])
page request
{:deadline deadline :signal (:signal state) :phase :attempt}))})
(catch :default cause
{:evidence (cause-evidence cause :attempt) :error cause})))
(attempt
(await ((get-in state [:services :run])
page
(transit/encode-str
{:preparation-id preparation-id
:timeout-ms (max 1 (process/remaining deadline))})
{:deadline deadline :signal (:signal state) :phase :attempt}))))
(defn- ^:async recycle-browser
[state]
(when-let [owner @(:owner-ref state)]
(reset! (:owner-ref state) nil)
(try
(await ((get-in state [:services :close]) owner))
(catch :default cause
(write-log state log/warn (str "Browser cleanup failed: " (message-of cause)))))))
(let [closed (attempt (await ((get-in state [:services :close]) owner)))]
(when (failure? closed)
(write-log state log/warn (str "Browser cleanup failed: " (errors/message-of closed)))))))
(defn- ^:async close-current-page
[state]
@ -264,13 +271,13 @@
(if-let [page @(:page-ref state)]
(do
(reset! (:page-ref state) nil)
(try
(await ((get-in state [:services :close-page]) page))
true
(catch :default cause
(record-failure state nil :browser-close (cause-evidence cause :browser-close))
(await (recycle-browser state))
false)))
(let [closed (attempt (await ((get-in state [:services :close-page]) page)))]
(if (failure? closed)
(do
(record-failure state nil :browser-close (cause-evidence closed :browser-close))
(await (recycle-browser state))
false)
true)))
true))))
(defn- ^:async ensure-browser
@ -315,34 +322,35 @@
(defn- ^:async open-case-page
[state case owner]
(let [opened (try
{:owner (await ((get-in state [:services :new-page])
owner @(:host-ref state)
{:viewport (declarations/resolve-viewport (:view case))
:startup-timeout-ms (:startup-timeout-ms (:opts state))
:signal (:signal state)}))}
(catch :default cause {:error cause}))]
(if-let [cause (:error opened)]
(if (interrupted? state)
{:outcome :interrupted}
(do
(record-failure state (:id case) :browser-page (cause-evidence cause :browser-page))
(await (recycle-browser state))
{:outcome :abandon}))
(let [opened (attempt
(await ((get-in state [:services :new-page])
owner @(:host-ref state)
{:viewport (declarations/resolve-viewport (:view case))
:startup-timeout-ms (:startup-timeout-ms (:opts state))
:signal (:signal state)})))]
(cond
(not (failure? opened))
(do
(reset! (:page-ref state) (:owner opened))
{:page (:page (:owner opened))}))))
(reset! (:page-ref state) opened)
{:page (:page opened)})
(interrupted? state)
{:outcome :interrupted}
:else
(do
(record-failure state (:id case) :browser-page (cause-evidence opened :browser-page))
(await (recycle-browser state))
{:outcome :abandon}))))
(defn- ^:async open-page
[state case]
(if (interrupted? state)
{:outcome :interrupted}
(let [launch (try
{:owner (await (ensure-browser state))}
(catch :default cause {:error cause}))]
(let [owner (attempt (await (ensure-browser state)))]
(cond
(nil? (:error launch))
(await (open-case-page state case (:owner launch)))
(not (failure? owner))
(await (open-case-page state case owner))
(interrupted? state)
{:outcome :interrupted}
@ -350,7 +358,7 @@
:else
(do
(record-failure state (:id case) :browser-launch
(cause-evidence (:error launch) :browser-launch))
(cause-evidence owner :browser-launch))
(reset! (:abort-run? state) true)
{:outcome :abort})))))
@ -361,12 +369,15 @@
(defn- ^:async execute-slot
[state case page preparation-id warmup? deadline]
(let [{:keys [evidence error]} (await (run-attempt state page preparation-id deadline))
attempt (measurement/attempt (:id case) preparation-id warmup? evidence)]
(record-attempt state attempt)
(let [response (await (run-attempt state page preparation-id deadline))
measured (measurement/attempt (:id case) preparation-id warmup?
(if (failure? response)
(cause-evidence response :attempt)
response))]
(record-attempt state measured)
(cond
(and error (interrupted? state)) :interrupted
(= :completed (:outcome attempt)) :ok
(and (failure? response) (interrupted? state)) :interrupted
(= :completed (:outcome measured)) :ok
:else :failed)))
(defn- ^:async finish-slot
@ -472,53 +483,48 @@
(defn- ^:async launch-initial
[state]
(let [launched (try
(await (ensure-browser state))
true
(catch :default cause
(if (interrupted? state)
false
(do
(record-failure state nil :browser-launch
(cause-evidence cause :browser-launch))
false))))]
(let [owner (attempt (await (ensure-browser state)))]
(reset! (:launch-deadline state) nil)
(when-not launched
(when (failure? owner)
(when-not (interrupted? state)
(record-failure state nil :browser-launch (cause-evidence owner :browser-launch)))
(reset! (:abort-run? state) true))
launched))
(not (failure? owner))))
(defn- fail-startup
"Records the startup failure and aborts the run. An interrupted run records
nothing. Returns false."
[state stage cause]
(when (interrupted? state)
(throw cause))
(record-failure state nil stage (cause-evidence cause stage))
(reset! (:abort-run? state) true)
(when-not (interrupted? state)
(record-failure state nil stage (cause-evidence cause stage))
(reset! (:abort-run? state) true))
false)
(defn- ^:async record-provenance
[state deadline]
(try
(let [git (await (build/git-provenance (:root state)
{:deadline deadline :signal (:signal state)}))]
(swap! (:run-ref state) assoc-in [:metadata :diagnostics :runner-git] git)
(persist state)
true)
(catch :default cause
(fail-startup state :runner-git cause))))
(let [git (attempt (await (build/git-provenance (:root state)
{:deadline deadline :signal (:signal state)})))]
(if (failure? git)
(fail-startup state :runner-git git)
(do
(swap! (:run-ref state) assoc-in [:metadata :diagnostics :runner-git] git)
(persist state)
true))))
(defn- ^:async start-server
[state deadline]
(try
(let [remaining (process/remaining deadline)]
(when (zero? remaining)
(throw (ex-info "server startup timed out"
{:type ::startup-timeout :phase :server-startup})))
(reset! (:host-ref state)
(await (server/open (:selected-build state)
{:startup-timeout-ms remaining :signal (:signal state)})))
true)
(catch :default cause
(fail-startup state :server-startup cause))))
(let [remaining (process/remaining deadline)
host (attempt
(when (zero? remaining)
(throw (ex-info "server startup timed out"
{:type ::startup-timeout :phase :server-startup})))
(await (server/open (:selected-build state)
{:startup-timeout-ms remaining :signal (:signal state)})))]
(if (failure? host)
(fail-startup state :server-startup host)
(do
(reset! (:host-ref state) host)
true))))
(defn- session-active?
[state]
@ -596,13 +602,13 @@
@(:run-ref state)))
(defn- ^:async release-resource
"Closes the resource in `reference`. Returns nil or the failure."
[reference close]
(try
(when-let [resource @reference]
(reset! reference nil)
(await (close resource)))
nil
(catch :default cause cause)))
(attempt :catch-fatal
(when-let [resource @reference]
(reset! reference nil)
(await (close resource)))
nil))
(defn- ^:async cleanup
[state]
@ -611,7 +617,7 @@
server-failure (await (release-resource (:host-ref state) server/close))
failure (or page-failure browser-failure server-failure)]
(when failure
(warn-safely state (str "run: cleanup failed: " (message-of failure) "\n")))
(warn-safely state (str "run: cleanup failed: " (errors/message-of failure) "\n")))
failure))
(defn- remove-build
@ -625,12 +631,11 @@
(defn- playwright-version
[root]
(try
(let [require-package (if (exists? js/require)
js/require
(node-module/createRequire (path/join root "package.json")))]
(.-version (require-package "playwright/package.json")))
(catch :default _ nil)))
(ex/ignoring
(let [require-package (if (exists? js/require)
js/require
(node-module/createRequire (path/join root "package.json")))]
(.-version (require-package "playwright/package.json")))))
(defn- environment
[root _selected-build]
@ -690,7 +695,7 @@
:signal signal
:home home
:run-ref (atom (create-run-record root (:run-id home) selected-build cases opts))
:storage-error-ref (atom nil)
:sink-failure-ref (atom nil)
:owner-ref (atom nil)
:page-ref (atom nil)
:host-ref (atom nil)
@ -701,21 +706,20 @@
(defn- record-session-failure
[state stage cause]
(try
(record-failure state nil stage (cause-evidence cause stage))
(catch :default record-cause
(let [recorded (attempt :catch-fatal
(record-failure state nil stage (cause-evidence cause stage)))]
(when (failure? recorded)
(warn-safely state (str "Could not record " (when (= :cleanup stage) "cleanup ")
"failure: " (message-of record-cause) "\n")))))
"failure: " (errors/message-of recorded) "\n")))))
(defn- ^:async execute-session
"Runs the session. Returns the failure that ended it, or nil. An interruption
is not a failure."
[state]
(try
(await (run-session state))
nil
(catch :default cause
(when-not (interrupted? state)
(record-session-failure state :runner cause))
cause)))
(let [ended (attempt :catch-fatal (await (run-session state)))]
(when (and (failure? ended) (not (interrupted? state)))
(record-session-failure state :runner ended)
ended)))
(defn- ^:async cleanup-session
[state]
@ -723,60 +727,53 @@
(record-session-failure state :cleanup cause)
cause))
(defn- save-run-outcome
[state error]
(try
{:run (finish-run state) :saved true :error error}
(catch :default cause
{:run @(:run-ref state) :saved false :error cause})))
(defn- remove-run-build
[state saved?]
(when (and saved? (:remove (:opts state)))
(try
(remove-build (:root state) (:selected-build state))
nil
(catch :default cause cause))))
(attempt :catch-fatal
(remove-build (:root state) (:selected-build state))
nil)))
(defn- format-run-report
"Returns the report text or the failure."
[state run]
(try
{:report (format/format-run (summary/summarize run))}
(catch :default cause
(warn-safely state (str "Report failed: " (message-of cause) "\n"))
{:error cause})))
(let [report (attempt (format/format-run (summary/summarize run)))]
(when (failure? report)
(warn-safely state (str "Report failed: " (errors/message-of report) "\n")))
report))
(defn- log-run-completion
[state run]
(try
(write-log state log/debug (str "Run " (name (get-in run [:termination :reason]))))
nil
(catch :default cause cause)))
(attempt :catch-fatal
(write-log state log/debug (str "Run " (name (get-in run [:termination :reason]))))
nil))
(defn- get-exit-code
[run error storage-error harness-failed?]
[run causes harness-failed?]
(case (get-in run [:termination :reason])
:interrupted (if (= "SIGTERM" (get-in run [:termination :signal])) 143 130)
:completed (if (or error storage-error harness-failed?) 1 0)
:interrupted (outcome/interruption-code (get-in run [:termination :signal]))
:completed (if (or (seq causes) harness-failed?) 1 0)
1))
(defn- finish-execution
[state session-error]
(let [finished (save-run-outcome state session-error)
run (:run finished)
removal-error (remove-run-build state (:saved finished))
report-result (format-run-report state run)
log-error (log-run-completion state run)
error (or (:error finished) removal-error (:error report-result) log-error)
storage-error @(:storage-error-ref state)
home (:home state)]
[state session-error cleanup-error]
(let [saved (attempt :catch-fatal (finish-run state))
run (if (failure? saved) @(:run-ref state) saved)
removal (remove-run-build state (not (failure? saved)))
report (format-run-report state run)
logged (log-run-completion state run)
causes (->> [cleanup-error session-error saved removal report logged
@(:sink-failure-ref state)]
(filter failure?)
distinct
vec)
home (:home state)]
{:run run
:home home
:log-path (:log-path home)
:report (:report report-result)
:exit-code (get-exit-code run error storage-error @(:harness-failed? state))
:error error
:storage-error storage-error}))
:report (when-not (failure? report) report)
:errors causes
:exit-code (get-exit-code run causes @(:harness-failed? state))}))
(defn ^:async execute
"Executes a prepared selection in an allocated home and owns host and browser.
@ -790,9 +787,10 @@
A browser startup failure leaves a valid partial record.
Returns the run, home, report, log path, exit code and optional error /
storage-error. A storage error reports any failed record or log write,
including a failure followed by a successful write."
Returns the run, home, report, log path, exit code and the failures in
:errors, a cleanup failure first. :errors includes any failed record or log
write, including a failure followed by a successful write. An interruption
is not a failure."
[root home selected-build cases options signal]
(check-options options)
(binding [log/*log-path* (:log-path home)]
@ -800,7 +798,7 @@
(persist state)
(let [session-error (await (execute-session state))
cleanup-error (await (cleanup-session state))]
(finish-execution state (or cleanup-error session-error))))))
(finish-execution state session-error cleanup-error)))))
(defn- ^:async get-selected-build
[root opts signal]
@ -818,22 +816,16 @@
(try
(catalog/collect selected-build {:master-seed (:seed opts) :filter (:filter opts)})
(catch :default cause
(throw (ex-info (message-of cause)
(throw (ex-info (errors/message-of cause)
(assoc (ex-data cause) :build-id (:id selected-build)
:log-path (:log-path selected-build))
cause)))))
(defn- publish-report
[outcome]
(try
(when-let [report (:report outcome)]
(log/result (str "Report\n" report)))
outcome
(catch :default cause
(assoc outcome :error (or (:error outcome) cause)
:storage-error cause
:exit-code (if (= :interrupted (get-in outcome [:run :termination :reason]))
(:exit-code outcome) 1)))))
[result]
(outcome/publish result
#(when-let [report (:report result)]
(log/result (str "Report\n" report)))))
(defn ^:async run
"Prepares or loads a build, collects matching cases and executes one run.
@ -858,7 +850,6 @@
(log/info (str " selected " (count cases) " cases"))
(publish-report (await (execute root home selected-build cases opts signal))))
(catch :default cause
(throw (ex-info (message-of cause)
(assoc (ex-data cause) :log-path
(or (:log-path (ex-data cause)) (:log-path home)))
cause)))))))
(throw (-> cause
errors/as-failure
(errors/with-data {:log-path (:log-path home)}))))))))

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

@ -9,6 +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.feature-plan :as feature-plan]
[benches.render-wasm.node.compare :as compare]
[benches.render-wasm.node.log :as log]
@ -274,32 +275,34 @@
:options (cond-> options (= command "ab") (assoc :default-features false))
:summary summary}))
(defn- ^:async run-cli
[args]
(let [{:keys [command arguments options summary] :as request} (parse-args args)]
(log/configure {:level (options/console-level options)
:color (options/color-mode options)})
(cond
(:help options)
(log/result (usage summary))
(= command "compare")
(log/result (:text (compare/execute (second arguments) (nth arguments 2)
(select-keys options [:cases :allow-build-differences
:allow-scene-differences
:allow-all-differences]))))
:else
(let [^js commands (js/require (path/join js/__dirname "commands.cjs"))]
(set! (.-exitCode js/process)
(await (.execute commands
(transit/encode-str (select-keys request [:command :options])))))))))
(defn ^:async -main
[& args]
(log/configure {})
(try
(let [{:keys [command arguments options summary] :as request} (parse-args args)]
(log/configure {:level (options/console-level options)
:color (options/color-mode options)})
(cond
(:help options)
(log/result (usage summary))
(= command "compare")
(log/result (:text (compare/execute (second arguments) (nth arguments 2)
(select-keys options [:cases :allow-build-differences
:allow-scene-differences
:allow-all-differences]))))
:else
(let [^js commands (js/require (path/join js/__dirname "commands.cjs"))]
(set! (.-exitCode js/process)
(await (.execute commands
(transit/encode-str (select-keys request [:command :options]))))))))
(catch :default cause
(let [data (ex-data cause)]
(log/error {:message (str (or (ex-message cause) (str cause))
"\nTry --help for usage.")
(let [failed (attempt :catch-fatal (await (run-cli args)))]
(when (failure? failed)
(let [data (ex-data failed)]
(log/error {:message (str (errors/message-of failed) "\nTry --help for usage.")
:fields (into (filterv (comp some? second)
[[:type (:type data)] [:baseline (:baseline data)]
[:candidate (:candidate data)]])

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

@ -14,6 +14,7 @@
(:require
["fs" :as fs]
["path" :as path]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.files :as files]
[benches.render-wasm.result :as result]
@ -57,12 +58,12 @@
(fs/mkdirSync dir #js {:recursive true})
(catch :default cause
(invalid-home "cannot create run home"
{:path dir :cause (or (ex-message cause) (str cause))})))
{: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 (or (ex-message cause) (str cause))})))
{:path log-path :cause (errors/message-of cause)})))
{:dir dir
:record-path record-path
:log-path log-path

17
frontend/test/performance_tests/render_wasm/build_test.cljs
View File

@ -15,6 +15,7 @@
["os" :as os]
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.process :as process]
[cljs.test :as t :include-macros true]
@ -224,6 +225,22 @@
(fs/readFileSync (path/join (:renderer-dir retained) "partial.js") "utf8"))))))
done)))
(t/deftest failed-manifest-save-makes-the-preparation-error-fatal
(t/async done
(complete
((^:async fn []
(install-renderer
(str failing-compiler
"fs.unlinkSync(path.join(path.dirname(process.env.FRONTEND_DEST), 'build.transit'));\n"))
(let [cause (await (rejected (build/prepare {:root (frontend-root)
:build-timeout-ms 10000
:on-created record-created})))
data (ex-data cause)]
(t/is (errors/fatal? cause))
(t/is (string? (:manifest-error data)))
(t/is (= :process-exit (:type (ex-data (ex-cause cause))))))))
done)))
(t/deftest timed-out-lock-holder-retains-its-attempt-and-retry-gets-a-new-id
(t/async done
(complete

79
frontend/test/performance_tests/render_wasm/errors_test.cljs Normal file
View File

@ -0,0 +1,79 @@
;; 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 performance-tests.render-wasm.errors-test
(:require
[benches.render-wasm.errors :as errors :include-macros true :refer [attempt failure?]]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(t/deftest attempt-returns-the-value-of-its-body
(t/is (= 3 (attempt 1 2 3)))
(t/is (nil? (attempt nil)))
(t/is (= {:error :not-a-failure} (attempt {:error :not-a-failure}))))
(t/deftest attempt-returns-the-error-its-body-throws
(let [cause (ex-info "boom" {:a 1})
result (attempt (throw cause))]
(t/is (failure? result))
(t/is (identical? cause result))))
(t/deftest attempt-turns-a-thrown-value-into-an-error-that-keeps-its-text
(let [text (attempt (throw "device disconnected"))
object (attempt (throw #js {:code 7}))]
(t/is (failure? text))
(t/is (= "device disconnected" (ex-message text)))
(t/is (failure? object))
(t/is (str/includes? (ex-message object) "code"))))
(t/deftest attempt-throws-fatal-failures-again
(let [cause (errors/fatal-error "write failed" {:path "a"} (js/Error. "disk"))]
(t/is (thrown-with-msg? js/Error #"write failed"
(attempt (throw cause))))
(t/is (identical? cause (attempt :catch-fatal (throw cause))))))
(t/deftest attempt-treats-a-fatal-cause-deep-in-the-chain-as-fatal
(let [fatal (errors/fatal-error "write failed" {} nil)
outer (ex-info "outer" {} (ex-info "middle" {} fatal))]
(t/is (true? (errors/fatal? outer)))
(t/is (thrown-with-msg? js/Error #"outer" (attempt (throw outer))))))
(t/deftest fatal-marker-is-not-assumed-from-other-data
(t/is (false? (errors/fatal? (ex-info "x" {:type :anything}))))
(t/is (false? (errors/fatal? nil)))
(t/is (false? (errors/fatal? "text"))))
(t/deftest ^:async attempt-awaits-promises-in-an-async-function
(let [value (attempt (await (js/Promise.resolve 7)))
failure (attempt (await (js/Promise.reject (ex-info "rejected" {}))))
bound (let [x (attempt :catch-fatal (await (js/Promise.resolve 1)) 2)] x)]
(t/is (= 7 value))
(t/is (= "rejected" (ex-message failure)))
(t/is (= 2 bound))))
(t/deftest ^:async attempt-keeps-fatal-rejections-fatal
(let [cause (errors/fatal-error "write failed" {} nil)
outer (try
(attempt (await (js/Promise.reject cause)))
nil
(catch :default thrown thrown))]
(t/is (identical? cause outer))))
(t/deftest with-data-passes-non-failures-through
(t/is (= 1 (errors/with-data 1 {:a 1})))
(t/is (nil? (errors/with-data nil {:a 1})))
(t/is (= {:a 1} (errors/with-data {:a 1} {:a 2}))))
(t/deftest with-data-adds-keys-under-the-failure-data
(let [cause (ex-info "boom" {:log-path "inner"})
result (errors/with-data cause {:log-path "outer" :build-id "b"})]
(t/is (= "boom" (ex-message result)))
(t/is (= {:log-path "inner" :build-id "b"} (ex-data result)))
(t/is (identical? cause (ex-cause result)))))
(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"))))

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

@ -12,6 +12,7 @@
["path" :as path]
[benches.render-wasm.cases :as cases]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.feature-comparison :as feature-comparison]
@ -525,7 +526,7 @@
0)]
(files/atomic-write (:record-path run-home)
(result/encode (result/check-record run)))
(js/Promise.resolve {:run run :home run-home :exit-code exit-code :error nil}))))
(js/Promise.resolve {:run run :home run-home :exit-code exit-code :errors []}))))
(defn- comparison-services
[{:keys [prepare-build collect-catalog execute-run]}]
@ -622,8 +623,8 @@
(let [response (await (execute root home build cases options signal-object))]
(when signal (.abort controller signal))
(assoc response :exit-code 1
:error (js/Error. "executor failure")
:storage-error (js/Error. "recovered write failure"))))})}))
:errors [(js/Error. "executor failure")
(errors/fatal-error "recovered write failure" {} nil)])))})}))
record (saved-comparison outcome)
run (result/decode (fs/readFileSync (get-in record [:configurations 0 :run :record-path]) "utf8"))]
(t/is (= code (:exit-code outcome)))
@ -632,7 +633,7 @@
(t/is (= [:failed :unattempted] (mapv :status (:configurations record))))
(t/is (= "run-evidence" (get-in record [:configurations 0 :failure :phase])))
(t/is (= "recovered write failure" (get-in record [:configurations 0 :failure :message])))
(t/is (= "recovered write failure" (ex-message (:error outcome)))))))
(t/is (= "recovered write failure" (ex-message (first (:errors outcome))))))))
(t/deftest ^:async pre-aborted-comparison-preserves-all-work-as-unattempted
(create-frontend-root)
@ -646,7 +647,6 @@
:execute-run (execute-service {})})}))
record (saved-comparison outcome)]
(t/is (= code (:exit-code outcome)))
(t/is (true? (:interrupted? outcome)))
(t/is (= :interrupted (:status record)))
(t/is (some? (:ended-at record)))
(t/is (every? #(= :unattempted (:status %)) (concat (:configurations record) (:edges record))))
@ -679,7 +679,6 @@
{:services services}))
record (saved-comparison outcome)]
(t/is (= code (:exit-code outcome)))
(t/is (true? (:interrupted? outcome)))
(t/is (= :interrupted (:status record)))
(t/is (= [:failed :unattempted] (mapv :status (:configurations record))))
(t/is (= signal (get-in record [:configurations 0 :reason])))
@ -705,7 +704,8 @@
(t/is (every? #(= :completed (:status %)) (:configurations record)))
(t/is (= [:failed :unattempted :unattempted :unattempted] (mapv :status (:edges record))))
(t/is (= "comparison-storage" (get-in record [:edges 0 :failure :phase])))
(t/is (= (get-in outcome [:home :log-path]) (:tail-log outcome)))))
(t/is (= (get-in outcome [:home :log-path])
(:log-path (ex-data (first (:errors outcome))))))))
(t/deftest ^:async edge-analysis-failures-allow-independent-comparisons-to-complete
(create-frontend-root)
@ -750,7 +750,8 @@
(t/is (= :running (:status record)))
(t/is (= [:running :planned] (mapv :status (:configurations record))))
(t/is (= :completed (get-in run [:termination :reason])))
(t/is (= (get-in outcome [:home :log-path]) (:tail-log outcome)))))
(t/is (= (get-in outcome [:home :log-path])
(:log-path (ex-data (first (:errors outcome))))))))
(t/deftest create-home-creates-only-a-fresh-home
(create-frontend-root)
@ -973,7 +974,6 @@
record (:comparison result)]
(t/is (= 1 @calls))
(t/is (= 130 (:exit-code result)))
(t/is (true? (:interrupted? result)))
(t/is (= :interrupted (:status record)))
(t/is (some? (:ended-at record)))
(t/is (= "SIGINT" (get-in record [:configurations 0 :reason])))
@ -1029,7 +1029,7 @@
record (:comparison result)]
(t/is (= 1 (:exit-code result)))
(t/is (str/ends-with? @stdout "Status failed\n"))
(t/is (some? (:error result)))
(t/is (seq (:errors result)))
(t/is (= :running (:status record)))
(t/is (= :building (get-in record [:configurations 0 :status])))
(t/is (nil? (get-in record [:configurations 0 :build])))
@ -1053,7 +1053,7 @@
(t/is (= 1 (:exit-code response)))
(t/is (= :failed (get-in response [:comparison :configurations 0 :status])))
(t/is (= (get-in response [:home :log-path])
(or (:tail-log response) (:log-path response))))))
(:log-path (ex-data (first (:errors response))))))))
(t/deftest ^:async comparison-storage-error-keeps-its-origin-through-build-preparation
(create-frontend-root)
@ -1073,7 +1073,7 @@
(created selected)))))))}}))]
(t/is (= 1 (:exit-code response)))
(t/is (= (get-in response [:home :log-path])
(or (:tail-log response) (:log-path response))))))
(:log-path (ex-data (first (:errors response))))))))
(t/deftest ^:async pending-real-signals-stop-edge-analysis
(create-frontend-root)

47
frontend/test/performance_tests/render_wasm/outcome_test.cljs Normal file
View File

@ -0,0 +1,47 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns performance-tests.render-wasm.outcome-test
(:require
[benches.render-wasm.node.outcome :as outcome]
[cljs.test :as t :include-macros true]))
(t/deftest failed-reports-the-cause-with-exit-code-1-and-its-log-path
(let [cause (ex-info "boom" {:log-path "build.log"})
result (outcome/failed cause {:home :h})]
(t/is (= [cause] (:errors result)))
(t/is (= 1 (:exit-code result)))
(t/is (= "build.log" (:log-path result)))
(t/is (= :h (:home result)))))
(t/deftest failed-prefers-the-log-path-given-in-data
(let [result (outcome/failed (ex-info "boom" {:log-path "build.log"}) {:log-path "run.log"})]
(t/is (= "run.log" (:log-path result)))))
(t/deftest add-error-appends-and-keeps-interruption-exit-codes
(doseq [[before after] [[0 1] [1 1] [130 130] [143 143]]]
(let [first-cause (js/Error. "first")
second-cause (js/Error. "second")
result (-> {:errors [first-cause] :exit-code before}
(outcome/add-error second-cause))]
(t/is (= [first-cause second-cause] (:errors result)))
(t/is (= after (:exit-code result))))))
(t/deftest publish-returns-the-outcome-when-printing-succeeds
(let [printed (atom nil)
result (outcome/publish {:exit-code 0} #(reset! printed :done))]
(t/is (= :done @printed))
(t/is (= {:exit-code 0} result))))
(t/deftest publish-adds-a-failed-print-to-the-outcome
(let [cause (js/Error. "stream closed")
result (outcome/publish {:exit-code 0} #(throw cause))]
(t/is (= [cause] (:errors result)))
(t/is (= 1 (:exit-code result)))))
(t/deftest interruption-code-maps-signal-names
(t/is (= 143 (outcome/interruption-code "SIGTERM")))
(t/is (= 130 (outcome/interruption-code "SIGINT"))))

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

@ -10,6 +10,7 @@
["os" :as os]
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.errors :as errors]
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.feature-comparison :as feature-comparison]
@ -695,7 +696,7 @@
(t/is (= code (:exit-code result)))
(t/is (= :interrupted (get-in result [:run :termination :reason])))
(t/is (= signal (get-in result [:run :termination :signal])))
(t/is (some? (:error result))))))
(t/is (seq (:errors result))))))
(t/deftest ^:async log-failure-still-closes-pages-browsers-and-hosts
(let [out (output-dir)
@ -714,8 +715,7 @@
(options fake out)))
state @(:state fake)
host (:host state)]
(t/is (some? (:error result)))
(t/is (some? (:storage-error result)))
(t/is (some errors/fatal? (:errors result)))
(t/is (= 1 (:exit-code result)))
(t/is (empty? (attempts-for (:run result) :case/a)))
(t/is (= 1 (:close-pages state)))
@ -746,8 +746,8 @@
result (await (execute fake [(collected :case/a :fresh)] (options fake out)))
run (saved-record result)]
(t/is (= 1 (:exit-code result)))
(t/is (some? (:storage-error result)))
(t/is (str/includes? (ex-message (:error result))
(t/is (some errors/fatal? (:errors result)))
(t/is (str/includes? (ex-message (first (:errors result)))
(if cleanup-fails "cleanup rejected" "cannot append benchmark log")))
(t/is (= :incomplete (get-in run [:termination :reason])))
(t/is (str/includes? (fs/readFileSync file "utf8") "Run incomplete")))))
@ -761,7 +761,7 @@
(t/is (= [:completed] (mapv :outcome (:attempts run))))
(t/is (= :completed (get-in run [:termination :reason])))
(t/is (= :cleanup (get-in run [:termination :failure :stage])))
(t/is (= "cleanup rejected" (ex-message (:error result))))
(t/is (= "cleanup rejected" (ex-message (first (:errors result)))))
(t/is (= 1 (:exit-code result)))))
(t/deftest ^:async interruption-during-shutdown-is-persisted
@ -900,7 +900,7 @@
(t/is (= :running (get-in saved [:termination :reason])))
(t/is (= 1 (count (:attempts saved))))
(t/is (every? zero? (vals (get-in saved [:remaining :case/a]))))
(t/is (some? (:error response)))
(t/is (seq (:errors response)))
(t/is (= 1 (:exit-code response)))
(t/is (= "<!doctype html>"
(fs/readFileSync (path/join dir "index.html") "utf8")))))

4
frontend/test/performance_tests/render_wasm/runner.cljs
View File

@ -18,11 +18,13 @@
[performance-tests.render-wasm.compare-test]
[performance-tests.render-wasm.containers-test]
[performance-tests.render-wasm.contracts-test]
[performance-tests.render-wasm.errors-test]
[performance-tests.render-wasm.feature-comparison-test]
[performance-tests.render-wasm.fingerprint-test]
[performance-tests.render-wasm.geometry-scenes-test]
[performance-tests.render-wasm.lifecycle-test]
[performance-tests.render-wasm.log-test]
[performance-tests.render-wasm.outcome-test]
[performance-tests.render-wasm.process-test]
[performance-tests.render-wasm.protocol-test]
[performance-tests.render-wasm.report-test]
@ -52,11 +54,13 @@
'performance-tests.render-wasm.compare-test
'performance-tests.render-wasm.containers-test
'performance-tests.render-wasm.contracts-test
'performance-tests.render-wasm.errors-test
'performance-tests.render-wasm.feature-comparison-test
'performance-tests.render-wasm.fingerprint-test
'performance-tests.render-wasm.geometry-scenes-test
'performance-tests.render-wasm.lifecycle-test
'performance-tests.render-wasm.log-test
'performance-tests.render-wasm.outcome-test
'performance-tests.render-wasm.process-test
'performance-tests.render-wasm.protocol-test
'performance-tests.render-wasm.report-test