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 27, improve logging and console reporting.

Browse Source 
AI-assisted-by: deepseek-flash, gpt-6.1-sol
This commit is contained in:
Miguel de Benito Delgado 2026-10-29 13:58:32 +01:00
parent 21b1d9fc5e
commit 0ce2d980f3
22 changed files with 1307 additions and 461 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
frontend/performance/benches/render_wasm/feature_plan.cljs
View File

@ -7,8 +7,8 @@
(ns benches.render-wasm.feature-plan
"Requested-feature configurations and comparison edges."
(:require
[benches.render-wasm.node.options :as options]
[clojure.string :as str]))
[benches.render-wasm.node.options :as options]
[clojure.string :as str]))
(def ^:const default-max-features 3)
@ -65,12 +65,12 @@
feature)))
features)}})
gray-values)
edges (into []
(for [bits gray-values
[i feature] (map-indexed vector features)
:let [bit (- n i 1)]
:when (not (bit-test bits bit))]
{:from (slug bits)
:to (slug (bit-set bits bit))
:feature feature}))]
edges (vec
(for [bits gray-values
[i feature] (map-indexed vector features)
:let [bit (- n i 1)]
:when (not (bit-test bits bit))]
{:from (slug bits)
:to (slug (bit-set bits bit))
:feature feature}))]
{:features features :configurations configurations :edges edges})))

11
frontend/performance/benches/render_wasm/fingerprint.cljs
View File

@ -5,10 +5,7 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.fingerprint
"Scene fingerprints identify validated starting snapshots by content.
Canonical production verbose Transit orders unordered representations,
preserves type tags and ordered collections, and hashes UTF-8 bytes.
Callers validate snapshots and compute fingerprints before upload and timers."
"Scene fingerprints to uniquely identify snapshots by their content."
(:require
[benches.render-wasm.codec :as codec]
[goog.crypt :as crypt]
@ -17,7 +14,7 @@
(declare canonicalize)
(defn- canonical-text
"Encodes an already canonical Transit representation as deterministic text."
"Encodes a Transit representation as text."
[value]
(js/JSON.stringify value))
@ -65,14 +62,14 @@
Realizing :objects removes ObjectsMap's serialized shape strings while keeping
production shape, geometry and path tags in the values."
[snapshot]
(-> (assoc snapshot :objects (into {} (:objects snapshot)))
(-> (update snapshot :objects into {})
(codec/encode-str {:type :json-verbose})
(js/JSON.parse)
(canonicalize)
(canonical-text)))
(defn fingerprint
"Returns the SHA-256 algorithm and digest for a validated snapshot."
"Returns the SHA-256 and digest for a validated snapshot."
[snapshot]
(let [hash (goog.crypt.Sha256.)]
(.update hash (crypt/stringToUtf8ByteArray (snapshot-text snapshot)))

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

@ -276,8 +276,8 @@
(conj visited real)))))))))
(defn- purge-feature-comparisons
"Unlinks feature-comparison records, configuration run evidence and edge
reports from the output directory.
"Unlinks feature-comparison records and logs, configuration run evidence and
edge reports from the output directory.
Keeps directories, builds and unrelated files."
[root]
@ -292,6 +292,7 @@
base (path/basename dir)
names (array-seq (fs/readdirSync dir))]
(when (= "feature-comparisons" parent)
(unlink-if-present (path/join dir "feature-comparison.log"))
(unlink-if-present (path/join dir "feature-comparison.transit")))
(when (= "configs" parent)
(unlink-if-present (path/join dir "run.log"))

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

@ -20,6 +20,7 @@
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.catalog :as catalog]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.options :as options]
[benches.render-wasm.node.process :as process]
[clojure.string :as str]))
@ -36,7 +37,7 @@
(if (contains? #{:process-timeout :process-cancelled} (:type (ex-data cause)))
(throw cause)
(do
(.error js/console (str "Git provenance unavailable: " (or (ex-message cause) (str cause))))
(log/warn (str "Git provenance unavailable: " (or (ex-message cause) (str cause))))
{:sha nil :dirty nil})))))
(defn- check-profile-marks
@ -46,11 +47,6 @@
{:type ::profile-marks :compiled compiled})))
compiled)
(defn- output
[build text _stream]
(fs/appendFileSync (:log-path build) text "utf8")
(.write (.-stderr js/process) text))
(defn- ^:async validate-browser
"Imports the release bridge in Node without preparing a renderer.
The bridge's identity method returns the compiled identity over Transit."
@ -83,70 +79,83 @@
:feature-selection selection})
build-ref (atom initial)
phase (atom :storage)]
(try
(when on-created (on-created initial))
(reset! phase :provenance)
(let [git (await (git-provenance root bounds))]
(swap! build-ref #(artifacts/write-manifest % (assoc-in (:manifest %) [:provenance :git] git))))
(reset! phase :renderer)
(let [build @build-ref
facts-path (path/join (:renderer-dir build) "cargo-build.json")
args (cond-> ["frontend" "--offline"]
(not (:default-features? selection)) (conj "--no-default-features")
(seq (:features selection)) (into ["--features" (str/join "," (:features selection))]))]
(await (process/run (merge bounds
{:command (path/resolve root ".." "render-wasm" "build")
:args args :cwd (path/resolve root ".." "render-wasm")
:capture-output? false :on-output #(output build %1 %2)
:env {"PENPOT_WASM_PREPARED" "1" "NODE_ENV" "production"
"BUILD_MODE" "release" "CARGO_NET_OFFLINE" "true"
"VERSION_TAG" (:id build)
"FRONTEND_DEST" (:renderer-dir build)
"FRONTEND_SHARED_DEST" (path/join root "src" "app" "render_wasm" "api" "shared.js")
"RENDER_WASM_SHARED_ARTIFACT" (path/join (:renderer-dir build) "shared.js")
"RENDER_WASM_BUILD_INFO" facts-path}})))
(let [facts (js/JSON.parse (fs/readFileSync facts-path "utf8"))
profile (js->clj (.-profile facts) :keywordize-keys true)
resolved (:features (options/feature-selection {:features (js->clj (.-features facts))
:default-features? (:default-features? selection)}))]
(when-not (and (= "3" (:opt_level profile))
(false? (:debug_assertions profile)))
(throw (ex-info "Cargo did not produce an optimized renderer"
{:type ::renderer-profile :profile profile})))
(swap! build-ref #(artifacts/write-manifest
% (cond-> (-> (:manifest %)
(assoc-in [:functional :features] resolved)
(assoc-in [:functional :default-features?] (boolean (some #{"default"} resolved)))
(assoc-in [:provenance :cargo-profile] profile))
(js/Object.hasOwn facts "environment")
(assoc :environment (js->clj (.-environment facts))))))))
(reset! phase :cljs)
(let [build @build-ref]
(await (process/run (merge bounds
{:command "clojure" :cwd root
:args ["-M:dev:renderer-bench" "release"
"bench-render-wasm-catalog" "bench-render-wasm-browser"]
:capture-output? false :on-output #(output build %1 %2)
:env {"RENDER_BENCH_BUILD_ID" (:id build)
"RENDER_BENCH_CASES_PATH" (:cases-path build)
"RENDER_BENCH_BROWSER_DIR" (:browser-dir build)}})))
(fs/copyFileSync (path/join root "performance" "benches" "render_wasm" "browser" "index.html")
(:index-path build))
(reset! phase :identity)
(check-profile-marks (catalog/build-identity build))
(catalog/collect build {:master-seed 42})
(await (validate-browser build root bounds))
(artifacts/check-files build)
(when (zero? (process/remaining deadline))
(throw (ex-info "preparation deadline expired" {:type :process-timeout})))
(let [ready (artifacts/write-manifest build (assoc (:manifest build) :status :ready))]
(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)}]
(output build (str "\nPreparation failed: " (pr-str failure) "\n") :stderr)
(artifacts/write-manifest build (assoc (:manifest build) :status :failed :failure failure))
(throw (ex-info "renderer build preparation failed"
{:type ::preparation-failed :build-id (:id build)
:phase @phase :log-path (:log-path build)} cause)))))))
(binding [log/*log-path* (:log-path initial)]
(try
(when on-created (on-created initial))
(reset! phase :provenance)
(let [git (await (git-provenance root bounds))]
(swap! build-ref #(artifacts/write-manifest % (assoc-in (:manifest %) [:provenance :git] git))))
(reset! phase :renderer)
(log/info "Renderer compiling")
(let [build @build-ref
facts-path (path/join (:renderer-dir build) "cargo-build.json")
args (cond-> ["frontend" "--offline"]
(not (:default-features? selection)) (conj "--no-default-features")
(seq (:features selection)) (into ["--features" (str/join "," (:features selection))]))]
(await (process/run (merge bounds
{:command (path/resolve root ".." "render-wasm" "build")
:args args :cwd (path/resolve root ".." "render-wasm")
:capture-output? false :on-line (fn [line _] (log/debug line))
:env {"PENPOT_WASM_PREPARED" "1" "NODE_ENV" "production"
"BUILD_MODE" "release" "CARGO_NET_OFFLINE" "true"
"VERSION_TAG" (:id build)
"FRONTEND_DEST" (:renderer-dir build)
"FRONTEND_SHARED_DEST" (path/join root "src" "app" "render_wasm" "api" "shared.js")
"RENDER_WASM_SHARED_ARTIFACT" (path/join (:renderer-dir build) "shared.js")
"RENDER_WASM_BUILD_INFO" facts-path}})))
(let [facts (js/JSON.parse (fs/readFileSync facts-path "utf8"))
profile (js->clj (.-profile facts) :keywordize-keys true)
resolved (:features (options/feature-selection {:features (js->clj (.-features facts))
:default-features? (:default-features? selection)}))]
(when-not (and (= "3" (:opt_level profile))
(false? (:debug_assertions profile)))
(throw (ex-info "Cargo did not produce an optimized renderer"
{:type ::renderer-profile :profile profile})))
(swap! build-ref #(artifacts/write-manifest
% (cond-> (-> (:manifest %)
(assoc-in [:functional :features] resolved)
(assoc-in [:functional :default-features?] (boolean (some #{"default"} resolved)))
(assoc-in [:provenance :cargo-profile] profile))
(js/Object.hasOwn facts "environment")
(assoc :environment (js->clj (.-environment facts))))))))
(reset! phase :cljs)
(log/info "Modules compiling")
(let [build @build-ref]
(await (process/run (merge bounds
{:command "clojure" :cwd root
:args ["-M:dev:renderer-bench" "release"
"bench-render-wasm-catalog" "bench-render-wasm-browser"]
:capture-output? false :on-line (fn [line _] (log/debug line))
:env {"RENDER_BENCH_BUILD_ID" (:id build)
"RENDER_BENCH_CASES_PATH" (:cases-path build)
"RENDER_BENCH_BROWSER_DIR" (:browser-dir build)}})))
(fs/copyFileSync (path/join root "performance" "benches" "render_wasm" "browser" "index.html")
(:index-path build))
(reset! phase :identity)
(log/info "Validating")
(check-profile-marks (catalog/build-identity build))
(catalog/collect build {:master-seed 42})
(await (validate-browser build root bounds))
(artifacts/check-files build)
(when (zero? (process/remaining deadline))
(throw (ex-info "preparation deadline expired" {:type :process-timeout})))
(log/info " ready")
(let [ready (artifacts/write-manifest build (assoc (:manifest build) :status :ready))]
(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))))))))

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

@ -12,17 +12,11 @@
[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.process :as process]
[benches.render-wasm.node.run :as run]))
(enable-console-print!)
(defn- print-error
[cause]
(.error js/console (or (ex-message cause) (str cause)))
(when-let [data (ex-data cause)]
(.error js/console (pr-str data))))
(defn- ^:async run-command
[root options]
(let [controller (js/AbortController.)
@ -36,18 +30,10 @@
(ex-info "run interrupted"
{:type ::interrupted :signal name})))))]
(try
(let [result (await (run/run root options signal
#(.write (.-stderr js/process) %)
#(println %)))]
(when-let [error (:error result)]
(print-error error))
(:exit-code result))
(await (run/run root options signal))
(catch :default cause
(print-error cause)
(case @interrupted
"SIGINT" 130
"SIGTERM" 143
1))
{:error cause :log-path (:log-path (ex-data cause))
:exit-code (case @interrupted "SIGINT" 130 "SIGTERM" 143 1)})
(finally
(remove-signals)))))
@ -61,8 +47,10 @@
:features (or (:features options) [])}
:build-timeout-ms (:build-timeout-ms options)
:signal (.-signal controller)
:on-created #(println (:id %))}))
0
:on-created (fn [build]
(log/result (str "Build " (:id build)))
(log/result (str "Output " (:dir build))))}))
{:exit-code 0}
(finally (remove-signals)))))
(defn- ^:async ab-command
@ -79,29 +67,14 @@
(let [prepared (await (feature-plan/prepare root options signal))]
(if (:dry-run options)
(do
(.write (.-stdout js/process) (feature-plan/format-plan prepared))
0)
(let [result (await (feature-comparison/execute
root prepared signal
{:on-created
(fn [home record]
(println (:comparison-id record))
(println (:dir home)))
:on-progress
#(.write (.-stderr js/process) %)}))]
(when-let [error (:error result)]
(print-error error))
(or (case @interrupted
"SIGINT" 130
"SIGTERM" 143
nil)
(:exit-code result)))))
(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
(print-error cause)
(case @interrupted
"SIGINT" 130
"SIGTERM" 143
1))
{:error cause :log-path (:log-path (ex-data cause))
:exit-code (case @interrupted "SIGINT" 130 "SIGTERM" 143 1)})
(finally
(remove-signals)))))
@ -110,26 +83,39 @@
Each compiled module owns its CLJS values; only the string crosses modules.
Execution errors are printed here before returning a numeric exit code."
[request]
(try
(let [{:keys [command options]} (transit/decode-str request)
root (artifacts/frontend-root)]
(case command
"purge"
(do
(artifacts/purge root (cond (:only-builds options) :builds
(:only-runs options) :runs
(:only-comparisons options) :comparisons
:else :all))
0)
(log/configure {})
(let [outcome
(try
(let [{:keys [command options]} (transit/decode-str request)
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))
"build"
(await (build-command root options))
"run"
(await (run-command root options))
"run"
(await (run-command root options))
"ab"
(await (ab-command root options))))
(catch :default cause
(print-error cause)
1)))
"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)))

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

@ -15,6 +15,7 @@
[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.run :as run]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.report.compare :as compare]
@ -62,10 +63,12 @@
(invalid-home "feature comparison cannot use a directory inside builds" {:path dir}))
(try
(fs/mkdirSync dir #js {:recursive true})
(fs/writeFileSync (path/join dir "feature-comparison.log") "" #js {:encoding "utf8" :flag "wx"})
(catch :default cause
(invalid-home "cannot create feature comparison home"
{:path dir :cause (or (ex-message cause) (str cause))})))
{:dir dir
:log-path (path/join dir "feature-comparison.log")
:record-path (path/join dir record-file)}))
(defn write-record
@ -105,16 +108,23 @@
[cause]
(or (ex-message cause) (str cause)))
(defn- with-log-path
[cause log-path]
(ex-info (message-of cause)
(assoc (data-of cause) :log-path (or (:log-path (data-of cause)) log-path))
cause))
(defn- failure-evidence
[phase cause]
{:phase (name phase)
:message (message-of cause)
:cause (failures/describe-cause cause)})
(cond-> {:phase (name phase)
:message (message-of cause)
:cause (failures/describe-cause cause)}
(:log-path (data-of cause)) (assoc :tail-log (:log-path (data-of cause)))))
(defn- storage-error
[cause]
[cause log-path]
(ex-info "cannot persist feature comparison"
{:type ::storage-error :cause (message-of cause)}
{:type ::storage-error :cause (message-of cause) :log-path log-path}
cause))
(defn- storage-error?
@ -123,7 +133,7 @@
depth 0]
(cond
(nil? cause) false
(= ::storage-error (:type (data-of cause))) true
(contains? #{::storage-error ::log/storage-error} (:type (data-of cause))) true
(>= depth 8) false
:else (recur (ex-cause cause) (inc depth)))))
@ -157,7 +167,7 @@
saved (try
(write-record (:home state) next)
(catch :default cause
(throw (storage-error cause))))]
(throw (storage-error cause (get-in state [:home :log-path])))))]
(reset! (:record-ref state) saved)
(reset! (:saved-ref state) saved)
saved))
@ -179,11 +189,6 @@
:edges (mapv #(assoc % :status :planned) (:edges plan))
:warnings warnings}))
(defn- progress
[state text]
(when-let [on-progress (:on-progress state)]
(on-progress text)))
(defn- fail-config
[state slug phase cause]
(persist state
@ -231,6 +236,8 @@
(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 (data-of error))
:exit-code exit-code
:error error
:interrupted? interrupted?}))
@ -333,6 +340,7 @@
(if-not (and (= selection saved-selection) valid-features?)
(let [cause (ex-info "renderer build manifest disagrees with the planned selection"
{:type ::invalid-build
:log-path (:log-path selected)
:selection selection
:saved-selection saved-selection})]
(fail-config state slug :build cause)
@ -345,7 +353,7 @@
(change-config record slug
#(assoc % :status :ready
:effective-features effective))))
(progress state (str "comparison: configuration " slug " built\n"))
(log/info (str "Configuration " slug " built"))
(let [catalog-result
(try
(let [collected ((:collect-catalog services)
@ -358,7 +366,7 @@
(catch :default cause
(if (storage-error? cause)
(throw cause)
{:error cause})))]
{:error (with-log-path cause (:log-path selected))})))]
(cond
(:error catalog-result)
(if-let [interrupted (signal-name signal)]
@ -380,6 +388,7 @@
(:mismatch catalog-result)
(let [cause (ex-info "build catalog disagrees with the prepared cases"
{:type ::catalog-mismatch
:log-path (:log-path selected)
:configuration slug})]
(fail-config state slug :catalog cause)
{:stop? true
@ -413,17 +422,13 @@
:run {:run-id (:run-id run-home)
:record-path (:record-path run-home)
:log-path (:log-path run-home)}))))
(progress state (str "comparison: configuration " slug " running\n"))
(log/info (str "Configuration " slug " running"))
(let [run-result
(try
(await ((:execute-run services)
root run-home selected cases
(assoc options :build-id (:id selected))
signal
(fn [text] (progress state text))
(fn [id]
(progress state
(str "comparison: run " id " started\n")))))
signal))
(catch :default cause
(if (storage-error? cause)
(throw cause)
@ -444,7 +449,8 @@
:configuration slug})))
nil
(catch :default cause cause)))
run-error (or evidence-error (:error run-result))
run-error (when-let [cause (or evidence-error (:error run-result))]
(with-log-path cause (:log-path run-home)))
interrupted (or (signal-name signal)
(= :interrupted termination))
completed (and (nil? evidence-error)
@ -482,14 +488,14 @@
(if (empty? attempts)
(let [cause (ex-info "configuration run made no attempts"
{:type ::zero-attempts
:log-path (:log-path run-home)
:configuration slug})]
{:stop? true
:reason (str "not attempted after a run with no attempts in configuration "
slug)
:error cause})
(do
(progress state
(str "comparison: configuration " slug " completed\n"))
(log/info (str "Configuration " slug " completed"))
{:stop? false})))
(do
(persist state
@ -506,23 +512,25 @@
(some? evidence-error)
{:stop? true
:reason (str "not attempted after run evidence failure in configuration " slug)
:error evidence-error}
:error run-error}
:else
(if (empty? attempts)
(let [cause (ex-info "configuration run made no attempts"
{:type ::zero-attempts
:log-path (:log-path run-home)
:configuration slug})]
{:stop? true
:reason (str "not attempted after a run with no attempts in configuration "
slug)
:error cause})
(do
(progress state
(str "comparison: configuration " slug " failed\n"))
(log/warn (str "Configuration " slug " failed"))
{:stop? false :error run-error}))))))
(let [cause (ex-info "run executor returned no record"
{:type ::missing-run})]
(let [cause (with-log-path
(or (:error run-result)
(ex-info "run executor returned no record" {:type ::missing-run}))
(:log-path run-home))]
(fail-config state slug :run cause)
{:stop? true
:reason (str "not attempted after run failure in configuration " slug)
@ -552,13 +560,13 @@
:removed (vec (sort (set/difference baseline-set candidate-set)))}))
(defn- save-comparison
[path comparison]
[path comparison log-path]
(let [record (result/check-record comparison)
text (result/encode record)]
(try
(files/atomic-write path text)
(catch :default cause
(throw (storage-error cause))))))
(throw (storage-error cause log-path))))))
(defn- unacknowledged-count
[comparison]
@ -590,7 +598,7 @@
path (path/join (get-in state [:home :dir])
"comparisons"
(str (:from edge) "__" (:to edge) ".transit"))]
(save-comparison path comparison)
(save-comparison path comparison (get-in state [:home :log-path]))
{:path path
:unacknowledged (unacknowledged-count comparison)})
(catch :default cause
@ -606,7 +614,7 @@
(try
(fs/mkdirSync comparisons #js {:recursive true})
(catch :default cause
(throw (storage-error cause))))
(throw (storage-error cause (get-in state [:home :log-path])))))
(let [outcome
(loop [edges (:edges @(:record-ref state))
error error]
@ -631,10 +639,12 @@
(do
(mark-edge state edge :failed
{:failure (failure-evidence :comparison (:error result))})
(recur (rest edges) (:error result)))
(recur (rest edges) (or error (:error result))))
(pos? (:unacknowledged result))
(do
(log/warn (str "Comparison " (:from edge) " -> " (:to edge)
" has " (:unacknowledged result) " unacknowledged differences"))
(mark-edge state edge :failed
{:path (:path result)
:failure {:unacknowledged-differences (:unacknowledged result)}})
@ -682,15 +692,13 @@
"Executes a prepared feature comparison and owns builds, runs and reports.
- prepared: node.feature-plan/prepare output.
- callbacks: accepts :on-created fn(home record), :on-progress fn(string) and
an optional :services map with :prepare-build, :collect-catalog,
- 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."
[root prepared signal callbacks]
(let [callbacks (or callbacks {})
services (merge default-services (:services callbacks))
[root prepared signal settings]
(let [services (merge default-services (:services settings))
comparison-id (str (random-uuid))
home (try
(create-home root comparison-id (:output-dir prepared))
@ -712,21 +720,31 @@
:cases (:cases prepared)
:signal signal
:services services
:on-created (:on-created callbacks)
:on-progress (:on-progress callbacks)
:record-ref record-ref
:saved-ref saved-ref}]
(try
(let [saved (write-record home initial)]
(reset! record-ref saved)
(reset! saved-ref saved))
(when-let [on-created (:on-created state)]
(on-created home @saved-ref))
(let [result (await (run-comparisons state))]
result)
(catch :default cause
{:comparison @saved-ref
:home home
:exit-code 1
:error cause
:interrupted? false}))))))
(binding [log/*log-path* (:log-path home)]
(let [outcome (try
(log/result (str "Comparison " comparison-id))
(log/result (str "Output " (:dir home)))
(let [saved (write-record home initial)]
(reset! record-ref saved)
(reset! saved-ref saved))
(await (run-comparisons state))
(catch :default cause
{:comparison @saved-ref
:home home
:log-path (:log-path home)
:tail-log (:log-path (data-of cause))
:exit-code 1
:error cause
:interrupted? false}))]
(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))))))))))

163
frontend/performance/benches/render_wasm/node/log.cljs Normal file
View File

@ -0,0 +1,163 @@
;; 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.log
"Console output and scoped file logs for the benchmark CLI.
Public API:
(log/configure {:level :info
:color :auto
:stdout stream
:stderr stream})
(log/result text)
(log/info text)
(log/debug text)
(log/warn text)
(log/error {:message ...
:fields [...]
:tail-log ...})
Every output function uses the same private one:
...
└── log/write <-- this guy
├── append text to the bound log file
└── filter and render console output
├── result → stdout
└── diagnostics → stderr
The CLI selects the logging threshold for the console:
- Default: :info
- --quiet: :warn
- --verbose: :debug
But console filtering and file logging are independent:
| Function | Console destination | Console visibility | File log |
|----------|---------------------|---------------------|----------|
| result | stdout | Always | Always |
| info | stderr | Default and verbose | Always |
| debug | stderr | Verbose | Always |
| warn | stderr | Always | Always |
| error | stderr | Always | Always |
So: quiet mode still records detailed diagnostics in files.
Also, the console renderer adds headings, prefixes, and colors."
(:require
["fs" :as fs]
[clojure.string :as str]))
;; Each high-level task binds its own path and awaits its work inside that scope:
;; (binding [log/*log-path* (:log-path home)]
;; (await (execute-task ...)))
;; Returning or throwing from a child restores the parent's destination
(def ^:dynamic *log-path* nil)
(defonce ^:private config (atom nil))
(defn configure
"Configures console level, color mode and output streams."
[options]
(reset! config (merge {:level :info :color :auto
:stdout (.-stdout js/process)
:stderr (.-stderr js/process)}
options)))
(defn- color?
[stream mode]
(case mode
:always true
:never false
(and (.-isTTY ^js stream)
(empty? (.-NO_COLOR (.-env js/process)))
(not= "dumb" (.-TERM (.-env js/process))))))
(defn- paint
[enabled code text]
(if enabled (str "\u001b[" code "m" text "\u001b[0m") text))
(defn- render
[level text color]
(str/join "\n"
(map (fn [line]
(case level
:info (if (re-find #"^\S" line) (paint color "1;36" line) line)
:debug (paint color "2" (str "· " line))
:warn (paint color "33" (str "! " line))
:error (paint color "31" line)
line))
(str/split-lines text))))
(defn- write
[level text]
(when-not @config (configure {}))
(let [{:keys [stdout stderr color] console-level :level} @config
text (str/replace (str text) #"\n$" "")
failure (when *log-path*
(try
(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))))
enabled (case level
:debug (= :debug console-level)
:info (contains? #{:info :debug} console-level)
true)
stream (if (= :result level) stdout stderr)]
(when enabled
(.write ^js stream (str (if (= :result level)
text
(render level text (color? stream color))) "\n")))
(when failure
(if (= :error level)
(.write ^js stderr (str "Could not append log: " *log-path* "\n"))
(throw failure)))))
(defn result [text] (write :result text))
(defn info [text] (write :info text))
(defn debug [text] (write :debug text))
(defn warn [text] (write :warn text))
(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))))
(defn error
"Prints a terminal failure with ordered fields and an optional bounded log tail."
[{:keys [message fields tail-log tail?] :or {tail? true}}]
(let [tail-path (or tail-log *log-path*)
fields (cond-> (vec fields)
(and *log-path* (not (some #(= :log (first %)) fields)))
(conj [:log *log-path*])
(and tail-log (not= tail-log *log-path*))
(conj [:tail-log tail-log]))
width (reduce max 0 (map #(count (name (first %))) fields))
tail (when tail? (get-tail tail-path))]
(write :error
(str "✖ " message
(apply str
(map (fn [[key value]]
(let [label (name key)]
(str "\n " label
(apply str (repeat (+ 2 (- width (count label))) " "))
value)))
fields))
(when (seq tail)
(str "\n tail\n" (str/join "\n" (map #(str " " %) tail))))))))

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

@ -30,3 +30,13 @@
(defn parse-feature-list
[text]
(:features (feature-selection {:features (mapv str/trim (str/split text #"," -1))})))
(defn console-level
"Returns the console level selected by quiet or verbose options."
[opts]
(cond (:quiet opts) :warn (:verbose opts) :debug :else :info))
(defn color-mode
"Returns automatic, forced or disabled console coloring."
[opts]
(case (:color opts) true :always false :never :auto))

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

@ -9,6 +9,7 @@
(:require
["child_process" :as child-process]
["fs" :as fs]
["node:readline" :as readline]
[clojure.string :as str]))
(def default-termination-grace-ms 5000)
@ -128,8 +129,9 @@
deadline is an absolute Date.now() timestamp; signal is an optional
AbortSignal. An expired deadline or aborted signal starts no process.
on-output receives [UTF-8 text :stdout/:stderr] as data arrives. Output is
also collected unless capture-output? is false, in which case both result
on-output receives [UTF-8 text :stdout/:stderr] as data arrives. Optional
on-line receives [line :stdout/:stderr], including a final unterminated line.
Output is also collected unless capture-output? is false; then both result
strings are empty. Returns a promise of
{:exit-code 0 :stdout string :stderr string}.
@ -141,7 +143,7 @@
after a successful root exit. Cleanup sends SIGTERM then, after the grace,
SIGKILL. Settlement waits for live group members to stop. It uses root exit,
not child close, since descendants may inherit and retain the output pipes."
[{:keys [command args cwd env deadline signal termination-grace-ms on-output capture-output?]
[{:keys [command args cwd env deadline signal termination-grace-ms on-output on-line capture-output?]
:or {termination-grace-ms default-termination-grace-ms capture-output? true}
:as options}]
(let [empty-result {:exit-code nil :signal nil :stdout "" :stderr ""}
@ -173,6 +175,7 @@
(let [stdout (volatile! [])
stderr (volatile! [])
output-failure (volatile! nil)
line-readers (volatile! [])
complete (volatile! nil)
timeout (volatile! nil)
abort (fn [_] (@complete (cancelled signal)))
@ -220,6 +223,18 @@
(.on (.-stderr child) "data" #(route stderr :stderr %))
(.on (.-stdout child) "error" #(stream-error :stdout % "Could not read command output"))
(.on (.-stderr child) "error" #(stream-error :stderr % "Could not read command output"))
(when on-line
(doseq [[stream input] [[:stdout (.-stdout child)] [:stderr (.-stderr child)]]]
(let [reader (readline/createInterface
#js {:input input :terminal false :crlfDelay js/Infinity})]
(vswap! line-readers conj reader)
(.on reader "line"
(fn [line]
(try
(on-line line stream)
(catch :default cause
(stream-error stream cause "Command output callback failed")))))
(.on reader "error" #(stream-error stream % "Could not read command output")))))
;; EPIPE is normal when a command exits without reading stdin.
(.on (.-stdin child) "error"
(fn [cause]
@ -251,6 +266,8 @@
(throw (process-error options result failure))
(dissoc result :signal)))))
(finally
(doseq [reader @line-readers]
(.close ^js reader))
(stop-waiting)))))
(finally
(when-let [stream (.-stdin child)]

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

@ -25,6 +25,7 @@
[benches.render-wasm.node.browser :as browser]
[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.process :as process]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.node.server :as server]
@ -74,21 +75,19 @@
[state]
(some? (interruption (:signal state))))
(defn- log
[state text]
(defn- write-log
[state output text]
(try
(runs/append-log! (:home state) text)
(output text)
(catch :default cause
(reset! (:storage-error-ref state) cause)
(throw cause)))
(when-let [progress (:on-progress state)]
(progress text)))
(throw cause))))
(defn- safe-log
(defn- warn-safely
"Appends runner diagnostics without replacing an error already under handling."
[state text]
(try
(log state text)
(write-log state log/warn text)
(catch :default _
nil)))
@ -104,15 +103,18 @@
[state preparation]
(swap! (:run-ref state) result/record-preparation preparation)
(persist state)
(log state (str "run: prepared " (result/case-name (:case-id preparation)) "\n")))
(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)
(persist state)
(log state (str "run: " (if (:warmup? attempt) "warmup" "attempt") " "
(result/case-name (:case-id attempt)) " "
(name (:outcome attempt)) "\n")))
(let [remaining (get-in @(:run-ref state) [:remaining (:case-id attempt)])
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)")))))
(defn- record-failure
[state case-id stage evidence]
@ -123,9 +125,9 @@
(swap! (:run-ref state) update-in [:metadata :diagnostics :failures]
(fnil conj []) failure)
(persist state)
(log state (str "run: " (name stage) " failed"
(when (some? case-id) (str " for " (result/case-name case-id)))
": " (:message failure) "\n"))
(write-log state log/warn (str (name stage) " failed"
(when (some? case-id) (str " for " (result/case-name case-id)))
": " (:message failure) "\n"))
failure))
(defn- record-screenshot-status
@ -161,15 +163,15 @@
(try
(await ((get-in state [:services :screenshot]) page path bounds))
(record-screenshot-status state (:id case) {:file file :status :ok})
(log state (str "run: screenshot " file "\n"))
(write-log state log/debug (str "Screenshot " file))
(catch :default cause
(record-screenshot-status state (:id case)
{:file file :status :failed
:message (message-of cause)
:cause (failures/describe-cause cause)})
(log state (str "run: screenshot failed for "
(result/case-name (:id case)) ": "
(message-of cause) "\n")))))))
(write-log state log/warn (str "Screenshot failed for "
(result/case-name (:id case)) ": "
(message-of cause) "\n")))))))
(defn- case-slots
"Returns each scheduled slot in order: all warmups, then measured slots.
@ -212,7 +214,7 @@
(try
(await ((get-in state [:services :close]) owner))
(catch :default cause
(log state (str "run: browser cleanup failed: " (message-of cause) "\n"))))))
(write-log state log/warn (str "Browser cleanup failed: " (message-of cause)))))))
(defn- ^:async close-current-page
[state]
@ -247,7 +249,7 @@
(reset! (:owner-ref state) owner)
(swap! (:run-ref state) assoc-in [:metadata :environment :browser] (:version owner))
(persist state)
(log state (str "run: browser " (:version owner) "\n"))
(write-log state log/debug (str "Browser " (:version owner)))
owner)))
(defn- ^:async open-page
@ -513,13 +515,15 @@
(when (and (seq cases)
(not @(:abort-run? state))
(not (interrupted? state)))
(let [case (first cases)
outcome (if (= :fresh (:context case))
(await (run-fresh-case state case))
(await (run-reuse-case state case)))]
(when (#{:abort :interrupted} outcome)
(reset! (:abort-run? state) true))
(recur (rest cases))))))))
(let [case (first cases)]
(write-log state log/info (str "▸ Case " (result/case-name (:id case))
" (" (name (:context case)) ")"))
(let [outcome (if (= :fresh (:context case))
(await (run-fresh-case state case))
(await (run-reuse-case state case)))]
(when (#{:abort :interrupted} outcome)
(reset! (:abort-run? state) true))
(recur (rest cases)))))))))
(defn- finish-run
[state]
@ -589,7 +593,7 @@
(catch :default cause cause))
failure (or page-failure browser-failure server-failure)]
(when failure
(safe-log state (str "run: cleanup failed: " (message-of failure) "\n")))
(warn-safely state (str "run: cleanup failed: " (message-of failure) "\n")))
failure))
(defn- remove-build
@ -658,102 +662,102 @@
(defn ^:async execute
"Executes a prepared selection in an allocated home and owns host and browser.
Options are resolved CLI options. root is the frontend checkout. The record
exists before on-created runs, so a browser startup failure still leaves a
valid partial record. Returns {:run schema:run :home home :exit-code n
:error cause-or-nil :storage-error cause-or-nil}. A storage error reports any
Options are resolved CLI options. root is the frontend checkout. 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."
[root home selected-build cases options signal on-progress on-created]
(let [opts (assoc (normalize-options options) :run-id (:run-id home))
run (result/create-run
{:run-id (:run-id opts)
:started-at (now)
:plan {:cases cases
:warmups (:warmups opts)
:repetitions (:repetitions opts)
:timeout-policy {:attempt-ms (:timeout-ms opts)}}
:metadata (metadata root selected-build opts)})
state {:root root
:selected-build selected-build
:cases cases
:opts opts
:signal signal
:on-progress on-progress
:home home
:run-ref (atom run)
:storage-error-ref (atom nil)
:owner-ref (atom nil)
:page-ref (atom nil)
:host-ref (atom nil)
:launch-deadline (atom nil)
:abort-run? (atom false)
:harness-failed? (atom false)
:services (merge browser/service (:browser opts))}]
(persist state)
(when on-created (on-created (:run-id opts)))
(let [error (atom nil)]
(try
(await (run-session state))
(catch :default cause
(reset! error cause)
(when-not (interrupted? state)
(try
(record-failure state nil :runner (cause-evidence cause :runner))
(catch :default record-cause
(safe-log state (str "run: could not record failure: "
(message-of record-cause) "\n")))))))
(when-let [cleanup-error (await (cleanup state))]
(reset! error cleanup-error)
[root home selected-build cases options signal]
(binding [log/*log-path* (:log-path home)]
(let [opts (assoc (normalize-options options) :run-id (:run-id home))
run (result/create-run
{:run-id (:run-id opts)
:started-at (now)
:plan {:cases cases
:warmups (:warmups opts)
:repetitions (:repetitions opts)
:timeout-policy {:attempt-ms (:timeout-ms opts)}}
:metadata (metadata root selected-build opts)})
state {:root root
:selected-build selected-build
:cases cases
:opts opts
:signal signal
:home home
:run-ref (atom run)
:storage-error-ref (atom nil)
:owner-ref (atom nil)
:page-ref (atom nil)
:host-ref (atom nil)
:launch-deadline (atom nil)
:abort-run? (atom false)
:harness-failed? (atom false)
:services (merge browser/service (:browser opts))}]
(persist state)
(let [error (atom nil)]
(try
(record-failure state nil :cleanup
(cause-evidence cleanup-error :cleanup))
(catch :default record-cause
(safe-log state (str "run: could not record cleanup failure: "
(message-of record-cause) "\n")))))
(let [saved-run (try
(finish-run state)
(catch :default cause
(reset! error cause)
nil))
run (or saved-run @(:run-ref state))
removal-error (when (and (:remove? opts) saved-run)
(try
(remove-build root selected-build)
(await (run-session state))
(catch :default cause
(reset! error cause)
(when-not (interrupted? state)
(try
(record-failure state nil :runner (cause-evidence cause :runner))
(catch :default record-cause
(warn-safely state (str "Could not record failure: "
(message-of record-cause) "\n")))))))
(when-let [cleanup-error (await (cleanup state))]
(reset! error cleanup-error)
(try
(record-failure state nil :cleanup
(cause-evidence cleanup-error :cleanup))
(catch :default record-cause
(warn-safely state (str "Could not record cleanup failure: "
(message-of record-cause) "\n")))))
(let [saved-run (try
(finish-run state)
(catch :default cause
(reset! error cause)
nil))
run (or saved-run @(:run-ref state))
removal-error (when (and (:remove? opts) saved-run)
(try
(remove-build root selected-build)
nil
(catch :default cause cause)))
report-result (try
{:report (format/format-run (summary/summarize run))}
(catch :default cause
(warn-safely state (str "Report failed: "
(message-of cause) "\n"))
{:error cause}))
log-error (try
(write-log state log/debug
(str "Run " (name (get-in run [:termination :reason]))))
nil
(catch :default cause cause)))
report-error (try
(log state (str "\n"
(format/format-run (summary/summarize run))
"\n"))
nil
(catch :default cause
(safe-log state (str "run: report failed: "
(message-of cause) "\n"))
cause))]
(when removal-error
(reset! error removal-error))
(when report-error
(reset! error report-error))
(let [reason (get-in run [:termination :reason])
signal-exit (if (= "SIGTERM" (get-in run [:termination :signal]))
143 130)
base (cond
(= :completed reason) 0
(= :interrupted reason) signal-exit
:else 1)
exit (if (= :interrupted reason)
base
(if (or @error
@(:storage-error-ref state)
(and (= :completed reason)
@(:harness-failed? state)))
1
base))]
{:run run
:home home
:exit-code exit
:error @error
:storage-error @(:storage-error-ref state)})))))
(catch :default cause cause))]
(when-let [cause (or removal-error (:error report-result) log-error)]
(compare-and-set! error nil cause))
(let [reason (get-in run [:termination :reason])
signal-exit (if (= "SIGTERM" (get-in run [:termination :signal]))
143 130)
base (cond
(= :completed reason) 0
(= :interrupted reason) signal-exit
:else 1)
exit (if (= :interrupted reason)
base
(if (or @error
@(:storage-error-ref state)
(and (= :completed reason)
@(:harness-failed? state)))
1
base))]
{:run run
:home home
:log-path (:log-path home)
:report (:report report-result)
:exit-code exit
:error @error
:storage-error @(:storage-error-ref state)}))))))
(defn ^:async run
"Prepares or loads a build, collects matching cases and executes one run.
@ -761,38 +765,47 @@
The output home is reserved before build work so filesystem errors fail fast.
A build or catalog failure leaves the home without a run record and rethrows
with build facts."
[root options signal on-progress on-created]
[root options signal]
(let [opts (normalize-options options)
home (runs/create-home {:root root :run-id (str (random-uuid))
:output-dir (:output-dir opts) :remove (:remove? opts)})]
(try
(let [selected-build
(if-let [id (:build-id opts)]
(do
(when on-progress (on-progress (str "run: using build " id "\n")))
(artifacts/load-build root id))
(await (build/prepare
{:root root
:features {:default-features? (:default-features opts true)
:features (or (:features opts) [])}
:build-timeout-ms (:build-timeout-ms opts)
:signal signal
:on-created #(when on-progress
(on-progress (str "run: build " (:id %) "\n")))})))
cases (try
(catalog/collect selected-build
{:master-seed (:seed opts)
:filter (:filter opts)})
(catch :default cause
(throw (ex-info (message-of cause)
(assoc (ex-data cause)
:build-id (:id selected-build)
:log-path (:log-path selected-build))
cause))))]
(await (execute root home selected-build cases opts signal on-progress on-created)))
(catch :default cause
(when on-progress
(on-progress (str "run: " (message-of cause) "\n"))
(when-let [data (ex-data cause)]
(on-progress (str (pr-str data) "\n"))))
(throw cause)))))
(binding [log/*log-path* (:log-path home)]
(try
(log/result (str "Run " (:run-id home)))
(log/result (str "Output " (:dir home)))
(let [selected-build
(if-let [id (:build-id opts)]
(artifacts/load-build root id)
(await (build/prepare
{:root root
:features {:default-features? (:default-features opts true)
:features (or (:features opts) [])}
:build-timeout-ms (:build-timeout-ms opts)
:signal signal})))
cases (try
(catalog/collect selected-build
{:master-seed (:seed opts)
:filter (:filter opts)})
(catch :default cause
(throw (ex-info (message-of cause)
(assoc (ex-data cause)
:build-id (:id selected-build)
:log-path (:log-path selected-build))
cause))))]
(log/info (str " build " (:id selected-build)))
(log/info (str " selected " (count cases) " cases"))
(let [outcome (await (execute root home selected-build cases opts signal))]
(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))))))
(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)))))))

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

@ -11,12 +11,11 @@
[app.common.transit :as transit]
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.compare :as compare]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.options :as options]
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]))
(enable-console-print!)
(def ^:private max-timeout-ms 2147483647)
(def ^:private positive-timeout
@ -47,6 +46,9 @@
(def cli-options
[["-h" "--help" "Print this help"]
["-q" "--quiet" "Only warnings, errors and results"]
["-v" "--verbose" "Show debug details and raw build output"]
[nil "--[no-]color" "Colorize terminal output; default auto" :default nil]
[nil "--[no-]default-features" "Enable Cargo defaults" :default true]
[nil "--features FEATURES" "Comma-separated functional Cargo features"
:parse-fn options/parse-feature-list]
@ -95,10 +97,13 @@
" runner compare BASELINE CANDIDATE [--cases A,B]\n"
" [--allow-build-differences] [--allow-scene-differences]\n"
" [--allow-all-differences]\n\n"
"build prints one attempt ID after storage initialization. Exit 0 means\n"
"build prints Build <id> and Output <absolute path> on stdout. Exit 0 means\n"
"ready; errors retain the build.transit and build.log for that ID.\n"
"run prints one run ID on stdout. Progress, failures and the summary go\n"
"to stderr. Builds and managed runs live under target/performance/render-wasm.\n"
"run prints Run <id>, Output <absolute path> and Report on stdout.\n"
"Progress and diagnostics go to stderr. -q/--quiet hides progress;\n"
"-v/--verbose includes raw build output. --[no-]color overrides terminal\n"
"color detection. File logs receive all levels without logger colors.\n"
"Builds and managed runs live under target/performance/render-wasm.\n"
"compare reads saved schema:run records and starts no build, host or browser.\n"
"Build and scene permissions combine; operation and runtime checks stay strict.\n"
"All-differences permits every compatibility difference. Reports retain them.\n\n"
@ -109,7 +114,8 @@
"output creation, compilation or browser startup. ab accepts run budgets,\n"
"timeouts, seed, filter, output and screenshots, plus comparison permissions.\n"
"It rejects --build, --remove, --cases and --[no-]default-features.\n"
"ab prints the comparison UUID and output path on stdout; progress and\n"
"ab prints Comparison <id>, Output <path> and Status <status> on stdout;\n"
"feature-comparison.log records comparison progress. Diagnostics and\n"
"failures go to stderr. --dry-run prints only the plan without creating\n"
"the comparison home. Managed output lives under\n"
"feature-comparisons/<ab-id>/feature-comparison.transit.\n\n"
@ -239,6 +245,8 @@
flags (supplied-flags args)]
(when (seq errors)
(invalid-args (str/join "\n" errors)))
(when (and (:quiet options) (:verbose options))
(invalid-args "--quiet and --verbose are mutually exclusive"))
(when-not (:help options)
(when-not (and (= 1 (count (take 1 arguments)))
(contains? #{"build" "purge" "run" "ab" "compare"} command))
@ -262,25 +270,22 @@
:options (cond-> options (= command "ab") (assoc :default-features false))
:summary summary}))
(defn- print-error
[cause]
(.error js/console (or (ex-message cause) (str cause)))
(when-let [data (ex-data cause)]
(.error js/console (pr-str data))))
(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)
(println (usage summary))
(log/result (usage summary))
(= command "compare")
(println (:text (compare/execute (second arguments) (nth arguments 2)
(select-keys options [:cases :allow-build-differences
:allow-scene-differences
:allow-all-differences]))))
(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"))]
@ -288,7 +293,12 @@
(await (.execute commands
(transit/encode-str (select-keys request [:command :options]))))))))
(catch :default cause
(print-error cause)
(when (= ::invalid-args (:type (ex-data cause)))
(.error js/console "Try --help for usage."))
(let [data (ex-data cause)]
(log/error {:message (str (or (ex-message cause) (str cause))
"\nTry --help for usage.")
:fields (into (filterv (comp some? second)
[[:type (:type data)] [:baseline (:baseline data)]
[:candidate (:candidate data)]])
(map #(vector :difference (:field %)) (:mismatches data)))
:tail? false}))
(set! (.-exitCode js/process) 1))))

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

@ -73,11 +73,6 @@
[home run]
(files/atomic-write (:record-path home) (result/encode run)))
(defn append-log!
"Appends runner diagnostics to the run log. Callers keep lines terminated."
[home text]
(fs/appendFileSync (:log-path home) (str text) "utf8"))
(defn screenshot-file
"Returns the relative PNG filename for a case, replacing path separators."
[case-id]

3
frontend/test/performance_tests/render_wasm/artifacts_test.cljs
View File

@ -356,7 +356,8 @@
edge-dir (path/join ab-dir "comparisons")
run-dir (path/join managed "runs" "saved")
outside (path/join root "unmanaged" "feature-comparison.transit")
outputs [["feature-comparison.transit" ab-dir]
outputs [["feature-comparison.log" ab-dir]
["feature-comparison.transit" ab-dir]
["run.log" config-dir]
["run.transit" config-dir]
["shot.PNG" config-dir]

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

@ -212,14 +212,14 @@
(:id initial) (:id at-renderer)))
(t/is (= :building (:status initial) (:status at-renderer)))
(t/is (false? (:renderer-started? created)))
(t/is (= "" (:log created) (:log observation)))
(t/is (= "" (:log created)))
(t/is (str/includes? (:log observation) "Renderer compiling\n"))
(t/is (= :failed (:status manifest)))
(t/is (= :renderer (get-in manifest [:failure :phase])))
(t/is (= :process-exit (get-in manifest [:failure :cause 0 :type])))
(t/is (= {:sha nil :dirty nil} (get-in manifest [:provenance :git])))
(t/is (str/includes? log "compiler stdout before failure\n"))
(t/is (str/includes? log "compiler stderr before failure\n"))
(t/is (str/includes? log "Preparation failed:"))
(t/is (= "partial renderer output\n"
(fs/readFileSync (path/join (:renderer-dir retained) "partial.js") "utf8"))))))
done)))
@ -247,7 +247,6 @@
(t/is (= "held" (fs/readFileSync (path/join (:renderer-dir retained) "lock-acquired.txt") "utf8")))
(t/is (str/includes? log "compiler lock acquired\n"))
(t/is (str/includes? log "waiting in compiler\n"))
(t/is (str/includes? log "Preparation failed:"))
;; The retry must acquire the same flock before its compiler can exit.
(install-renderer failing-compiler)
(let [retry-cause (await (rejected (build/prepare {:root (frontend-root)

375
frontend/test/performance_tests/render_wasm/cli_integration.cjs
View File

@ -14,7 +14,9 @@
// The normal unit test build does not build this CLI.
const assert = require("node:assert/strict");
const { execFile } = require("node:child_process");
const { execFile, spawn } = require("node:child_process");
const { once } = require("node:events");
const { setTimeout: pause } = require("node:timers/promises");
const { randomUUID } = require("node:crypto");
const fs = require("node:fs");
const os = require("node:os");
@ -188,6 +190,10 @@ function seedComparisons(fixture) {
path.join(directory, "feature-comparison.transit"),
"comparison\n",
);
fs.writeFileSync(
path.join(directory, "feature-comparison.log"),
"progress\n",
);
fs.writeFileSync(path.join(directory, "keep.txt"), "keep\n");
for (const file of ["run.transit", "run.log", "case-load.PNG"]) {
fs.writeFileSync(path.join(config, file), "configuration output\n");
@ -230,6 +236,76 @@ function installCargoMetadata(fixture, definitions) {
return cargo;
}
function installPreparedCompiler(fixture, breakLog) {
const k = transit.keyword;
const m = (pairs) => transit.map(pairs);
const marker = "RENDER_FIXTURE_BUILD_ID";
const identity = transit
.writer("json")
.write(m([k("build-id"), marker, k("cljs-profile-marks"), false]));
const descriptor = m([
k("id"),
k("fixture/load"),
k("scene"),
k("fixture"),
k("scene-description"),
"fixture",
k("scene-seed"),
42,
k("params"),
m([]),
k("view"),
m([k("scale"), 1, k("x"), 0, k("y"), 0]),
k("context"),
k("fresh"),
k("completion"),
k("render-full"),
k("batch-size"),
1,
k("preparation"),
m([]),
]);
const catalog = transit
.writer("json")
.write(m([k("build-id"), marker, k("cases"), [descriptor]]));
const frontend = path.resolve(fixture.managed, "../../..");
const host = path.join(
frontend,
"performance",
"benches",
"render_wasm",
"browser",
);
const bin = path.join(fixture.rendererRoot, "fixture-bin");
fs.mkdirSync(host, { recursive: true });
fs.mkdirSync(bin);
fs.writeFileSync(path.join(host, "index.html"), "<html></html>");
fs.writeFileSync(
fixture.compiler,
`#!/usr/bin/env node
const fs = require('node:fs'); const path = require('node:path');
fs.writeFileSync(process.env.RENDER_WASM_BUILD_INFO, JSON.stringify({features: ['default'], profile: {opt_level: '3', debug_assertions: false}}));
for (const file of ['render-wasm.js', 'render-wasm.wasm', 'shared.js']) fs.writeFileSync(path.join(process.env.FRONTEND_DEST, file), 'fixture');
`,
{ mode: 0o755 },
);
fs.writeFileSync(
path.join(bin, "clojure"),
`#!/usr/bin/env node
const fs = require('node:fs'); const path = require('node:path');
const id = process.env.RENDER_BENCH_BUILD_ID;
const identity = ${JSON.stringify(identity)}.replaceAll(${JSON.stringify(marker)}, id);
const catalog = ${JSON.stringify(catalog)}.replaceAll(${JSON.stringify(marker)}, id);
fs.writeFileSync(process.env.RENDER_BENCH_CASES_PATH, 'module.exports = {buildIdentity() {return ' + JSON.stringify(identity) + ';}, collectCases() {return ' + JSON.stringify(catalog) + ';}};');
const log = path.join(path.dirname(process.env.RENDER_BENCH_CASES_PATH), 'build.log');
const sabotage = ${breakLog ? "'fs.unlinkSync(' + JSON.stringify(log) + '); fs.mkdirSync(' + JSON.stringify(log) + ');'" : "''"};
fs.writeFileSync(path.join(process.env.RENDER_BENCH_BROWSER_DIR, 'browser.js'), 'const fs = require("node:fs"); module.exports = {buildIdentity() {' + sabotage + 'return ' + JSON.stringify(identity) + ';}};');
`,
{ mode: 0o755 },
);
fixture.env.PATH = `${bin}${path.delimiter}${process.env.PATH}`;
}
function runFixtureText({
runId,
caseId,
@ -407,7 +483,7 @@ process.exitCode = 23;
`;
test(
"build retains failure evidence and prints only its UUID",
"build prints its allocation and one failure block with retained compiler evidence",
testOptions,
async (t) => {
const fixture = createFrontend(t);
@ -416,12 +492,16 @@ test(
const args = ["build", "--build-timeout-ms", "10000"];
const result = await runCli(fixture, args);
assert.equal(result.exitCode, 1);
const id = result.stdout.trim();
const [buildLine] = result.stdout.trim().split("\n");
const id = buildLine.slice("Build ".length);
assert.match(
id,
/^[0-9a-f]{8}-[0-9a-f]{4}-4[0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$/i,
);
assert.equal(result.stdout, `${id}\n`);
assert.equal(
result.stdout,
`Build ${id}\nOutput ${path.join(fixture.builds, id)}\n`,
);
assert.deepEqual(fs.readdirSync(fixture.builds), [id]);
const directory = path.join(fixture.builds, id);
@ -450,16 +530,280 @@ test(
for (const output of [log, result.stderr]) {
assert.ok(output.includes("compiler stdout before failure\n"));
assert.ok(output.includes("compiler stderr before failure\n"));
assert.ok(output.includes("Preparation failed:"));
}
assert.match(result.stderr, /renderer build preparation failed/);
assert.match(
result.stderr,
/:type :benches.render-wasm.node.build\/preparation-failed/,
/type\s+:benches.render-wasm.node.build\/preparation-failed/,
);
assert.ok(result.stderr.includes(`:build-id "${id}"`));
assert.ok(result.stderr.includes(`:log-path ${JSON.stringify(logPath)}`));
assert.match(result.stderr, /:phase :renderer/);
assert.match(result.stderr, new RegExp(`build\\s+${id}`));
assert.ok(result.stderr.includes(logPath));
assert.match(result.stderr, /phase\s+:renderer/);
assert.equal(result.stderr.split("✖ ").length - 1, 1);
assert.doesNotMatch(result.stderr, /^compiler (stdout|stderr)/m);
assert.match(log, /✖ renderer build preparation failed/);
},
);
test(
"build failure diagnostics retain semantic and storage causes",
testOptions,
async (t) => {
for (const [source, reason, broken] of [
[
`#!/usr/bin/env node
const fs = require('node:fs');
fs.writeFileSync(process.env.RENDER_WASM_BUILD_INFO, JSON.stringify({features: [], profile: {opt_level: '0', debug_assertions: false}}));
`,
/Cargo did not produce an optimized renderer/,
],
[
failingCompiler +
"\nfs.unlinkSync(require('node:path').join(require('node:path').dirname(process.env.FRONTEND_DEST), 'build.transit'));\n",
/Command exited unsuccessfully/,
"manifest",
],
[
`#!/usr/bin/env node
const fs = require('node:fs');
const path = require('node:path');
const log = path.join(path.dirname(process.env.FRONTEND_DEST), 'build.log');
fs.unlinkSync(log); fs.mkdirSync(log);
process.stdout.write('compiler output\\n');
`,
/cannot append benchmark log/,
"log",
],
]) {
const fixture = createFrontend(t);
fs.writeFileSync(fixture.compiler, source, { mode: 0o755 });
const result = await runCli(fixture, ["build"]);
const [id] = fs.readdirSync(fixture.builds);
assert.equal(result.exitCode, 1);
assert.match(result.stderr, /✖ renderer build preparation failed/);
assert.match(result.stderr, reason);
assert.ok(result.stderr.includes(id));
assert.ok(
result.stderr.includes(path.join(fixture.builds, id, "build.log")),
);
if (broken !== "log") {
const log = fs.readFileSync(
path.join(fixture.builds, id, "build.log"),
"utf8",
);
assert.match(log, /✖ renderer build preparation failed/);
assert.match(log, reason);
}
if (broken === "manifest") {
assert.match(result.stderr, /manifest-error\s+.*ENOENT/);
} else {
const manifest = readManifest(
path.join(fixture.builds, id, "build.transit"),
);
assert.equal(
manifest.get(transit.keyword("status")).toString(),
":failed",
);
}
}
},
);
test(
"build completion retains a usable ready build or the original log failure",
testOptions,
async (t) => {
for (const breakLog of [false, true]) {
const fixture = createFrontend(t);
installPreparedCompiler(fixture, breakLog);
const result = await runCli(fixture, ["build"]);
const [id] = fs.readdirSync(fixture.builds);
const manifest = readManifest(
path.join(fixture.builds, id, "build.transit"),
);
assert.equal(result.exitCode, breakLog ? 1 : 0, result.stderr);
assert.equal(
manifest.get(transit.keyword("status")).toString(),
breakLog ? ":failed" : ":ready",
);
if (breakLog) {
assert.match(result.stderr, /cannot append benchmark log/);
assert.ok(
result.stderr.includes(path.join(fixture.builds, id, "build.log")),
);
} else {
assert.match(result.stderr, /ready/);
}
}
},
);
test(
"output flags control progress, raw output and console colors",
testOptions,
async (t) => {
for (const [flags, phases, raw, colors] of [
[[], true, false, false],
[["--verbose"], true, true, false],
[["--quiet"], false, false, false],
[["--color"], true, false, true],
[["--no-color"], true, false, false],
]) {
const fixture = createFrontend(t);
fs.writeFileSync(fixture.compiler, failingCompiler, { mode: 0o755 });
const result = await runCli(fixture, ["build", ...flags]);
assert.equal(result.exitCode, 1, result.stderr);
assert.match(result.stdout, /^Build [^\n]+\nOutput \/[^\n]+\n$/);
assert.equal(
/^(?:\u001b\[[0-9;]*m)?Renderer compiling/m.test(result.stderr),
phases,
);
assert.equal(
result.stderr.includes("· compiler stdout before failure"),
raw,
);
assert.equal(result.stderr.includes("\u001b["), colors);
assert.match(result.stderr, /! Git provenance unavailable:/);
const [id] = fs.readdirSync(fixture.builds);
const log = fs.readFileSync(
path.join(fixture.builds, id, "build.log"),
"utf8",
);
assert.match(log, /^compiler stdout before failure$/m);
assert.match(log, /^Renderer compiling$/m);
assert.doesNotMatch(log, /\u001b\[/);
}
},
);
test(
"ab retains its log and names the nested build tail on failure",
testOptions,
async (t) => {
const fixture = createFrontend(t);
installCargoMetadata(fixture, { default: [], a: [] });
fs.writeFileSync(fixture.compiler, failingCompiler, { mode: 0o755 });
const result = await runCli(fixture, [
"ab",
"--features",
"a",
"--filter",
"rects/load",
]);
assert.equal(result.exitCode, 1, result.stderr);
const [idLine, outputLine, statusLine] = result.stdout.trim().split("\n");
assert.match(idLine, /^Comparison [0-9a-f-]+$/);
const directory = outputLine.slice("Output ".length);
assert.equal(statusLine, "Status failed");
const logPath = path.join(directory, "feature-comparison.log");
assert.equal(result.stderr.split("✖ ").length - 1, 1);
assert.ok(result.stderr.includes(logPath));
assert.match(result.stderr, /tail-log\s+.*build\.log/);
assert.match(
fs.readFileSync(logPath, "utf8"),
/compiler stderr before failure/,
);
await runCli(fixture, ["purge", "--only-comparisons"]);
assert.equal(fs.existsSync(logPath), false);
},
);
test(
"ab prints status once and preserves the build failure when its log becomes unwritable",
testOptions,
async (t) => {
const fixture = createFrontend(t);
installCargoMetadata(fixture, { default: [], a: [] });
const output = path.join(fixture.managed, "comparison-output");
fixture.env.COMPARISON_LOG = path.join(output, "feature-comparison.log");
fs.writeFileSync(
fixture.compiler,
failingCompiler +
"\nfs.unlinkSync(process.env.COMPARISON_LOG); fs.mkdirSync(process.env.COMPARISON_LOG);\n",
{ mode: 0o755 },
);
const result = await runCli(fixture, [
"ab",
"--features",
"a",
"--filter",
"rects/load",
"--output-dir",
output,
]);
assert.equal(result.exitCode, 1);
assert.equal(result.stdout.split("Status failed\n").length - 1, 1);
assert.match(result.stderr, /✖ renderer build preparation failed/);
},
);
test(
"run and ab retain signal exit codes during preparation",
testOptions,
async (t) => {
for (const command of ["run", "ab"]) {
for (const [signal, code] of [
["SIGINT", 130],
["SIGTERM", 143],
]) {
const fixture = createFrontend(t);
installCargoMetadata(fixture, { default: [], a: [] });
const marker = path.join(fixture.managed, "compiler-started");
fs.writeFileSync(
fixture.compiler,
`#!/usr/bin/env node\nconst fs = require('node:fs'); fs.writeFileSync(${JSON.stringify(marker)}, 'ready'); setInterval(() => {}, 1000);\n`,
{ mode: 0o755 },
);
const args =
command === "ab"
? ["ab", "--features", "a", "--filter", "rects/load"]
: ["run"];
const child = spawn(process.execPath, [fixture.runner, ...args], {
cwd: os.tmpdir(),
env: { ...process.env, ...fixture.env },
stdio: ["ignore", "pipe", "pipe"],
});
t.after(() => {
if (child.exitCode === null) child.kill("SIGKILL");
});
const exited = once(child, "exit");
let stderr = "";
child.stdout.resume();
child.stderr.on("data", (chunk) => {
stderr += chunk;
});
const deadline = Date.now() + 10000;
while (
!fs.existsSync(marker) &&
child.exitCode === null &&
Date.now() < deadline
)
await pause(10);
assert.ok(fs.existsSync(marker), stderr);
child.kill(signal);
assert.deepEqual(await exited, [code, null], stderr);
}
}
},
);
test(
"run records an early retained-build failure in its allocated log",
testOptions,
async (t) => {
const fixture = createFrontend(t);
const output = path.join(fixture.managed, "early-run");
const result = await runCli(fixture, [
"run",
"--build",
"missing",
"--output-dir",
output,
]);
assert.equal(result.exitCode, 1);
const logPath = path.join(output, "run.log");
assert.ok(result.stderr.includes(logPath));
assert.match(fs.readFileSync(logPath, "utf8"), /✖ /);
},
);
@ -584,6 +928,7 @@ test("purge deletes only the selected artifacts", testOptions, async (t) => {
const [comparisonId] = fs.readdirSync(fixture.comparisons);
const comparison = path.join(fixture.comparisons, comparisonId);
for (const file of [
"feature-comparison.log",
"feature-comparison.transit",
"configs/00/run.transit",
"configs/00/run.log",
@ -664,7 +1009,10 @@ process.exit(23);
const result = await runCli(fixture, ["run", "--output-dir", output]);
assert.equal(result.exitCode, 1);
assert.equal(result.stdout, "");
assert.match(
result.stdout,
new RegExp(`^Run [0-9a-f-]+\\nOutput ${output}\\n$`),
);
assert.equal(fs.readFileSync(marker, "utf8"), "reserved");
assert.equal(fs.existsSync(path.join(output, "run.transit")), false);
},
@ -755,7 +1103,7 @@ test(
assert.equal(result.stdout, "");
assert.match(
result.stderr,
/:type :benches.render-wasm.node.runner\/invalid-args/,
/type\s+:benches.render-wasm.node.runner\/invalid-args/,
);
assert.deepEqual(tree(fixture.managed), original, args.join(" "));
}
@ -924,6 +1272,9 @@ test(
assert.match(result.stdout, /--allow-build-differences/);
assert.match(result.stdout, /--allow-scene-differences/);
assert.match(result.stdout, /--allow-all-differences/);
assert.match(result.stdout, /-q, --quiet/);
assert.match(result.stdout, /-v, --verbose/);
assert.match(result.stdout, /--\[no-\]color/);
assert.doesNotMatch(result.stdout, /--force/);
assert.deepEqual(tree(fixture.managed), original);
},
@ -1144,7 +1495,7 @@ test(
]);
assert.equal(rejected.exitCode, 1);
assert.match(rejected.stderr, /incompatible saved runs/);
assert.ok(rejected.stderr.includes(`:field :${field}`));
assert.match(rejected.stderr, new RegExp(`difference\\s+:${field}`));
const allowed = await runCli(fixture, [
"compare",

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

@ -13,9 +13,11 @@
[benches.render-wasm.cases :as cases]
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.feature-comparison :as feature-comparison]
[benches.render-wasm.node.feature-plan :as node-plan]
[benches.render-wasm.node.files :as files]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.process :as process]
[benches.render-wasm.result :as result]
[cljs.test :as t :include-macros true]
@ -26,7 +28,9 @@
(t/use-fixtures :each
{:before #(reset! temporary-root (fs/mkdtempSync (path/join (os/tmpdir) "penpot-feature-plan-")))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
:after (fn []
(log/configure {})
(fs/rmSync @temporary-root #js {:recursive true :force true}))})
(defn- frontend-root [] (path/join @temporary-root "frontend"))
(defn- renderer-root [] (path/join @temporary-root "render-wasm"))
@ -510,8 +514,7 @@
(defn- execute-service
[spec-or-fn]
(fn [_ run-home selected-build cases options _signal _on-progress on-created]
(when on-created (on-created (:run-id run-home)))
(fn [_ run-home selected-build cases options _signal]
(let [spec (if (fn? spec-or-fn) (spec-or-fn selected-build) spec-or-fn)
run (fake-run-record selected-build run-home cases options spec)
exit-code (case (:kind spec)
@ -554,7 +557,6 @@
(let [prepared (comparison-prepared ["a"] {})
record (path/join (:output-dir prepared) "feature-comparison.transit")
observed (atom nil)
created (atom nil)
services (comparison-services
{:prepare-build (build-service
{:inspect (fn [_]
@ -564,11 +566,8 @@
:execute-run (execute-service {})})
result (await (feature-comparison/execute
(frontend-root) prepared nil
{:services services
:on-created (fn [home saved] (reset! created [home saved]))}))]
(t/is (= :running (get-in @created [1 :status])))
(t/is (every? #(= :planned (:status %)) (get-in @created [1 :configurations])))
(t/is (= (:dir (first @created)) (:dir (:home result))))
{:services services}))]
(t/is (fs/existsSync (get-in result [:home :log-path])))
(t/is (= :running (:status @observed)))
(t/is (= :building (get-in @observed [:configurations 0 :status])))
(t/is (nil? (get-in @observed [:configurations 0 :build])))
@ -581,14 +580,30 @@
result (await (feature-comparison/execute
(frontend-root) prepared nil
{:services (comparison-services
{:prepare-build (build-service {})
:execute-run (execute-service {})})}))
{:prepare-build
(^:async fn [request]
(let [build (await ((build-service {}) request))]
(fs/mkdirSync (path/dirname (:log-path build)) #js {:recursive true})
(binding [log/*log-path* (:log-path build)]
(await (timers/setImmediate))
(log/debug "Build fixture"))
build))
:execute-run
(^:async fn [root home build cases options signal]
(binding [log/*log-path* (:log-path home)]
(let [response (await ((execute-service {}) root home build cases options signal))]
(log/debug "Run fixture")
response)))})}))
record (:comparison result)
edge (first (:edges record))
path (:path edge)
comparison (result/decode (fs/readFileSync path "utf8"))]
(t/is (= 0 (:exit-code result)))
(t/is (= :completed (:status record)))
(let [text (fs/readFileSync (get-in result [:home :log-path]) "utf8")]
(doseq [slug ["0" "1"]
phase ["built" "running" "completed"]]
(t/is (str/includes? text (str "Configuration " slug " " phase "\n")))))
(t/is (every? #(= :completed (:status %)) (:configurations record)))
(t/is (every? #(= :completed (:status %)) (:edges record)))
(t/is (= ["a"] (get-in record [:configurations 1 :effective-features])))
@ -775,7 +790,8 @@
(t/deftest ^:async persistence-failure-retains-the-last-saved-state
(create-frontend-root)
(let [prepared (comparison-prepared ["a"] {})
(let [stdout (atom "")
prepared (comparison-prepared ["a"] {})
record-path (path/join (:output-dir prepared) "feature-comparison.transit")
prepare (fn [request]
(fs/rmSync record-path)
@ -783,19 +799,62 @@
(let [build (fake-build (:selection request) [])]
((:on-created request) build)
(js/Promise.resolve build)))
result (await (feature-comparison/execute
(frontend-root) prepared nil
{:services (comparison-services
{:prepare-build prepare
:execute-run (execute-service {})})}))
result (do
(log/configure {:stdout #js {:write #(swap! stdout str %)}})
(await (feature-comparison/execute
(frontend-root) prepared nil
{:services (comparison-services
{:prepare-build prepare
:execute-run (execute-service {})})})))
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 (= :running (:status record)))
(t/is (= :building (get-in record [:configurations 0 :status])))
(t/is (nil? (get-in record [:configurations 0 :build])))
(t/is (= :planned (get-in record [:configurations 1 :status])))))
(t/deftest ^:async comparison-storage-error-uses-comparison-evidence-after-a-failed-config
(create-frontend-root)
(let [prepared (comparison-prepared ["a"] {})
record (path/join (:output-dir prepared) "feature-comparison.transit")
response (await (feature-comparison/execute
(frontend-root) prepared nil
{:services
(comparison-services
{:prepare-build
(build-service
{:inspect (fn [request]
(when (seq (get-in request [:selection :features]))
(fs/renameSync record (str record ".saved"))
(fs/mkdirSync record)))})
:execute-run (execute-service {:kind :failed})})}))]
(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))))))
(t/deftest ^:async comparison-storage-error-keeps-its-origin-through-build-preparation
(create-frontend-root)
(let [prepared (comparison-prepared ["a"] {})
record (path/join (:output-dir prepared) "feature-comparison.transit")
response (await (feature-comparison/execute
(frontend-root) prepared nil
{:services
{:prepare-build
(^:async fn [request]
(let [created (:on-created request)]
(await (build/prepare
(assoc request :on-created
(fn [selected]
(fs/renameSync record (str record ".saved"))
(fs/mkdirSync record)
(created selected)))))))}}))]
(t/is (= 1 (:exit-code response)))
(t/is (= (get-in response [:home :log-path])
(or (:tail-log response) (:log-path response))))))
(t/deftest ^:async pending-real-signals-stop-edge-analysis
(create-frontend-root)
(doseq [[signal exit-code] [["SIGINT" 130] ["SIGTERM" 143]]]

142
frontend/test/performance_tests/render_wasm/log_test.cljs Normal file
View File

@ -0,0 +1,142 @@
;; 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.log-test
(:require
["fs" :as fs]
["node:stream" :as stream]
["node:timers/promises" :as timers]
["os" :as os]
["path" :as path]
[benches.render-wasm.node.log :as log]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(def temporary-root (atom nil))
(t/use-fixtures :each
{:before #(reset! temporary-root (fs/mkdtempSync (path/join (os/tmpdir) "bench-log-")))
:after (fn []
(log/configure {})
(fs/rmSync @temporary-root #js {:recursive true :force true}))})
(defn- capture
[]
(let [text (atom "")
out (stream/Writable.
#js {:write (fn [chunk _encoding done]
(swap! text str (.toString chunk))
(done))})]
{:stream out :text text}))
(t/deftest levels-filter-console-and-retain-every-line-in-the-file
(doseq [[level expected] [[:warn "! warning\n✖ failure\n"]
[:info "Phase\n attempt 1/1 completed\n! warning\n✖ failure\n"]
[:debug "Phase\n attempt 1/1 completed\n· raw child\n! warning\n✖ failure\n"]]]
(let [stdout (capture)
stderr (capture)
file (path/join @temporary-root (name level))]
(log/configure {:level level :color :never
:stdout (:stream stdout) :stderr (:stream stderr)})
(binding [log/*log-path* file]
(log/info "Phase")
(log/info " attempt 1/1 completed")
(log/debug "raw child")
(log/warn "warning")
(log/error {:message "failure" :tail? false})
(log/result "Run saved"))
(t/is (= "Run saved\n" @(:text stdout)))
(t/is (= (str/replace expected "✖ failure\n" (str "✖ failure\n log " file "\n"))
@(:text stderr)))
(t/is (= (str "Phase\n attempt 1/1 completed\nraw child\nwarning\n✖ failure\n log "
file "\nRun saved\n")
(fs/readFileSync file "utf8"))))))
(t/deftest colors-apply-to-console-headings-and-preserve-indented-progress
(doseq [[mode tty no-color term colored?]
[[:always false "1" "dumb" true] [:never true "" "xterm" false]
[:auto false "" "xterm" false] [:auto true "" "xterm" true]
[:auto true "1" "xterm" false] [:auto true "" "dumb" false]]]
(let [stdout (capture)
stderr (capture)
file (path/join @temporary-root (str (random-uuid)))
env (.-env js/process)
old-no-color (.-NO_COLOR env)
old-term (.-TERM env)]
(try
(set! (.-NO_COLOR env) no-color)
(set! (.-TERM env) term)
(set! (.-isTTY ^js (:stream stderr)) tty)
(log/configure {:color mode :stdout (:stream stdout) :stderr (:stream stderr)})
(binding [log/*log-path* file]
(log/info "Phase\n progress")
(log/result "Output /tmp/run"))
(t/is (= colored? (str/includes? @(:text stderr) "\u001b[")))
(t/is (= "Phase\n progress\n"
(str/replace @(:text stderr) #"\u001b\[[0-9;]*m" "")))
(t/is (= "Output /tmp/run\n" @(:text stdout)))
(t/is (= "Phase\n progress\nOutput /tmp/run\n" (fs/readFileSync file "utf8")))
(finally
(if (nil? old-no-color) (js-delete env "NO_COLOR") (set! (.-NO_COLOR env) old-no-color))
(if (nil? old-term) (js-delete env "TERM") (set! (.-TERM env) old-term)))))))
(t/deftest ^:async nested-tasks-route-lines-to-their-own-files-on-success-and-failure
(let [parent (path/join @temporary-root "comparison.log")
child (path/join @temporary-root "build.log")
output (capture)]
(log/configure {:level :warn :stdout (:stream output) :stderr (:stream output)})
(binding [log/*log-path* parent]
(log/debug "comparison before")
(await ((^:async fn []
(binding [log/*log-path* child]
(await (timers/setImmediate))
(log/debug "child success")))))
(log/debug "comparison between")
(try
(await ((^:async fn []
(binding [log/*log-path* child]
(await (timers/setImmediate))
(log/debug "child failure")
(throw (js/Error. "failed"))))))
(catch :default _ (log/debug "comparison after"))))
(t/is (= "comparison before\ncomparison between\ncomparison after\n"
(fs/readFileSync parent "utf8")))
(t/is (= "child success\nchild failure\n" (fs/readFileSync child "utf8")))))
(t/deftest error-names-tail-source-and-bounds-evidence-before-appending
(let [file (path/join @temporary-root "comparison.log")
child (path/join @temporary-root "build.log")
output (capture)]
(fs/writeFileSync child (str "excluded\n" (apply str (repeat 9000 "x")) "\n"
(str/join "\n" (map #(str "line-" %) (range 30)))) "utf8")
(log/configure {:color :never :stderr (:stream output)})
(binding [log/*log-path* file]
(log/error {:message "build failed" :fields [[:phase :renderer] [:build "id"]]
:tail-log child}))
(let [expected (str "✖ build failed\n phase :renderer\n build id\n"
" log " file "\n tail-log " child "\n tail\n"
(str/join "\n" (map #(str " line-" %) (range 10 30))) "\n")]
(t/is (= expected @(:text output)))
(t/is (= expected (fs/readFileSync file "utf8"))))
(fs/writeFileSync child (apply str (repeat 10000 "z")) "utf8")
(reset! (:text output) "")
(binding [log/*log-path* file]
(log/error {:message "bounded" :tail-log child}))
(t/is (= 8192 (count (re-find #"z+$" (str/trim @(:text output))))))
(fs/writeFileSync file "last line\n" "utf8")
(reset! (:text output) "")
(binding [log/*log-path* file]
(log/error {:message "same source"}))
(t/is (= (str "✖ same source\n log " file "\n tail\n last line\n")
@(:text output)))))
(t/deftest error-reporting-survives-unreadable-tail-and-file-append-failure
(let [output (capture)]
(log/configure {:color :never :stderr (:stream output)})
(binding [log/*log-path* @temporary-root]
(log/error {:message "original failure" :tail-log (path/join @temporary-root "missing")}))
(t/is (str/starts-with? @(:text output) "✖ original failure\n"))
(t/is (str/includes? @(:text output) @temporary-root))))

49
frontend/test/performance_tests/render_wasm/process_test.cljs
View File

@ -235,6 +235,20 @@
(t/is (= (select-keys result [:stdout :stderr]) @seen))
(t/is (= "yes" (fs/readFileSync (file "done") "utf8")))))
(t/deftest ^:async lines-keep-streams-separate-and-flush-final-fragments
(let [seen (atom {:stdout [] :stderr []})
source (str "process.stdout.write('out-'); process.stderr.write('err-');"
"setTimeout(() => { process.stdout.write('done\\r');"
"process.stderr.write('done\\nlast-err');"
"setTimeout(() => process.stdout.write('\\nlast-out'), 20); }, 20);")
result (await (process/run
(node-options source
{:capture-output? false
:on-line (fn [line stream]
(swap! seen update stream conj line))})))]
(t/is (= {:stdout ["out-done" "last-out"] :stderr ["err-done" "last-err"]} @seen))
(t/is (= {:exit-code 0 :stdout "" :stderr ""} result))))
(t/deftest ^:async decodes-utf8-across-real-pipe-chunks
(let [source (str "const bytes = Buffer.from('Ω😀');\n"
"process.stdout.write(bytes.subarray(0, 1));\n"
@ -343,23 +357,24 @@
(await (assert-tree-stopped))))
(t/deftest ^:async output-callback-failure-cleans-the-owned-group
(let [seen (atom "")
data (await
(rejected
(process/run
(node-options
(str (spawn-descendant) "setInterval(() => {}, 1000);")
{:on-output
(fn [text stream]
(when (= :stdout stream)
(swap! seen str text)
(when (str/includes? @seen "descendant-ready\n")
(throw (js/Error. "Output consumer failed")))))}))))]
(t/is (= :process-output (:type data)))
(t/is (= :stdout (:stream data)))
(t/is (= "SIGTERM" (:signal data)))
(t/is (str/includes? (:stdout data) "descendant-ready\n"))
(await (assert-tree-stopped))))
(doseq [callback [:on-output :on-line]]
(let [seen (atom "")
data (await
(rejected
(process/run
(node-options
(str (spawn-descendant) "setInterval(() => {}, 1000);")
{callback
(fn [text stream]
(when (= :stdout stream)
(swap! seen str text)
(when (str/includes? @seen "descendant-ready")
(throw (js/Error. "Output consumer failed")))))}))))]
(t/is (= :process-output (:type data)))
(t/is (= :stdout (:stream data)))
(t/is (= "SIGTERM" (:signal data)))
(t/is (str/includes? (:stdout data) "descendant-ready\n"))
(await (assert-tree-stopped)))))
(t/deftest ^:async successful-owner-exit-cleans-descendants-that-hold-the-pipes
(let [source (str (spawn-descendant)

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

@ -13,6 +13,7 @@
[benches.render-wasm.feature-plan :as feature-plan]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.feature-comparison :as feature-comparison]
[benches.render-wasm.node.log :as log]
[benches.render-wasm.node.run :as run]
[benches.render-wasm.node.runs :as runs]
[benches.render-wasm.result :as result]
@ -24,7 +25,9 @@
(t/use-fixtures :each
{:before #(reset! temporary-root
(fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-run-")))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
:after (fn []
(log/configure {})
(fs/rmSync @temporary-root #js {:recursive true :force true}))})
(defn- output-dir
[]
@ -187,7 +190,7 @@
(runs/create-home {:root (artifacts/frontend-root) :run-id (:run-id opts)
:output-dir (:output-dir opts)})
(selected-build (build-dir) "test-build")
cases opts (.-signal controller) nil nil)))
cases opts (.-signal controller))))
(defn- attempts-for
[run case-id]
@ -201,6 +204,48 @@
[result]
(result/decode (fs/readFileSync (get-in result [:home :record-path]) "utf8")))
(t/deftest ^:async retained-run-prints-results-and-keeps-all-levels-in-its-log
(doseq [level [:info :warn :debug]]
(let [root @temporary-root
cases [(collected :case/a :fresh) (collected :case/b :reuse)]
build (artifacts/create-build root {:default-features? true :features []}
{:git {:sha "fixture" :dirty false}})
stdout (atom "")
stderr (atom "")
fake (fake-browser {})
out (output-dir)]
(doseq [file [(:index-path build) (path/join (:browser-dir build) "browser.js")
(path/join (:renderer-dir build) "render-wasm.js")
(path/join (:renderer-dir build) "render-wasm.wasm")
(path/join (:renderer-dir build) "shared.js")]]
(fs/writeFileSync file "fixture" "utf8"))
(fs/writeFileSync (:cases-path build)
(str "module.exports = {buildIdentity() {return "
(js/JSON.stringify (transit/encode-str {:build-id (:id build)}))
";}, collectCases() {return "
(js/JSON.stringify (transit/encode-str {:build-id (:id build) :cases cases}))
";}};") "utf8")
(artifacts/write-manifest build (assoc (:manifest build) :status :ready))
(log/configure {:level level :color :never
:stdout #js {:write #(swap! stdout str %)}
:stderr #js {:write #(swap! stderr str %)}})
(let [response (await (run/run root (assoc (options fake out) :build-id (:id build)
:warmups 1 :repetitions 2) nil))
saved (saved-record response)
text (fs/readFileSync (get-in response [:home :log-path]) "utf8")]
(t/is (= 0 (:exit-code response)))
(t/is (= (str "Run " (:run-id saved) "\nOutput " out "\nReport\n"
(str/replace (:report response) #"\n$" "") "\n") @stdout))
(t/is (str/includes? text "▸ Case case/a (fresh)\n"))
(doseq [case-text (rest (str/split text #"▸ Case "))]
(t/is (str/includes? case-text " attempt 1/3 completed (warmup)\n"))
(t/is (str/includes? case-text " attempt 2/3 completed\n"))
(t/is (str/includes? case-text " attempt 3/3 completed\n")))
(t/is (str/includes? text (:report response)))
(t/is (str/includes? text "Browser FakeBrowser/1"))
(t/is (= (not= :warn level) (str/includes? @stderr "▸ Case case/a")))
(t/is (= (= :debug level) (str/includes? @stderr "Browser FakeBrowser/1")))))))
(t/deftest ^:async fresh-and-reuse-cases-follow-their-context-policies
(let [fake (fake-browser {})
cases [(collected :case/fresh :fresh) (collected :case/reuse :reuse)]
@ -465,7 +510,7 @@
home (runs/create-home {:root root :run-id (:run-id opts) :output-dir (:output-dir opts)})
controller (js/AbortController.)
executed (await (run/execute root home build [(collected :case/a :fresh)]
opts (.-signal controller) nil nil))
opts (.-signal controller)))
saved (saved-record executed)
facts (get-in saved [:metadata :build])]
(t/is (zero? (:exit-code executed)))
@ -487,7 +532,7 @@
result (await (run/execute root home (selected-build dir id)
[(collected :case/a :fresh)]
(assoc (options fake out) :remove? true)
(.-signal (js/AbortController.)) nil nil))]
(.-signal (js/AbortController.))))]
(t/is (fs/existsSync (get-in result [:home :record-path])))
(t/is (fs/existsSync dir))
(t/is (not (fs/existsSync (path/join dir "index.html"))))
@ -518,7 +563,7 @@
response (await (run/execute root home (selected-build dir id)
[(collected :case/a :fresh)]
(assoc (options fake out) :remove true)
(.-signal (js/AbortController.)) nil nil))
(.-signal (js/AbortController.))))
saved (result/decode (fs/readFileSync prior "utf8"))]
(t/is (= :running (get-in saved [:termination :reason])))
(t/is (= 1 (count (:attempts saved))))
@ -530,7 +575,8 @@
(t/deftest ^:async comparison-stops-after-run-record-or-log-storage-fails
(doseq [filename ["run.transit" "run.log"]]
(let [root @temporary-root
(let [executed (atom nil)
root @temporary-root
out (output-dir)
cases [(collected :case/a :fresh)]
prepared {:plan (feature-plan/plan ["a"] {:dry-run true})
@ -553,7 +599,7 @@
(js/Promise.resolve build)))
:collect-catalog (fn [_ _] cases)
:execute-run
(fn [root home selected cases opts signal on-progress on-created]
(^:async fn [root home selected cases opts signal]
(let [base (fake-browser {})
close (:close (:service base))
file (path/join (:dir home) filename)
@ -561,13 +607,16 @@
(fn [owner]
(close owner)
(fs/renameSync file (str file ".saved"))
(fs/mkdirSync file)))]
(run/execute root home selected cases (assoc opts :browser service)
signal on-progress on-created)))}}))
(fs/mkdirSync file)))
outcome (await (run/execute root home selected cases
(assoc opts :browser service) signal))]
(reset! executed outcome)
outcome))}}))
saved (result/decode (fs/readFileSync (get-in response [:home :record-path]) "utf8"))
evidence (path/join out "configs" "0"
(if (= filename "run.transit") "run.transit.saved" "run.transit"))]
(t/is (= 1 (count (:attempts (result/decode (fs/readFileSync evidence "utf8"))))))
(t/is (= 1 (:exit-code response)))
(t/is (re-find #"Case case/a" (or (:report @executed) "")))
(t/is (= :failed (get-in saved [:configurations 0 :status])))
(t/is (= :unattempted (get-in saved [:configurations 1 :status]))))))

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

@ -22,6 +22,7 @@
[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.process-test]
[performance-tests.render-wasm.protocol-test]
[performance-tests.render-wasm.report-test]
@ -55,6 +56,7 @@
'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.process-test
'performance-tests.render-wasm.protocol-test
'performance-tests.render-wasm.report-test

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

@ -11,6 +11,18 @@
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(t/deftest output-options-apply-to-every-command
(doseq [args [["build"] ["run"] ["purge"] ["compare" "base" "candidate"]
["ab" "--features" "a" "--filter" "rects/load"]]]
(t/is (= :info (options/console-level (:options (runner/parse-args args)))))
(t/is (= :auto (options/color-mode (:options (runner/parse-args args)))))
(t/is (= :warn (options/console-level (:options (runner/parse-args (conj args "-q"))))))
(t/is (= :debug (options/console-level (:options (runner/parse-args (conj args "-v"))))))
(t/is (= :always (options/color-mode (:options (runner/parse-args (conj args "--color"))))))
(t/is (= :never (options/color-mode (:options (runner/parse-args (conj args "--no-color")))))))
(t/is (thrown-with-msg? js/Error #"mutually exclusive"
(runner/parse-args ["run" "-q" "-v"]))))
(t/deftest build-parses-defaults-and-explicit-functional-feature-selection
(let [{:keys [command options]} (runner/parse-args ["build"])]
(t/is (= "build" command))
@ -219,7 +231,7 @@
:warmups 0 :repetitions 2 :timeout-ms 1000 :build-timeout-ms 2000
:startup-timeout-ms 3000 :output-dir "new-home" :screenshots true
:allow-build-differences true :allow-scene-differences true :allow-all-differences true
:max-features 3 :confirm false :dry-run false :default-features false}
:max-features 3 :confirm false :dry-run false :default-features false :color nil}
options))))
(t/deftest ab-rejects-missing-features-and-incompatible-flags-before-execution

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

@ -86,15 +86,12 @@
(t/is (= ::result/invalid-record (:type (ex-data error))))
(t/is (= run (result/decode (fs/readFileSync (:record-path home) "utf8")))))))
(t/deftest log-and-screenshot-paths-stay-in-the-run-home
(let [home (runs/create-home {:root @temporary-root :run-id "run-5"})]
(runs/append-log! home "first\n")
(runs/append-log! home "second\n")
(t/is (= "first\nsecond\n" (fs/readFileSync (:log-path home) "utf8")))
(let [shot (runs/screenshot-path home :rects/load)]
(t/is (= "rects-load.png" (:file shot)))
(t/is (= (path/join (:dir home) "rects-load.png") (:path shot)))
(t/is (= (path/dirname (:record-path home)) (path/dirname (:path shot)))))))
(t/deftest screenshot-paths-stay-in-the-run-home
(let [home (runs/create-home {:root @temporary-root :run-id "run-5"})
shot (runs/screenshot-path home :rects/load)]
(t/is (= "rects-load.png" (:file shot)))
(t/is (= (path/join (:dir home) "rects-load.png") (:path shot)))
(t/is (= (path/dirname (:record-path home)) (path/dirname (:path shot))))))
(t/deftest malformed-ids-and-empty-paths-fail-at-the-home-boundary
(doseq [id ["../escape" "" "a/b" "a\\b"]]