✨ Add retained renderer benchmark builds and host

Add prepared build artifacts, browser host and the build and
purge commands for the CLJS renderer benchmarks.

Each preparation attempt gets a build ID and a retained directory with
its manifest, log, Node case catalog, browser bundle, renderer files
and host page. Ready builds load their matching catalog in process and
serve only their own directory through an owned loopback host.

Own Chromium through a bounded process group, verify the compiled build
identity before execution and retain failed preparations for diagnosis.
Wire the diagnostic pilot to the same build, catalog, server and
browser APIs.

Add real boundary tests for artifacts, processes, servers, browsers and
CLI parsing, and register them with the performance test runner. Rename
the benchmark lint and test scripts to match the suite.

AI-assisted-by: deepseek-flash
This commit is contained in:
Miguel de Benito Delgado 2026-10-26 12:19:40 +01:00
parent aea06a7d1d
commit adce3d2872
24 changed files with 3550 additions and 370 deletions

View File

@ -34,13 +34,13 @@
"fmt:scss": "prettier -c resources/styles -c src/**/*.scss -w",
"lint:clj": "clj-kondo --fail-level error --config-dir ../.clj-kondo --lint ../common/src src/ performance/ test/performance_tests/render_wasm/",
"lint:js": "exit 0",
"lint:performance": "clj-kondo --config-dir ../.clj-kondo --lint performance/ test/performance_tests/render_wasm/",
"lint:renderer-benchmarks": "clj-kondo --config-dir ../.clj-kondo --lint performance/ test/performance_tests/render_wasm/",
"lint:scss": "pnpm exec stylelint '{src,resources}/**/*.scss'",
"build:test": "pnpm run build:wasm && clojure -M:dev:shadow-cljs compile test",
"build:performance-tests": "clojure -M:dev:shadow-cljs compile performance-tests",
"build:renderer-benchmarks:tests": "clojure -M:dev:shadow-cljs compile performance-tests",
"test": "pnpm run build:test && node target/tests/test.js",
"test:quiet": "node ./scripts/test-quiet.js",
"test:performance-tests": "pnpm run build:performance-tests && node target/performance-tests/test.js",
"test:renderer-benchmarks": "pnpm run build:renderer-benchmarks:tests && node target/performance-tests/test.js",
"test:storybook": "vitest run --project=storybook",
"watch:test": "mkdir -p target/tests && concurrently \"clojure -M:dev:shadow-cljs watch test\" \"nodemon -C -d 2 -w target/tests --exec 'node target/tests/test.js'\"",
"test:e2e": "playwright test --project default",

View File

@ -35,6 +35,7 @@
[benches.render-wasm.declarations :as decl]
[benches.render-wasm.failures :as fail]
[benches.render-wasm.fingerprint :as fingerprint]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.report.compare :as compare]
[benches.render-wasm.report.format :as format]
@ -674,6 +675,7 @@
(def bridge
"Browser-side bridge exported from the compiled module."
#js {"ping" ping
"buildIdentity" #(t/encode-str (identity/data))
"loadScene" load-scene
"prepareScene" prepare-scene-request
"runPrepared" run-prepared

View File

@ -1,21 +1,31 @@
<!doctype html>
<html>
<head>
<meta charset="utf-8">
<title>renderer benchmark pilot</title>
<meta charset="utf-8" />
<title>renderer benchmarks</title>
<style>
/* The canvas is the page: kill the UA body margin (8px) that would
leave a gutter around the scene in screenshots. */
html, body { margin: 0; padding: 0; }
canvas { display: block; }
html,
body {
margin: 0;
padding: 0;
}
canvas {
display: block;
}
</style>
</head>
<body>
<!-- Same one-liner as frontend/resources/polyfills/dynamicImport.js:
the bench bundle is plain ESM and must not depend on app boot. -->
<script>globalThis.dynamicImport = function (u) { return import(u); };</script>
<script>
globalThis.dynamicImport = function (u) {
return import(u);
};
</script>
<script type="module">
import bridge from "/bench/browser.js";
import bridge from "/browser/browser.js";
window.__benchBridge = bridge;
window.__benchReady = true;
</script>

View File

@ -0,0 +1,14 @@
;; 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.identity
(:require
[app.render-wasm.performance :as performance]))
(defmacro compiled-profile-marks
"Captures the profiling switch used by renderer macros in this compiler."
[]
(performance/enabled?))

View File

@ -0,0 +1,27 @@
;; 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 INC
(ns benches.render-wasm.identity
"Build identity shared by the isolated Node catalog and browser bundle."
(:require-macros [benches.render-wasm.identity :refer [compiled-profile-marks]]))
(goog-define build-id "unprepared")
(defn data
[]
{:build-id build-id :cljs-profile-marks (compiled-profile-marks)})
(defn check
"Checks a loaded bundle's identity against the selected build."
[expected-id actual]
(when-not (and (map? actual)
(string? (:build-id actual))
(= expected-id (:build-id actual)))
(throw (ex-info "renderer build identity mismatch"
{:type ::mismatch
:expected-id expected-id
:actual-id (:build-id actual)})))
actual)

View File

@ -0,0 +1,248 @@
;; 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 INC
(ns benches.render-wasm.node.artifacts
"Managed renderer builds under frontend/target/performance/render-wasm.
create-build writes the initial manifest and log before returning. A build
helper can then publish its :on-created output, compile into the returned
paths, and write a :ready or :failed manifest. Failed builds retain their
files and logs until an idle caller explicitly removes them."
(:require
["fs" :as fs]
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.codec :as codec]
[clojure.string :as str]))
(def ^:private executable-dir
;; CJS boots use __dirname. Node's ESM test boots have an absolute argv[1]
;; instead; capture it before a caller changes cwd. Neither uses a cwd root.
(if (exists? js/__dirname)
js/__dirname
(let [script (aget js/process.argv 1)]
(when (and (string? script) (path/isAbsolute script))
(path/dirname script)))))
(defn frontend-root
"Finds the frontend checkout by walking up from the Node executable.
Supports target/performance/render-wasm/{runner,pilot}.cjs and the ESM
target/{performance-tests,tests}/test.js boots, independent of caller cwd."
[]
(when-not executable-dir
(throw (ex-info "cannot locate the Node executable directory"
{:type ::missing-executable-dir})))
(loop [dir (path/resolve executable-dir)]
(let [deps (path/join dir "deps.edn")
scenes (path/join dir "performance" "benches" "render_wasm")
parent (path/dirname dir)]
(cond
(and (fs/existsSync deps) (.isFile ^js (fs/statSync deps))
(fs/existsSync scenes) (.isDirectory ^js (fs/statSync scenes)))
dir
(= parent dir)
(throw (ex-info "cannot locate the frontend checkout"
{:type ::missing-frontend-root
:executable-dir executable-dir}))
:else
(recur parent)))))
(defn- check-id
[id]
(when-not (and (string? id) (re-matches #"[A-Za-z0-9][A-Za-z0-9_-]{0,127}" id))
(throw (ex-info "invalid renderer build id" {:type ::invalid-id :id id})))
id)
(defn- contained?
[root file]
(let [relative (path/relative root file)]
(and (not (path/isAbsolute relative))
(not= relative "..")
(not (str/starts-with? relative (str ".." path/sep))))))
(defn- checked-path
[root file]
(let [resolved (fs/realpathSync file)]
(when-not (contained? root resolved)
(throw (ex-info "renderer artifact path escapes its managed directory"
{:type ::unsafe-path :path file})))
resolved))
(defn managed-root
"Returns the managed path under an existing frontend checkout.
Checks its nearest existing ancestor before creating or removing paths,
so a managed-root or ancestor symlink cannot escape the frontend root."
[root]
(let [frontend (fs/realpathSync root)
managed (path/resolve root "target" "performance" "render-wasm")]
(loop [existing managed]
(if (fs/existsSync existing)
(checked-path frontend existing)
(recur (path/dirname existing))))
managed))
(defn- build-reference
[root id manifest]
(let [dir (path/join (managed-root root) "builds" id)]
{:id id
:dir dir
:manifest-path (path/join dir "build.transit")
:log-path (path/join dir "build.log")
:cases-path (path/join dir "cases.cjs")
:browser-dir (path/join dir "browser")
:renderer-dir (path/join dir "renderer")
:index-path (path/join dir "index.html")
:manifest manifest}))
(defn- atomic-write
[file content]
(let [temporary (str file "." (random-uuid) ".tmp")]
(try
(fs/writeFileSync temporary content #js {:encoding "utf8" :flag "wx"})
(fs/renameSync temporary file)
(finally
(fs/rmSync temporary #js {:force true})))))
(defn create-build
"Allocates a UUID build and saves its :building build.transit and empty log.
root is the frontend checkout. selection is {:default-features? boolean
:features vector}; provenance is {:git {:sha string-or-nil
:dirty boolean-or-nil}}. This function does not compile or remove builds."
[root selection provenance]
(let [id (str (random-uuid))
now (.toISOString (js/Date.))
manifest {:type :renderer-build
:schema-version 1
:id id
:status :building
:created-at now
:updated-at now
:functional {:mode :release
:default-features? (:default-features? selection)
:features (:features selection)
:cljs-profile-marks false}
:provenance provenance}
build (build-reference root id manifest)]
(fs/mkdirSync (path/dirname (:dir build)) #js {:recursive true})
(checked-path (fs/realpathSync (managed-root root)) (path/dirname (:dir build)))
(fs/mkdirSync (:dir build))
(fs/mkdirSync (:browser-dir build))
(fs/mkdirSync (:renderer-dir build))
(fs/writeFileSync (:log-path build) "" "utf8")
(atomic-write (:manifest-path build) (codec/encode-str manifest))
build))
(defn write-manifest
"Atomically replaces a manifest and returns the updated build reference.
Only :building builds can change. An unchanged terminal manifest is a
no-op; :ready and :failed builds cannot otherwise change.
Read the saved status so an old build reference cannot reopen a build."
[build manifest]
(let [current (transit/decode-str (fs/readFileSync (:manifest-path build) "utf8"))]
(when-not (and (= (:id build) (:id current) (:id manifest))
(= :renderer-build (:type current))
(= 1 (:schema-version current))
(contains? #{:building :ready :failed} (:status current))
(= :renderer-build (:type manifest))
(= 1 (:schema-version manifest))
(contains? #{:building :ready :failed} (:status manifest)))
(throw (ex-info "invalid renderer build manifest"
{:type ::invalid-manifest :id (:id build)})))
(if (contains? #{:ready :failed} (:status current))
(if (= current manifest)
(assoc build :manifest current)
(throw (ex-info "renderer build is already terminal"
{:type ::terminal-build
:id (:id build)
:status (:status current)})))
(let [manifest (assoc manifest :updated-at (.toISOString (js/Date.)))]
(atomic-write (:manifest-path build) (codec/encode-str manifest))
(assoc build :manifest manifest)))))
(defn- require-file
[root file]
(let [resolved (checked-path root file)]
(when-not (.isFile ^js (fs/statSync resolved))
(throw (ex-info "renderer artifact is not a file"
{:type ::missing-artifact :path file})))
resolved))
(defn check-files
"Checks required files and selected directory containment; returns build.
build is a reference from create-build or load-build. This check neither
reads nor changes manifest status. The build helper must also check catalog
and browser identities before writing its terminal :ready manifest."
[build]
;; Build directories use <frontend>/target/performance/render-wasm/builds/<id>.
(let [root (path/resolve (:dir build) ".." ".." ".." ".." "..")
managed (fs/realpathSync (managed-root root))
dir (checked-path managed (:dir build))]
(require-file dir (:cases-path build))
(require-file dir (path/join (:browser-dir build) "browser.js"))
(require-file dir (path/join (:renderer-dir build) "render-wasm.js"))
(require-file dir (path/join (:renderer-dir build) "render-wasm.wasm"))
(require-file dir (path/join (:renderer-dir build) "shared.js"))
(require-file dir (:index-path build))
build))
(defn load-build
"Loads a ready schema-1 build and checks every required artifact.
IDs cannot contain path segments. The build, manifest and artifact paths
must remain inside the managed root and the selected build after resolving
symlinks. Building, failed, incomplete and unsupported builds are rejected."
[root id]
(check-id id)
(let [managed (fs/realpathSync (managed-root root))
build (build-reference root id nil)
dir (checked-path managed (:dir build))
file (require-file dir (:manifest-path build))
manifest (transit/decode-str (fs/readFileSync file "utf8"))]
(when-not (and (= :renderer-build (:type manifest))
(= 1 (:schema-version manifest))
(= id (:id manifest)))
(throw (ex-info "unsupported renderer build manifest"
{:type ::unsupported-manifest :id id})))
(when-not (= :ready (:status manifest))
(throw (ex-info "renderer build is not ready"
{:type ::not-ready :id id :status (:status manifest)})))
(check-files (assoc build :manifest manifest))))
(defn purge
"Deletes :builds, :runs or both (:all), including unfinished builds.
The caller must be idle: no build, server or run may still own these paths.
Boot executables and other files beside the managed subroots stay in place.
A selected subroot symlink is removed without deleting its target."
[root category]
(let [managed (managed-root root)]
(case category
:builds (fs/rmSync (path/join managed "builds") #js {:recursive true :force true})
:runs (fs/rmSync (path/join managed "runs") #js {:recursive true :force true})
:all (do
(fs/rmSync (path/join managed "builds") #js {:recursive true :force true})
(fs/rmSync (path/join managed "runs") #js {:recursive true :force true}))
(throw (ex-info "invalid renderer artifact category"
{:type ::invalid-category :category category})))))
(defn remove-builds
"Deletes only the selected build IDs. The caller must be idle."
[root ids]
(let [ids (mapv check-id ids)
managed (managed-root root)
builds (path/join managed "builds")]
(when (fs/existsSync builds)
(checked-path (fs/realpathSync managed) builds)
(doseq [id ids]
;; rmSync removes a final symlink itself, not its target.
(fs/rmSync (path/join builds id) #js {:recursive true :force true})))))

View File

@ -0,0 +1,256 @@
;; 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.browser
"Owns Chromium through process/run from spawn, then attaches Playwright by CDP.
Shutdown stops the owned process group before disconnecting the client."
(:require
["fs" :as fs]
["os" :as os]
["path" :as path]
["playwright" :as playwright]
[app.common.transit :as transit]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.process :as process]))
(def launch-settings
"Static settings for the full Chromium executable; profile and port are owned."
{:headless true
:transport :cdp
:args ["--headless"
"--no-sandbox"
"--disable-dev-shm-usage"
"--enable-gpu"
"--enable-unsafe-swiftshader"
"--no-first-run"
"--no-default-browser-check"
"--disable-background-networking"
"--disable-background-timer-throttling"
"--disable-renderer-backgrounding"
"--hide-scrollbars"
"--mute-audio"]})
(defn within
"Calls work while its absolute deadline and optional AbortSignal allow it.
Clears the timer/listener on every outcome and handles late rejections. The
caller still owns shutdown of the browser running the work."
[work {:keys [deadline signal phase]}]
(js/Promise.
(fn [resolve reject]
(let [settled (atom false)
timer (atom nil)]
(letfn [(cleanup []
(js/clearTimeout @timer)
(when signal
(.removeEventListener ^js signal "abort" aborted)))
(succeeded [value]
(when (compare-and-set! settled false true)
(cleanup)
(resolve value)))
(failed [cause]
(when (compare-and-set! settled false true)
(cleanup)
(reject cause)))
(aborted []
(failed (or (.-reason ^js signal)
(ex-info "browser work aborted" {:type ::aborted :phase phase}))))
(expired []
(failed (ex-info "browser work timed out" {:type ::timeout :phase phase})))]
(when signal
(.addEventListener ^js signal "abort" aborted #js {:once true}))
(cond
(and signal (.-aborted ^js signal))
(aborted)
(zero? (process/remaining deadline))
(expired)
:else
(do
(reset! timer (js/setTimeout expired (process/remaining deadline)))
(try
(.then (js/Promise.resolve (work)) succeeded failed)
(catch :default cause
(failed cause))))))))))
(defn evaluate
"Calls a fixed bridge method, optionally with a Transit string.
JSON quoting embeds the argument; descriptors and results remain Transit."
([^js page method]
(.evaluate page (str "window.__benchBridge." method "()")))
([^js page method text]
(.evaluate page (str "window.__benchBridge." method "(" (.stringify js/JSON text) ")"))))
(defn- endpoint-waiter
"Keeps the last 64 KiB of startup stderr until a complete endpoint line arrives."
[]
(let [callbacks (atom nil)
settled (atom false)
output (atom "")
address (atom nil)
promise (js/Promise. (fn [resolve reject]
(reset! callbacks {:resolve resolve :reject reject})))]
;; Cancellation may precede the first within call. Keep the endpoint's
;; rejection handled even when that call never subscribes to it.
(.catch promise (fn [_] nil))
{:promise promise
:address address
:on-output (fn [text stream]
(when (and (= :stderr stream) (not @settled))
(let [buffer (str @output text)]
(if-let [[_ endpoint] (re-find #"DevTools listening on (ws://[^\s]+)\r?\n" buffer)]
(do
(reset! settled true)
(reset! address endpoint)
(reset! output "")
((:resolve @callbacks) endpoint))
(reset! output (subs buffer (max 0 (- (count buffer) 65536))))))))
:failed (fn [cause]
(when (compare-and-set! settled false true)
((:reject @callbacks)
(ex-info "Chromium exited before its CDP endpoint became ready"
{:type ::endpoint-exit :stderr @output}
cause))))}))
(defn- ^:async stop-process
[{:keys [controller process]}]
(.abort controller)
(try
(let [result (await process)]
(throw (ex-info "Chromium exited before owned shutdown"
{:type ::process-exit :exit-code (:exit-code result)})))
(catch :default cause
(when-not (= :process-cancelled (:type (ex-data cause)))
(throw cause)))))
(defn- disconnect
"Disconnects only after the group has stopped. A late CDP attachment is also
closed by this continuation; the caller waits at most one termination grace."
[{:keys [connection]}]
(within (fn []
(if-let [pending @connection]
(.then pending
(fn [^js browser]
(when (.isConnected browser)
(.close browser)))
(fn [_] nil))
nil))
{:deadline (process/deadline process/default-termination-grace-ms)
:phase :browser-disconnect}))
(defn- ^:async shutdown-owner
[{:keys [user-data-dir] :as owner}]
(let [process-failure (try
(await (stop-process owner))
nil
(catch :default cause cause))
disconnect-failure (try
(await (disconnect owner))
nil
(catch :default cause cause))
profile-failure (try
(fs/rmSync user-data-dir #js {:recursive true :force true})
nil
(catch :default cause cause))]
(when-let [cause (or process-failure disconnect-failure profile-failure)]
(throw cause))))
(defn close
"Returns one shutdown Promise for this owner. Aborting the internal process
lifecycle invokes process/run's SIGTERM/5s/SIGKILL group cleanup, even during
startup or blocked page JS. Only process cancellation is normal shutdown."
[{:keys [shutdown signal abort-listener] :as owner}]
(or @shutdown
(do
(when signal
(.removeEventListener ^js signal "abort" @abort-listener))
(let [closing (shutdown-owner owner)]
(reset! shutdown closing)
closing))))
(defn ^:async open
"Spawns owned Chromium, attaches by public CDP and checks the retained bridge.
Options include a resolved {:width :height :dpr} viewport, an optional signal
and startup-timeout-ms (30000 by default). An optional absolute deadline lets
server/browser startup share a budget. The result holds :page, :context,
:browser, :version, :endpoint and ownership fields consumed by close.
Startup failures retain endpoint/profile facts after owned shutdown."
[host {:keys [viewport signal startup-timeout-ms deadline]
:or {startup-timeout-ms process/default-startup-timeout-ms}}]
(let [deadline (or deadline (process/deadline startup-timeout-ms))
budget (process/remaining deadline)]
(when (and signal (.-aborted ^js signal))
(throw (or (.-reason ^js signal) (ex-info "browser startup aborted" {:type ::aborted}))))
(when (zero? budget)
(throw (ex-info "browser startup timed out" {:type ::timeout :phase :browser-startup})))
(let [^js chromium (.-chromium playwright)
command (.executablePath chromium)
user-data-dir (fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-browser-"))
controller (js/AbortController.)
endpoint (endpoint-waiter)
running (process/run {:command command
:args (into (:args launch-settings)
["--remote-debugging-port=0"
"--remote-debugging-address=127.0.0.1"
(str "--user-data-dir=" user-data-dir)
"about:blank"])
:deadline js/Number.MAX_SAFE_INTEGER
:signal (.-signal controller)
:capture-output? false
:on-output (:on-output endpoint)})
owner {:controller controller :process running :shutdown (atom nil)
:connection (atom nil) :user-data-dir user-data-dir
:signal signal :abort-listener (atom nil)}
bounds {:deadline deadline :signal signal :phase :browser-startup}
abort (fn []
;; Startup/caller cleanup also awaits this same promise.
(.catch (close owner) (fn [_] nil)))]
(.then running
(fn [result]
((:failed endpoint) (ex-info "Chromium exited during startup"
{:type ::process-exit :exit-code (:exit-code result)})))
(:failed endpoint))
(reset! (:abort-listener owner) abort)
(when signal
(.addEventListener ^js signal "abort" abort #js {:once true}))
(try
(let [address (await (within (fn [] (:promise endpoint)) bounds))
^js browser (await (within (fn []
(let [connecting (.connectOverCDP chromium address
#js {:timeout (max 1 (process/remaining deadline))})]
(reset! (:connection owner) connecting)
connecting))
bounds))
^js context (await (within #(.newContext browser
#js {:viewport #js {:width (:width viewport)
:height (:height viewport)}
:deviceScaleFactor (:dpr viewport)})
bounds))
^js page (await (within #(.newPage context) bounds))]
(await (within #(.goto page (str (:base-url host) "/")
#js {:timeout (max 1 (process/remaining deadline))})
bounds))
(await (within #(.waitForFunction page "window.__benchReady === true" nil
#js {:timeout (max 1 (process/remaining deadline))})
bounds))
(identity/check (get-in host [:build :id])
(transit/decode-str (await (within #(evaluate page "buildIdentity") bounds))))
(assoc owner :browser browser :context context :page page
:version (.version browser) :endpoint address))
(catch :default cause
(try
(await (close owner))
(catch :default cleanup-cause
(throw (ex-info "browser shutdown failed after startup error"
{:type ::startup-cleanup
:endpoint @(:address endpoint) :user-data-dir user-data-dir
:startup-failure (failures/describe-cause cause)}
cleanup-cause))))
(throw (ex-info (or (ex-message cause) (str cause))
(assoc (ex-data cause) :endpoint @(:address endpoint) :user-data-dir user-data-dir)
cause)))))))

View File

@ -0,0 +1,167 @@
;; 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.build
"Prepares retained release artifacts under a single preparation deadline.
The caller owns exclusive preparation for this checkout. The renderer's
lock protects Cargo and copying; CLJS compilation follows after it releases.
Preparation uses installed dependencies and offline Cargo. Every attempt
retains its manifest and compiler log, including failed attempts."
(:require
["fs" :as fs]
["path" :as path]
["url" :as url]
[app.common.transit :as transit]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.catalog :as catalog]
[benches.render-wasm.node.process :as process]
[clojure.string :as str]))
(def diagnostic-features #{"stats" "profile" "profile-macros" "profile-raf"})
(defn feature-selection
"Validates measurement feature selection before allocating an attempt.
Cargo validates functional feature names during the retained build."
[{:keys [default-features? features]
:or {default-features? true features []}}]
(when-not (and (boolean? default-features?) (vector? features)
(every? #(and (string? %) (re-matches #"[A-Za-z0-9_-]+" %)) features))
(throw (ex-info "invalid Cargo feature selection" {:type ::invalid-features})))
(when-let [selected (seq (filter diagnostic-features features))]
(throw (ex-info "measurement builds cannot enable diagnostic Cargo features"
{:type ::diagnostic-features :features (vec selected)})))
{:default-features? default-features? :features (vec (sort (distinct features)))})
(defn parse-feature-list
[text]
(:features (feature-selection {:features (mapv str/trim (str/split text #"," -1))})))
(defn ^:async git-provenance
"Captures revision and dirty state through the same bounded child boundary."
[root bounds]
(try
(let [options (merge bounds {:command "git" :cwd root})
sha (await (process/run (assoc options :args ["rev-parse" "HEAD"])))
status (await (process/run (assoc options :args ["status" "--porcelain"])))]
{:sha (str/trim (:stdout sha)) :dirty (not (str/blank? (:stdout status)))})
(catch :default cause
(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))))
{:sha nil :dirty nil})))))
(defn- check-profile-marks
[compiled]
(when-not (false? (:cljs-profile-marks compiled))
(throw (ex-info "compiled benchmark enables profiling marks or omits its setting"
{: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."
[build root bounds]
(let [module-url (.-href (url/pathToFileURL (path/join (:browser-dir build) "browser.js")))
script "const {default: bridge} = await import(process.env.RENDER_BENCH_MODULE_URL); process.stdout.write(bridge.buildIdentity());"
result (await (process/run (merge bounds
{:command (.-execPath js/process) :cwd root
:args ["--input-type=module" "-e" script]
:env {"RENDER_BENCH_MODULE_URL" module-url}})))]
(check-profile-marks (identity/check (:id build) (transit/decode-str (:stdout result))))))
(defn ^:async prepare
"Returns a ready build reference after compilation and identity validation.
Options: frontend :root, :features, :build-timeout-ms (300000), AbortSignal
:signal, and optional :on-created callback. The callback runs once after
directory, log and initial manifest creation. CLI callers print the ID there.
Storage errors have no recorded ID. Later errors carry :build-id and :phase.
A retry always creates a new attempt."
[{:keys [root features build-timeout-ms signal on-created]
:or {build-timeout-ms process/default-build-timeout-ms}}]
(when-not (and (js/Number.isSafeInteger build-timeout-ms) (pos? build-timeout-ms))
(throw (ex-info "build timeout must be a positive integer" {:type ::invalid-timeout})))
(let [root (or root (artifacts/frontend-root))
selection (feature-selection features)
deadline (process/deadline build-timeout-ms)
bounds {:deadline deadline :signal signal}
initial (artifacts/create-build root selection {:git {:sha nil :dirty nil}
: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->clj (js/JSON.parse (fs/readFileSync facts-path "utf8")) :keywordize-keys true)
resolved (:features (feature-selection {:features (:features facts)
:default-features? (:default-features? selection)}))]
(when-not (and (= "3" (get-in facts [:profile :opt_level]))
(false? (get-in facts [:profile :debug_assertions])))
(throw (ex-info "Cargo did not produce an optimized renderer"
{:type ::renderer-profile :profile (:profile facts)})))
(swap! build-ref #(artifacts/write-manifest
% (-> (:manifest %)
(assoc-in [:functional :features] resolved)
(assoc-in [:functional :default-features?] (boolean (some #{"default"} resolved)))
(assoc-in [:provenance :cargo-profile] (:profile 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" "pilot.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)))))))

View File

@ -0,0 +1,26 @@
;; 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 INC
(ns benches.render-wasm.node.case-catalog
"Node-library entry points compiled with the browser's scene declarations.
Export collect-cases as collectCases and build-identity as buildIdentity.
Each build's cases.cjs must keep its own JavaScript scope and registry."
(:require
[app.common.transit :as transit]
[benches.render-wasm.cases :as cases]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.identity :as identity]))
(defn collect-cases
[encoded-selection]
(codec/encode-str
{:build-id identity/build-id
:cases (cases/collect-cases (transit/decode-str encoded-selection))}))
(defn build-identity
[]
(codec/encode-str (identity/data)))

View File

@ -0,0 +1,47 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns benches.render-wasm.node.catalog
"Loads case descriptors from a selected build, without the runner's registry."
(:require
["module" :as node-module]
[app.common.transit :as transit]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.declarations :as declarations]
[benches.render-wasm.identity :as identity]))
(defn- load-catalog
[build]
(let [cases-path (:cases-path build)]
(if (exists? js/require)
(js/require cases-path)
((node-module/createRequire cases-path) cases-path))))
(defn build-identity
"Reads and validates the selected catalog's compiled build facts."
[build]
(let [loaded (transit/decode-str (.buildIdentity ^js (load-catalog build)))]
(identity/check (:id build) loaded)
loaded))
(defn collect
"Requires the selected cases.cjs and checks both identity responses.
build comes from artifacts/load-build or a newly completed build. The
createRequire branch also supports the Node ESM test entry points."
[build selection]
(let [catalog (load-catalog build)
loaded (transit/decode-str (.buildIdentity ^js catalog))]
(identity/check (:id build) loaded)
(let [response (transit/decode-str
(.collectCases ^js catalog (codec/encode-str selection)))
cases (:cases response)]
(identity/check (:id build) response)
(when-not (and (vector? cases) (seq cases))
(throw (ex-info "renderer build returned an invalid case catalog"
{:type ::invalid-catalog
:build-id (:id build)})))
(mapv declarations/check-collected-case cases))))

View File

@ -5,52 +5,30 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.node.pilot
"The diagnostic pilot executes one unscored case in headless Chromium.
An unscored attempt checks integration without a performance conclusion.
Stdout contains one raw RunRecord schema3 in Transit. The record
stores the saved plan, provenance, preparation, attempt and remaining slots.
"Executes one unscored case using a prepared or retained renderer build.
Stdout contains one raw RunRecord schema3 in Transit; build IDs, progress and
reports go to stderr. The saved plan always has 0 warmups and 1 attempt.
Node/browser summaries must agree outside measurement.
THIS IS A SMOKE TEST AND THROWAWAY CODE. DO NOT USE THIS DESIGN AS GUIDANCE.
Build and startup have separate bounds. The case deadline covers preparation
and its one attempt; screenshots, reporting and disposal stay outside it.
Exit code 0 means the diagnostic completed, not a performance conclusion.
TODO(mem:render-wasm/performance/cljs-rewrite/10-process-build-and-server):
the inline static server and artifact layout here are pilot scaffolding.
Ticket 10 owns staging and server ownership; this only serves the release
browser bundle, the prepared renderer artifacts and `pilot.html` on an
ephemeral 127.0.0.1 port.
TODO(mem:render-wasm/performance/cljs-rewrite/11-runner-and-failure-accounting):
CLI surface, orchestration style, attempt loop and exit policy belong to
ticket 11. Raw `.then` chains below are diagnostic scaffolding, not the
runner's interop pattern.
Exit codes: 0 when the case completes; 1 on case failures, harness errors and
timeouts. Failures retain raw records. A timeout closes the browser, including
a synchronously blocked page.
Usage, from `frontend/` with Playwright's Chromium installed:
Follow README.md's prepared renderer release commands first.
clojure -M:dev:renderer-bench release bench-render-wasm-browser
pnpm run build:renderer-benchmarks:pilot
node target/performance/render-wasm/pilot.cjs --seed 42 --screenshot /tmp/pilot-rects.png
The pilot serves the release browser bundle, so compile
`bench-render-wasm-browser` first (after the prepared renderer build
refreshes `shared.js`). Flags: `--seed N` (default 42),
`--timeout-ms N` (default 30000), `--screenshot PATH` (optional untimed
capture for visual inspection)."
Example: node target/performance/render-wasm/pilot.cjs --build ID
--case rects/pan --seed 42 --warmups 0 --attempts 1"
(:require
["child_process" :as child-process]
["fs" :as fs]
["http" :as http]
["module" :as node-module]
["os" :as os]
["path" :as path]
["playwright" :as playwright]
["playwright/package.json" :as playwright-package]
[app.common.transit :as t]
[benches.render-wasm.cases :as cases]
[app.common.transit :as transit]
[benches.render-wasm.declarations :as declarations]
[benches.render-wasm.failures :as failures]
[benches.render-wasm.measurement :as measurement]
[benches.render-wasm.node.artifacts :as artifacts]
[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.process :as process]
[benches.render-wasm.node.server :as server]
[benches.render-wasm.random :as random]
[benches.render-wasm.report.format :as format]
[benches.render-wasm.report.summarize :as summary]
@ -60,133 +38,123 @@
(def ^:private default-seed 42)
(def ^:private default-timeout-ms 30000)
(defn- frontend-root
"Resolves the frontend checkout root from the compiled pilot location
(`target/performance/render-wasm/pilot.cjs`, next to `runner.cjs`). Ticket 10
owns command cwd resolution; the pilot pins its own roots instead."
[]
(path/resolve js/__dirname ".." ".." ".."))
(def ^:private mime
{".html" "text/html"
".js" "text/javascript"
".wasm" "application/wasm"
".json" "application/json"})
(defn- safe-join
"Joins `sub` under `root`, returning nil when it escapes (path traversal)."
[root sub]
(let [joined (path/join root sub)]
(when-not (str/includes? (path/relative root joined) "..")
joined)))
(defn- serve-file!
"Serves an existing artifact with its MIME type, or returns a missing status."
[^js res file]
(if (and (some? file) (fs/existsSync file))
(let [ext (path/extname file)]
(.writeHead res 200 #js {"Content-Type" (get mime ext "application/octet-stream")})
(.end res (fs/readFileSync file)))
(do (.writeHead res 404 #js {"Content-Type" "text/plain"})
(.end res "not found"))))
(defn- start-server!
"Serves the pilot page, the release browser bundle and the prepared
renderer artifacts. Returns a promise of `{server port}`."
[browser-dir js-dir html-file]
(js/Promise.
(fn [resolve _reject]
(let [^js server (http/createServer
(fn [^js req ^js res]
(let [url (.-url ^js req)]
(cond
(= url "/") (serve-file! res html-file)
(= url "/pilot.html") (serve-file! res html-file)
(str/starts-with? url "/bench/")
(serve-file! res (safe-join browser-dir (subs url (count "/bench/"))))
(str/starts-with? url "/js/")
(serve-file! res (safe-join js-dir (subs url (count "/js/"))))
:else (do (.writeHead res 404 #js {"Content-Type" "text/plain"})
(.end res "not found"))))))]
(.listen server 0 "127.0.0.1"
(fn [] (resolve #js {"server" server
"port" (.-port (.address server))})))))))
(defn- usage
"Returns the diagnostic pilot's command syntax."
[]
"pilot [--case SCENE/NAME] [--seed N] [--timeout-ms N] [--screenshot PATH]")
(str "pilot [--build ID] [--case SCENE/NAME] [--seed N]\n"
" [--timeout-ms N] [--build-timeout-ms N] [--startup-timeout-ms N]\n"
" [--no-default-features] [--features NAME,NAME]\n"
" [--warmups 0] [--attempts 1] [--screenshot PATH] [--help]\n"
"Defaults: rects/load, seed 42, timeout 30000, build timeout 300000,\n"
"startup timeout 30000, 0 warmups, 1 attempt.\n"
"--build cannot be combined with feature-selection flags."))
(defn- parse-args
"Resolves one case, seed, deadline and optional screenshot path."
(defn- invalid-args
[message]
(throw (ex-info message {:type ::invalid-args})))
(defn- parse-integer
[flag value]
(when-not (re-matches #"[0-9]+" value)
(invalid-args (str flag " requires a nonnegative integer")))
(let [number (js/Number value)]
(when-not (js/Number.isSafeInteger number)
(invalid-args (str flag " requires a safe integer")))
number))
(defn- parse-timeout
[flag value]
(let [number (parse-integer flag value)]
(when-not (<= 1 number 2147483647)
(invalid-args (str flag " must be between 1 and 2147483647")))
number))
(defn parse-args
"Parses the diagnostic CLI without loading a catalog or starting resources.
Case availability and Cargo features are checked by the selected build APIs."
[argv]
(let [opts (loop [args argv
opts {:seed default-seed :timeout-ms default-timeout-ms
:case-id :rects/load}]
(if (empty? args)
opts
(let [[flag value & rest-args] args]
(cond
(= flag "--seed") (recur rest-args (assoc opts :seed (js/parseInt value 10)))
(= flag "--case") (recur rest-args (assoc opts :case-id (when value (keyword value))))
(= flag "--timeout-ms") (recur rest-args (assoc opts :timeout-ms (js/parseInt value 10)))
(= flag "--screenshot") (recur rest-args (assoc opts :screenshot value))
:else (recur rest-args (assoc opts ::invalid flag))))))
valid-timeout? (fn [n] (and (integer? n) (pos? n)))]
(if (and (nil? (::invalid opts))
(random/seed? (:seed opts)) (valid-timeout? (:timeout-ms opts))
(some #{(:case-id opts)} (cases/case-ids)))
opts
(loop [args argv
seen #{}
opts {:case-id :rects/load :seed default-seed
:timeout-ms default-timeout-ms
:build-timeout-ms process/default-build-timeout-ms
:startup-timeout-ms process/default-startup-timeout-ms
:warmups 0 :attempts 1
:features {:default-features? true :features []}}]
(if (empty? args)
(do
(.error js/console (str "pilot: invalid args " (pr-str opts)))
(.error js/console (usage))
(js/process.exit 1)))))
(when-not (:help? opts)
(when (and (:build-id opts) (some seen ["--no-default-features" "--features"]))
(invalid-args "--build cannot be combined with feature-selection flags"))
(when-not (random/seed? (:seed opts))
(invalid-args "--seed must be a uint32 integer"))
(when-not (and (zero? (:warmups opts)) (= 1 (:attempts opts)))
(invalid-args "the diagnostic pilot requires --warmups 0 and --attempts 1")))
(cond-> (dissoc opts :features-text)
(contains? opts :features-text)
(assoc-in [:features :features] (build/parse-feature-list (:features-text opts)))))
(let [[flag & more] args]
(cond
(#{"--help" "-h"} flag)
(recur more (conj seen flag) (assoc opts :help? true))
(= flag "--no-default-features")
(recur more (conj seen flag) (assoc-in opts [:features :default-features?] false))
(#{"--build" "--case" "--seed" "--timeout-ms" "--build-timeout-ms"
"--startup-timeout-ms" "--warmups" "--attempts" "--features" "--screenshot"} flag)
(let [[value & rest-args] more]
(when (or (nil? value) (str/starts-with? value "--"))
(invalid-args (str flag " requires a value")))
(when (and (#{"--build" "--screenshot"} flag) (str/blank? value))
(invalid-args (str flag " requires a nonempty value")))
(when (and (= flag "--case") (not (re-matches #"[^/\s]+/[^/\s]+" value)))
(invalid-args "--case requires SCENE/NAME"))
(recur rest-args (conj seen flag)
(case flag
"--build" (assoc opts :build-id value)
"--case" (assoc opts :case-id (keyword value))
"--seed" (assoc opts :seed (parse-integer flag value))
"--timeout-ms" (assoc opts :timeout-ms (parse-timeout flag value))
"--build-timeout-ms" (assoc opts :build-timeout-ms (parse-timeout flag value))
"--startup-timeout-ms" (assoc opts :startup-timeout-ms (parse-timeout flag value))
"--warmups" (assoc opts :warmups (parse-integer flag value))
"--attempts" (assoc opts :attempts (parse-integer flag value))
"--features" (assoc opts :features-text value)
"--screenshot" (assoc opts :screenshot value))))
:else
(invalid-args (str "unknown pilot option: " flag)))))))
(defn- trace
"Diagnostic line on stderr (transit)"
[message]
(.error js/console message))
(defn- print-result!
"Prints the raw schema3 record (transit)"
[record]
(println (result/encode record)))
(defn- git-provenance
"Reads the revision and dirty flag without saving status text or diffs."
[root]
(try
(let [opts #js {:cwd root :encoding "utf8"}]
{:sha (str/trim (child-process/execFileSync "git" #js ["rev-parse" "HEAD"] opts))
:dirty (not (str/blank? (child-process/execFileSync "git" #js ["status" "--porcelain"] opts)))})
(catch :default _ {:sha nil :dirty nil})))
(defn- pilot-metadata
"Captures available environment and declared build facts for an unscored pilot.
Prepared artifacts lack ticket10's stamp, so their functional identity stays
unverified. Environment capture uses a fixed allowlist."
[root opts]
(let [env (into {} (keep (fn [k]
(when-some [v (unchecked-get (.-env js/process) k)] [k v])))
["BUILD_MODE" "NODE_ENV" "PENPOT_WASM_PREPARED" "PENPOT_WASM_FUNCTION_NAMES"
"CARGO_BUILD_TARGET" "CARGO_NET_OFFLINE" "COREPACK_ENABLE_NETWORK"])
cpus (array-seq (os/cpus))]
{:git (git-provenance root)
:build {:functional {:prepared-artifact-settings :unverified :cljs-profile-marks false}
:provenance {:artifact-source :prepared-public-assets :declared-env env}}
:environment {:node (.-version js/process) :playwright (.-version playwright-package)
"Uses the selected manifest as primary provenance, including on reuse."
[selected-build opts]
(let [manifest (:manifest selected-build)
cpus (array-seq (os/cpus))
require-package (if (exists? js/require)
js/require
(node-module/createRequire (:cases-path selected-build)))
^js package (require-package "playwright/package.json")]
{:git (merge {:sha nil :dirty nil} (get-in manifest [:provenance :git]))
:build {:functional (:functional manifest)
:provenance (assoc (:provenance manifest) :build-id (:id selected-build))}
:environment {:node (.-version js/process) :playwright (.-version package)
:browser nil :platform (os/platform) :release (os/release) :arch (os/arch)
:cpu {:models (vec (distinct (map #(.-model %) cpus))) :logical-count (count cpus)}
:launch {:headless true :args ["--enable-gpu"]}}
:launch browser/launch-settings}
:scored? false
:diagnostics (select-keys opts [:seed :screenshot])}))
:diagnostics (assoc (select-keys opts [:seed :screenshot])
:runner-git {:sha nil :dirty nil}
:runtime-helper-identity :unverified)}))
(defn- complete-record
"Adds available preparation and attempt evidence, then records termination.
Warm setup errors leave the slot unattempted. Fresh setup belongs to the
attempted cold load and consumes its slot even when setup fails."
"Retains evidence and fixed slots. A fresh preparation consumes its attempt;
a failed warm preparation leaves the attempt unstarted."
[run preparation evidence attempted?]
(let [id (get-in run [:plan :cases 0 :id])
(let [id (get-in run [:plan :cases 0 :id])
run (cond-> run preparation (result/record-preparation preparation))
run (if attempted?
(result/record-attempt run (measurement/attempt id (:preparation-id preparation) false evidence))
@ -197,152 +165,171 @@
(not ok?) (assoc :failure (select-keys evidence [:status :phase :message :cause])
:partial (:partial evidence))))))
(defn- evaluate-bridge
"Calls a fixed bridge method with one Transit string and returns its Promise.
JSON quoting embeds the string in JavaScript; records use Transit only."
[^js page method text]
(.evaluate page (str "window.__benchBridge." method "(" (.stringify js/JSON text) ")")))
(defn- failed-record
[run preparation attempted? phase cause]
(let [evidence {:status "failed" :phase (name phase)
:message (or (ex-message cause) (str cause))
:cause (failures/describe-cause cause)}]
(if (= :running (get-in run [:termination :reason]))
(complete-record run preparation evidence attempted?)
(assoc run :termination {:reason :diagnostic-failed :failure evidence
:prior-termination (:termination run)}))))
(defn -main
"Runs one unscored attempt and verifies Node/browser summaries of its raw record."
[& argv]
(trace "pilot: parsing args")
(let [opts (parse-args (or argv []))
root (frontend-root)
bundle (path/join root "target" "performance" "render-wasm" "browser")
js-dir (path/join root "resources" "public" "js")
html (path/join root "performance" "bench" "render_wasm" "browser" "pilot.html")
seed (:seed opts)
selected (some #(when (= (:id %) (:case-id opts)) %)
(cases/collect-cases {:master-seed seed}))
deadline (:timeout-ms opts)
started-at (.toISOString (js/Date.))
initial-run (result/create-run {:run-id (str "pilot-" started-at) :started-at started-at
:plan {:cases [selected] :warmups 0 :repetitions 1
:timeout-policy {:attempt-ms deadline :pilot-total-ms deadline}}
:metadata (pilot-metadata root opts)})
(defn- ^:async execute-case
[session selected selected-build opts signal preparation-ref attempted-ref]
(let [page (:page session)
deadline (process/deadline (:timeout-ms opts))
bounds {:deadline deadline :signal signal :phase :pilot-case}
stamp (str "?build=" (js/encodeURIComponent (:id selected-build)))
request (transit/encode-str {:case selected :timeout-ms (:timeout-ms opts)
:module-url (str "/renderer/render-wasm.js" stamp)
:wasm-url (str "/renderer/render-wasm.wasm" stamp)})
prepared (transit/decode-str
(await (browser/within
(fn []
(when (= :fresh (:context selected))
(reset! attempted-ref true))
(browser/evaluate page "prepareScene" request))
bounds)))]
(if (= "ok" (:status prepared))
(do
(reset! preparation-ref (:preparation prepared))
(transit/decode-str
(await (browser/within
(fn []
(reset! attempted-ref true)
(browser/evaluate page "runPrepared"
(transit/encode-str
{:preparation-id (get-in prepared [:preparation :preparation-id])
:timeout-ms (process/remaining deadline)})))
bounds))))
prepared)))
(defn- ^:async check-diagnostics
[session run opts signal]
(let [^js page (:page session)
deadline (process/deadline (:startup-timeout-ms opts))
bounds {:deadline deadline :signal signal :phase :pilot-diagnostics}
report (summary/summarize run)]
(when-let [shot (:screenshot opts)]
(await (browser/within #(.screenshot page #js {:path shot :timeout (process/remaining deadline)})
bounds)))
(let [browser-report (transit/decode-str
(await (browser/within #(browser/evaluate page "summarize" (result/encode run))
bounds)))]
(when-not (= report browser-report)
(throw (ex-info "Node/browser summaries differ" {:type ::summary-mismatch})))
(trace "pilot: Node/browser summaries agree"))
(await (browser/within #(browser/evaluate page "dispose") bounds))))
(defn- ^:async run-pilot
[opts]
(let [root (artifacts/frontend-root)
controller (js/AbortController.)
signal (.-signal controller)
interrupted-ref (atom nil)
remove-signals (process/on-signals
(fn [name]
(when-not (.-aborted signal)
(reset! interrupted-ref name)
(.abort controller (ex-info "pilot interrupted" {:type ::interrupted :signal name})))))
host-ref (atom nil)
session-ref (atom nil)
preparation-ref (atom nil)
attempted-ref (atom false)
run-ref (atom initial-run)]
(-> (start-server! bundle js-dir html)
(.then
(fn [info]
(trace "pilot: server up")
(let [server (unchecked-get info "server")
port (unchecked-get info "port")
url (str "http://127.0.0.1:" port "/pilot.html")
close! (fn [] (js/Promise.resolve (.close server)))
wait-for-bench-ready
(fn [^js page] (fn [] (.waitForFunction page "window.__benchReady === true")))
evaluate-load
(fn [^js page] (fn [_]
(trace "pilot: bridge ready, evaluating")
(when (= :fresh (:context selected))
(reset! attempted-ref true))
(let [request (t/encode-str {:case selected :timeout-ms deadline
:module-url "/js/render-wasm.js"
:wasm-url "/js/render-wasm.wasm"})]
(-> (evaluate-bridge page "prepareScene" request)
(.then (fn [text]
(let [prepared (t/decode-str text)]
(if (= "ok" (:status prepared))
(do
(reset! preparation-ref (:preparation prepared))
(reset! attempted-ref true)
(evaluate-bridge page "runPrepared"
(t/encode-str {:preparation-id (get-in prepared [:preparation :preparation-id])
:timeout-ms deadline})))
text))))))))
attach-screenshot-path
(fn [^js page version] (fn [text]
(let [out (complete-record
(assoc-in @run-ref [:metadata :environment :browser] version)
@preparation-ref (t/decode-str text) @attempted-ref)
report (summary/summarize out)
check-report (fn [_]
(-> (evaluate-bridge page "summarize" (result/encode out))
(.then (fn [browser-summary]
(when-not (= report (t/decode-str browser-summary))
(throw (ex-info "Node/browser summaries differ" {})))
(trace "pilot: Node/browser summaries agree")
(trace (format/format-run report))
out))))]
(reset! run-ref out)
(-> (if-let [shot (:screenshot opts)]
(.screenshot page #js {"path" shot})
(js/Promise.resolve nil))
(.then check-report)))))
viewport #js {"viewport"
#js {"width" 1920 "height" 1080}
"deviceScaleFactor" 2}
;; Holder so the outer timeout path can close a browser
;; the work chain never returned (blocked page, or a
;; launch/context/page failure after launch).
browser-ref (atom nil)
chromium-launch (-> (.-chromium playwright)
(.launch #js {"args" #js ["--enable-gpu"]}))
work
(-> chromium-launch
(.then
(fn [^js pw-browser]
(reset! browser-ref pw-browser)
(let [version (.version pw-browser)]
(swap! run-ref assoc-in [:metadata :environment :browser] version)
(-> (.newContext pw-browser viewport)
(.then
(fn [^js context]
(-> (.newPage context)
(.then
(fn [^js page]
(trace "pilot: page open")
(-> (.goto page url)
(.then (wait-for-bench-ready page))
(.then (evaluate-load page))
(.then (attach-screenshot-path page version))
(.then (fn [out]
(-> (.evaluate page "window.__benchBridge.dispose()")
(.then (fn [_] (.close page)))
(.then (fn [_] (.close context)))
(.then (fn [_] (.close pw-browser)))
(.then (fn [_] out)))))
(.catch (fn [cause]
(.close pw-browser)
(throw cause))))))))))))))
guard (js/Promise.
(fn [_resolve reject]
(js/setTimeout
(fn [] (reject (ex-info "pilot timeout" {:timeout-ms deadline})))
deadline)))]
(-> (js/Promise.race #js [work guard])
(.then (fn [out]
(-> (close!)
(.then (fn [_]
(print-result! out)
(js/process.exit
(if (= :completed (get-in out [:termination :reason])) 0 1)))))))
(.catch (fn [cause]
;; The work chain may have left a browser open
;; (guard timeout, blocked page, post-launch
;; failure): close it before the server so no
;; Chromium is orphaned. Double close is safe.
(-> (if-let [b @browser-ref]
(-> (.close b)
(.catch (fn [_] nil)))
(js/Promise.resolve nil))
(.then (fn [_] (close!)))
(.then (fn [_]
(if (= :running (get-in @run-ref [:termination :reason]))
(print-result! (complete-record @run-ref @preparation-ref
{:status "failed" :phase "pilot-harness"
:message (or (ex-message cause) (str cause))
:cause (failures/describe-cause cause)}
@attempted-ref))
(print-result! (assoc @run-ref :termination
{:reason :diagnostic-failed :cause (failures/describe-cause cause)})))
(js/process.exit 1))))))))))
(.catch (fn [cause]
(print-result! (complete-record initial-run nil
{:status "failed" :phase "pilot-startup"
:message (or (ex-message cause) (str cause))
:cause (failures/describe-cause cause)} false))
(js/process.exit 1))))))
attempted-ref (atom false)
run-ref (atom nil)
phase-ref (atom :pilot-build)
started-at (.toISOString (js/Date.))]
(letfn [(failed [cause phase]
(trace (str "pilot: " (or (ex-message cause) (str cause))))
(when-some [data (ex-data cause)]
(trace (pr-str data)))
(when @run-ref
(swap! run-ref failed-record @preparation-ref @attempted-ref phase cause)))]
(try
(let [selected-build (if-let [id (:build-id opts)]
(do
(trace (str "pilot: using build " id))
(artifacts/load-build root id))
(await (build/prepare
{:root root :features (:features opts)
:build-timeout-ms (:build-timeout-ms opts) :signal signal
:on-created #(trace (str "pilot: build " (:id %)))})))
_ (reset! phase-ref :pilot-catalog)
descriptors (catalog/collect selected-build
{:master-seed (:seed opts)
:filter (result/case-name (:case-id opts))})
selected (or (some #(when (= (:case-id opts) (:id %)) %) descriptors)
(throw (ex-info "case is absent from the selected build"
{:build-id (:id selected-build) :case-id (:case-id opts)})))
startup-end (process/deadline (:startup-timeout-ms opts))]
(reset! run-ref
(result/create-run
{:run-id (str "pilot-" started-at) :started-at started-at
:plan {:cases [selected] :warmups 0 :repetitions 1
:timeout-policy {:attempt-ms (:timeout-ms opts) :pilot-case-ms (:timeout-ms opts)
:build-ms (:build-timeout-ms opts) :startup-ms (:startup-timeout-ms opts)}}
:metadata (pilot-metadata selected-build opts)}))
(reset! phase-ref :pilot-provenance)
(swap! run-ref assoc-in [:metadata :diagnostics :runner-git]
(await (build/git-provenance root {:deadline startup-end :signal signal})))
(reset! phase-ref :pilot-server-startup)
(reset! host-ref (await (server/open selected-build
{:startup-timeout-ms (process/remaining startup-end)
:signal signal})))
(reset! phase-ref :pilot-browser-startup)
(reset! session-ref (await (browser/open @host-ref
{:viewport (declarations/resolve-viewport (:view selected))
:startup-timeout-ms (:startup-timeout-ms opts)
:deadline startup-end :signal signal})))
(swap! run-ref assoc-in [:metadata :environment :browser] (:version @session-ref))
(trace "pilot: retained browser identity verified")
(reset! phase-ref :pilot-case)
(let [evidence (await (execute-case @session-ref selected selected-build opts signal
preparation-ref attempted-ref))]
(swap! run-ref complete-record @preparation-ref evidence @attempted-ref))
(reset! phase-ref :pilot-diagnostics)
(await (check-diagnostics @session-ref @run-ref opts signal)))
(catch :default cause
(failed cause @phase-ref))
(finally
(try
(when @session-ref
(try
(await (browser/close @session-ref))
(catch :default cause
(failed cause :pilot-browser-cleanup))))
(when @host-ref
(try
(await (server/close @host-ref))
(catch :default cause
(failed cause :pilot-server-cleanup))))
(finally
(remove-signals)))))
(when (and @run-ref @interrupted-ref)
(swap! run-ref update :termination assoc :reason :interrupted :signal @interrupted-ref))
(when @run-ref
(try
(trace (format/format-run (summary/summarize @run-ref)))
(catch :default cause
(failed cause :pilot-report))))
@run-ref)))
(defn ^:async -main
"Runs the diagnostic and lets Node drain output after owned shutdown."
[& argv]
(try
(let [opts (parse-args (or argv []))]
(if (:help? opts)
(do
(println (usage))
(set! (.-exitCode js/process) 0))
(let [run (await (run-pilot opts))]
(when run
(println (result/encode run)))
(set! (.-exitCode js/process) (if (= :completed (get-in run [:termination :reason])) 0 1)))))
(catch :default cause
(trace (str "pilot: " (or (ex-message cause) (str cause))))
(when (= ::invalid-args (:type (ex-data cause)))
(trace (usage)))
(set! (.-exitCode js/process) 1))))

View File

@ -0,0 +1,275 @@
;; 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.process
"Deadline-bound Node commands with owned POSIX process groups."
(:require
["child_process" :as child-process]
["fs" :as fs]
[clojure.string :as str]))
(def default-build-timeout-ms 300000)
(def default-startup-timeout-ms 30000)
(def default-termination-grace-ms 5000)
(defn deadline
"Returns an absolute Date.now() timestamp, in milliseconds. All commands
in a preparation can share it, including commands waiting for a lock.
This is a wall clock deadline, so clock changes affect the time left."
[timeout-ms]
(+ (js/Date.now) timeout-ms))
(defn remaining
"Returns the nonnegative milliseconds left on a Date.now() deadline."
[deadline]
(max 0 (- deadline (js/Date.now))))
(defn- signal-group
[pid signal]
(try
(.kill js/process (- pid) signal)
true
(catch :default cause
(if (= "ESRCH" (.-code cause))
false
(throw cause)))))
(defn- linux-group-member?
[pid entry]
(when (re-matches #"\d+" entry)
(try
;; comm may contain spaces or ')'; fields after its final ')' start
;; with state, ppid and pgrp. Zombies retain a group but no resources.
(let [stat (fs/readFileSync (str "/proc/" entry "/stat") "utf8")
fields (str/split (str/trim (subs stat (inc (.lastIndexOf stat ")")))) #"\s+")]
(and (= pid (js/Number (nth fields 2)))
(not (contains? #{"Z" "X" "x"} (first fields)))))
(catch :default cause
(if (contains? #{"ENOENT" "ESRCH"} (.-code cause))
false
(throw cause))))))
(defn- group-running?
[pid]
(and (signal-group pid 0)
(if (= "linux" (.-platform js/process))
;; Container init need not reap orphan zombies promptly. Waiting
;; for kill(-pgid, 0) to return ESRCH can therefore hang forever.
(some #(linux-group-member? pid %) (array-seq (fs/readdirSync "/proc")))
true)))
(defn- pause
[ms]
(js/Promise. (fn [resolve _] (js/setTimeout resolve ms))))
(defn- ^:async terminate-group
[pid grace-deadline]
(try
(signal-group pid "SIGTERM")
(loop []
(when (group-running? pid)
(when (zero? (remaining grace-deadline))
;; Include members forked while earlier members handled termination.
(signal-group pid "SIGKILL"))
(await (pause 10))
(recur)))
(catch :default cause
;; A failed liveness probe must not leave a running compiler or lock owner.
(signal-group pid "SIGKILL")
(throw cause))))
(defn- process-error
[{:keys [command args cwd]} result {:keys [type message cause data]}]
(ex-info message
(merge {:type type :command command :args args :cwd cwd} result data)
cause))
(defn- cancelled
[^js signal]
{:type :process-cancelled
:message "Command cancelled"
:data {:reason (.-reason signal)}})
(defn- timed-out
[deadline]
{:type :process-timeout
:message "Command deadline expired"
:data {:deadline deadline}})
(defn- spawn-failed
[^js cause]
{:type :process-spawn
:message "Could not spawn command"
:cause cause
:data {:code (.-code cause)}})
(defn- stream-done
[^js stream]
(js/Promise.
(fn [resolve _]
(.once stream "end" resolve)
(.once stream "close" resolve)
(.once stream "error" resolve))))
(defn- drain-output
"Allow queued pipe data to drain, but never wait indefinitely for an EOF."
[done grace-deadline]
(js/Promise.
(fn [resolve _]
(let [timer (js/setTimeout resolve (max 10 (remaining grace-deadline)))]
(.then done
(fn [_]
(js/clearTimeout timer)
(resolve)))))))
(defn ^:async run
"Spawns command with literal args, cwd and env merged over process.env.
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
strings are empty. Returns a promise of
{:exit-code 0 :stdout string :stderr string}.
Failures reject with ex-info carrying :command, :exit-code, :signal and
output. Types are :process-exit, :process-spawn, :process-timeout and
:process-cancelled; output/cleanup errors use :process-output/:process-cleanup.
The detached POSIX group belongs to this call, including descendants left
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?]
:or {termination-grace-ms default-termination-grace-ms capture-output? true}
:as options}]
(let [empty-result {:exit-code nil :signal nil :stdout "" :stderr ""}
environment (js/Object.assign #js {} (.-env js/process) (if (map? env) (clj->js env) env))]
(when (and signal (.-aborted ^js signal))
(throw (process-error options empty-result (cancelled signal))))
(when (zero? (remaining deadline))
(throw (process-error options empty-result (timed-out deadline))))
(let [^js child (try
(child-process/spawn command (clj->js args)
#js {:cwd cwd
:env environment
:detached true
:stdio #js ["pipe" "pipe" "pipe"]})
(catch :default cause
(throw (process-error options empty-result (spawn-failed cause)))))
exited (js/Promise.
(fn [resolve _]
(.once child "exit"
(fn [code signal]
(resolve {:exit-code code :signal signal})))
(.once child "error"
(fn [cause]
(resolve (spawn-failed cause))))))]
(try
(if-not (.-pid child)
;; A failed spawn may not provide stdin/stdout/stderr at all.
(throw (process-error options empty-result (await exited)))
(let [stdout (volatile! [])
stderr (volatile! [])
output-failure (volatile! nil)
complete (volatile! nil)
timeout (volatile! nil)
abort (fn [_] (@complete (cancelled signal)))
stop-waiting (fn []
(js/clearTimeout @timeout)
(when signal
(.removeEventListener ^js signal "abort" abort)))
stream-error (fn [stream cause message]
(let [failure {:type :process-output
:message message
:cause cause
:data {:stream stream}}]
(vreset! output-failure failure)
(@complete failure)))
route (fn [parts stream text]
(when capture-output?
(vswap! parts conj text))
(when on-output
(try
(on-output text stream)
(catch :default cause
(stream-error stream cause "Command output callback failed")))))
output-done (js/Promise.all #js [(stream-done (.-stdout child))
(stream-done (.-stderr child))])
completed (js/Promise.
(fn [resolve _]
(vreset! complete resolve)
(.then exited resolve)
(letfn [(check-deadline []
(let [ms (remaining deadline)]
(if (zero? ms)
(resolve (timed-out deadline))
;; Node timers overflow above a signed 32-bit delay.
(vreset! timeout
(js/setTimeout check-deadline (min ms 2147483647))))))]
(check-deadline))
(when signal
(.addEventListener ^js signal "abort" abort #js {:once true})
(when (.-aborted ^js signal)
(abort nil)))))]
(try
(.setEncoding (.-stdout child) "utf8")
(.setEncoding (.-stderr child) "utf8")
(.on (.-stdout child) "data" #(route stdout :stdout %))
(.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"))
;; EPIPE is normal when a command exits without reading stdin.
(.on (.-stdin child) "error"
(fn [cause]
(when-not (= "EPIPE" (.-code cause))
(stream-error :stdin cause "Could not close command stdin"))))
(.end (.-stdin child))
(let [reason (await completed)
grace-deadline (benches.render-wasm.node.process/deadline termination-grace-ms)]
(stop-waiting)
(let [cleanup-failure (try
(await (terminate-group (.-pid child) grace-deadline))
nil
(catch :default cause
{:type :process-cleanup
:message "Could not terminate command group"
:cause cause}))
exit (await exited)]
(await (drain-output output-done grace-deadline))
(let [result {:exit-code (:exit-code exit)
:signal (:signal exit)
:stdout (str/join "" @stdout)
:stderr (str/join "" @stderr)}
failure (or (when (:type reason) reason)
@output-failure
cleanup-failure
(when (not= 0 (:exit-code exit))
{:type :process-exit :message "Command exited unsuccessfully"}))]
(if failure
(throw (process-error options result failure))
(dissoc result :signal)))))
(finally
(stop-waiting)))))
(finally
(when-let [stream (.-stdin child)]
(.destroy ^js stream))
(when-let [stream (.-stdout child)]
(.destroy ^js stream))
(when-let [stream (.-stderr child)]
(.destroy ^js stream)))))))
(defn on-signals
"Installs SIGINT/SIGTERM callbacks receiving the signal name. Returns an
idempotent remover. The caller can abort its work and let output drain."
[callback]
(let [interrupt (fn [] (callback "SIGINT"))
terminate (fn [] (callback "SIGTERM"))]
(.on js/process "SIGINT" interrupt)
(.on js/process "SIGTERM" terminate)
(fn []
(.removeListener js/process "SIGINT" interrupt)
(.removeListener js/process "SIGTERM" terminate))))

View File

@ -5,64 +5,82 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.node.runner
"Node CLI entry for the CLJS renderer benchmark suite.
Scaffolding only. Commands, options, result reporting and failure
accounting are owned by the tickets referenced below."
"Build preparation and managed artifact cleanup for renderer benchmarks."
(:require
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.process :as process]
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]))
(enable-console-print!)
(def cli-options
[["-h" "--help" "Print this help"]])
[["-h" "--help" "Print this help"]
[nil "--[no-]default-features" "Enable Cargo defaults" :default true]
[nil "--features FEATURES" "Comma-separated functional Cargo features"
:parse-fn build/parse-feature-list]
[nil "--build-timeout-ms MS" "Complete preparation deadline"
:default process/default-build-timeout-ms :parse-fn js/Number
:validate [#(and (js/Number.isSafeInteger %) (pos? %)) "Must be a positive integer"]]
[nil "--only-builds" "Purge build attempts"]
[nil "--only-runs" "Purge managed runs"]])
(defn- argv
[]
(let [args (->> (.-argv js/process)
(array-seq)
(drop 2))]
;; `pnpm run <script> -- ...` forwards the separator, so drop one
;; leading `--` before handing the args to tools.cli.
(cond-> args
(= "--" (first args)) rest)))
(defn- usage
(defn usage
[summary]
(str "Usage: node target/performance/render-wasm/runner.cjs [options]\n\n"
"Options:\n"
summary "\n\n"
"No command is implemented yet. Upcoming tickets add:\n"
" run benchmark standard scenes and operations\n"
" ab feature A/B matrix\n"
" compare offline comparison of two result files\n\n"
"Commands, options and reporting arrive with the later renderer\n"
"benchmark tickets."))
(str "Usage: runner build [options]\n"
" runner purge [--only-builds | --only-runs]\n\n"
"build prints one attempt ID after storage initialization. Exit 0 means\n"
"ready; errors retain the build.transit and build.log for that ID.\n"
"Progress goes to stderr. Preparation requires an idle checkout with\n"
"dependencies installed. Keep renderer watchers stopped until it ends.\n\n"
"purge requires an idle machine and deletes managed builds and runs.\n\n"
summary))
(defn- fail!
[message]
(js/console.error message)
;; Set the exit code instead of calling `process.exit` so piped output is
;; not truncated; nothing else keeps the process alive.
(set! (.-exitCode js/process) 1))
(defn parse-args
[args]
(let [args (cond-> args (= "--" (first args)) rest)
{:keys [arguments options errors summary]} (parse-opts args cli-options)
command (first arguments)
flags (into #{} (comp (filter #(str/starts-with? % "--"))
(map #(first (str/split % #"=" 2)))) args)]
(when (seq errors)
(throw (ex-info (str/join "\n" errors) {:type ::invalid-args})))
(when-not (:help options)
(when-not (and (= 1 (count arguments)) (contains? #{"build" "purge"} command))
(throw (ex-info "expected build or purge; try --help" {:type ::invalid-args})))
(when (and (:only-builds options) (:only-runs options))
(throw (ex-info "--only-builds and --only-runs are mutually exclusive" {:type ::invalid-args})))
(when (and (= command "build") (some flags ["--only-builds" "--only-runs"]))
(throw (ex-info "purge category flags require purge" {:type ::invalid-args})))
(when (and (= command "purge")
(some flags ["--features" "--default-features" "--no-default-features" "--build-timeout-ms"]))
(throw (ex-info "build options require build" {:type ::invalid-args}))))
{:command command :options options :summary summary}))
(defn -main
[& _]
(let [{:keys [options arguments errors summary]} (parse-opts (argv) cli-options)]
(cond
(:help options)
(println (usage summary))
(seq errors)
(fail! (str/join "\n" errors))
;; TODO(mem:render-wasm/performance_tests/cljs-rewrite/10-process-build-and-server,
;; mem:render-wasm/performance_tests/cljs-rewrite/11-runner-and-failure-accounting,
;; mem:render-wasm/performance_tests/cljs-rewrite/14-custom-measured-operations):
;; dispatch `run`, `ab` and `compare` instead of failing.
(seq arguments)
(fail! (str "Unknown command: " (str/join " " arguments) "\nTry --help"))
:else
(fail! "No command given\nTry --help"))))
(defn ^:async -main
[& args]
(try
(let [{:keys [command options summary]} (parse-args args)
root (artifacts/frontend-root)]
(cond
(:help options) (println (usage summary))
(= command "purge")
(artifacts/purge root (cond (:only-builds options) :builds
(:only-runs options) :runs
:else :all))
(= command "build")
(let [controller (js/AbortController.)
remove-signals (process/on-signals #(.abort controller %))]
(try
(await (build/prepare {:root root
:features {:default-features? (:default-features options)
:features (or (:features options) [])}
:build-timeout-ms (:build-timeout-ms options)
:signal (.-signal controller)
:on-created #(println (:id %))}))
(finally (remove-signals))))))
(catch :default cause
(.error js/console (or (ex-message cause) (str cause)))
(when-let [data (ex-data cause)] (.error js/console (pr-str data)))
(set! (.-exitCode js/process) 1))))

View File

@ -0,0 +1,178 @@
;; 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 INC
(ns benches.render-wasm.node.server
"An owned loopback HTTP server for one immutable renderer build."
(:require
["fs" :as fs]
["http" :as http]
["path" :as path]
[benches.render-wasm.node.process :as process]
[clojure.string :as str]))
(def ^:private mime
{".html" "text/html; charset=utf-8"
".js" "application/javascript"
".cjs" "application/javascript"
".mjs" "application/javascript"
".wasm" "application/wasm"
".css" "text/css; charset=utf-8"
".json" "application/json"
".svg" "image/svg+xml"
".png" "image/png"})
(def ^:private owners (js/WeakMap.))
(defn- contained?
[root file]
(let [relative (path/relative root file)]
(and (not (path/isAbsolute relative))
(not= relative "..")
(not (str/starts-with? relative (str ".." path/sep))))))
(defn- request-file
[root url]
(let [pathname (js/decodeURIComponent (first (str/split url #"[?#]" 2)))]
(when-not (str/starts-with? pathname "/")
(throw (ex-info "invalid request path" {:status 400})))
(when (or (str/includes? pathname "\u0000")
(str/includes? pathname "\\")
(some #{".."} (str/split pathname #"/")))
(throw (ex-info "forbidden request path" {:status 403})))
(let [relative (if (= pathname "/") "index.html" (subs pathname 1))
file (path/resolve root relative)]
(when-not (contained? root file)
(throw (ex-info "forbidden request path" {:status 403})))
(let [resolved (fs/realpathSync file)]
(when-not (contained? root resolved)
(throw (ex-info "forbidden artifact symlink" {:status 403})))
resolved))))
(defn- respond-error
[^js request ^js response status]
(.writeHead response status #js {"Content-Type" "text/plain; charset=utf-8"})
(.end response (when-not (= "HEAD" (.-method request))
(case status
400 "bad request"
403 "forbidden"
404 "not found"
405 "method not allowed"
"server error"))))
(defn- serve
[root ^js request ^js response]
(if-not (contains? #{"GET" "HEAD"} (.-method request))
(do
(.setHeader response "Allow" "GET, HEAD")
(respond-error request response 405))
(try
(let [file (request-file root (.-url request))
^js stat (fs/statSync file)]
(if-not (.isFile stat)
(respond-error request response 404)
(let [body (when (= "GET" (.-method request)) (fs/readFileSync file))]
(.writeHead response 200
#js {"Content-Type" (get mime (path/extname file) "application/octet-stream")
"Content-Length" (.-size stat)})
(.end response body))))
(catch :default error
(respond-error request response
(or (:status (ex-data error))
(when (instance? js/URIError error) 400)
(case (.-code error)
"ENOENT" 404
"ENOTDIR" 404
"EACCES" 403
500)))))))
(defn close
"Closes an owned host once and destroys only that server's connections.
Repeated calls return the same shutdown promise, including during startup."
[{:keys [server]}]
(let [{:keys [sockets shutdown]} (.get owners server)]
(or @shutdown
(let [result (js/Promise.
(fn [resolve reject]
(try
(.close ^js server
(fn [error]
(if (and error (not= "ERR_SERVER_NOT_RUNNING" (.-code error)))
(reject error)
(resolve nil))))
(doseq [socket (array-seq (js/Array.from sockets))]
(.destroy ^js socket))
(catch :default error
(if (= "ERR_SERVER_NOT_RUNNING" (.-code error))
(resolve nil)
(reject error))))))]
(reset! shutdown result)
result))))
(defn open
"Starts serving build's directory on 127.0.0.1 and an ephemeral port.
Resolves to {:server NodeHttpServer :base-url string :build build}. Startup
has a 30000 ms default timeout and accepts an optional AbortSignal. Abort,
timeout and listen errors close the owned server before rejecting."
([build] (open build {}))
([build {:keys [startup-timeout-ms signal] :or {startup-timeout-ms process/default-startup-timeout-ms}}]
(js/Promise.
(fn [resolve reject]
(let [root (fs/realpathSync (:dir build))
^js server (http/createServer #(serve root %1 %2))
sockets (js/Set.)
shutdown (atom nil)
settled (atom false)
controller (js/AbortController.)
timer (atom nil)
host {:server server :build build}]
(.set owners server {:sockets sockets :shutdown shutdown})
(.on server "connection"
(fn [socket]
(.add sockets socket)
(.once ^js socket "close" #(.delete sockets socket))
(when @shutdown
(.destroy ^js socket))))
(letfn [(cleanup []
(js/clearTimeout @timer)
(.removeListener server "error" failed)
(.removeListener server "listening" listening)
(when signal
(.removeEventListener ^js signal "abort" aborted)))
(failed [error]
(when (compare-and-set! settled false true)
(cleanup)
(.abort controller)
(.then (close host)
(fn [_] (reject error))
(fn [_] (reject error)))))
(aborted []
(failed (ex-info "renderer server startup aborted" {:type ::aborted})))
(listening []
(when (compare-and-set! settled false true)
(cleanup)
(resolve (assoc host :base-url
(str "http://127.0.0.1:" (.-port (.address server)))))))]
(.once server "error" failed)
(.once server "listening" listening)
(when signal
(.addEventListener ^js signal "abort" aborted #js {:once true}))
(if (and signal (.-aborted ^js signal))
(aborted)
(do
(reset! timer
(js/setTimeout
#(failed (ex-info "renderer server startup timed out"
{:type ::startup-timeout
:timeout-ms startup-timeout-ms}))
startup-timeout-ms))
(try
(.listen server #js {:host "127.0.0.1"
:port 0
:signal (.-signal controller)})
(catch :default error
(failed error)))))))))))

View File

@ -232,10 +232,9 @@
:bench-render-wasm-browser
{:target :esm
:output-dir "target/performance/render-wasm/browser/"
;; Bundle npm deps (date-fns via app.common): the pilot serves plain
;; static files with no import-map resolver. TODO(10): revisit when
;; ticket 10 owns staging; artifacts must stay self-contained.
:output-dir #shadow/env ["RENDER_BENCH_BROWSER_DIR" :default "target/performance/render-wasm/browser/"]
:closure-defines {benches.render-wasm.identity/build-id #shadow/env ["RENDER_BENCH_BUILD_ID" :default "unprepared"]}
;; Bundle npm dependencies for the dedicated static host.
:js-options {:js-provider :shadow}
:modules
@ -251,4 +250,17 @@
{:compiler-options
{:fn-invoke-direct true
:elide-asserts true
:anon-fn-naming-policy :off}}}}}
:anon-fn-naming-policy :off}}}
:bench-render-wasm-catalog
{:target :node-library
:output-to #shadow/env ["RENDER_BENCH_CASES_PATH" :default "target/performance/render-wasm/cases.cjs"]
:output-dir "target/performance/render-wasm/catalog/"
:exports {:collectCases benches.render-wasm.node.case-catalog/collect-cases
:buildIdentity benches.render-wasm.node.case-catalog/build-identity}
:closure-defines {benches.render-wasm.identity/build-id #shadow/env ["RENDER_BENCH_BUILD_ID" :default "unprepared"]}
:compiler-options {:output-feature-set :es2020
:warnings {:fn-deprecated false}}
:release {:compiler-options {:fn-invoke-direct true
:elide-asserts true
:anon-fn-naming-policy :off}}}}}

View File

@ -0,0 +1,406 @@
;; 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 INC
(ns performance-tests.render-wasm.artifacts-test
(:require
["fs" :as fs]
["os" :as os]
["path" :as path]
["worker_threads" :as workers]
[app.common.transit :as transit]
[benches.render-wasm.codec :as codec]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.artifacts :as artifacts]
[benches.render-wasm.node.catalog :as catalog]
[cljs.test :as t :include-macros true]))
(def ^:private temporary-root (atom nil))
(def ^:private selection {:default-features? true :features []})
(def ^:private provenance {:git {:sha "test-revision" :dirty false}})
(t/use-fixtures :each
{:before #(reset! temporary-root
(fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-artifacts-")))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
(defn- create-build
[]
(artifacts/create-build @temporary-root selection provenance))
(defn- write-file
[file content]
(fs/mkdirSync (path/dirname file) #js {:recursive true})
(fs/writeFileSync file content "utf8"))
(defn- complete-files
[build]
(write-file (:cases-path build) "module.exports = {};")
(write-file (path/join (:browser-dir build) "browser.js") "export default {};")
(write-file (path/join (:renderer-dir build) "render-wasm.js") "export default {};")
(fs/writeFileSync (path/join (:renderer-dir build) "render-wasm.wasm")
(js/Buffer.from #js [0 97 115 109 1 0 0 0]))
(write-file (path/join (:renderer-dir build) "shared.js") "export default {};")
(write-file (:index-path build) "<!doctype html><title>selected build</title>")
build)
(defn- ready-build
[]
(let [build (complete-files (create-build))]
(artifacts/write-manifest build (assoc (:manifest build) :status :ready))))
(defn- failure
[f]
(try
(f)
nil
(catch :default error error)))
(t/deftest frontend-root-is-independent-of-caller-cwd
(let [expected (artifacts/frontend-root)
previous (.cwd js/process)]
(try
(.chdir js/process @temporary-root)
(t/is (= expected (artifacts/frontend-root)))
(t/is (.isFile (fs/statSync (path/join expected "deps.edn"))))
(t/is (.isDirectory (fs/statSync
(path/join expected "performance" "benches" "render_wasm"))))
(finally
(.chdir js/process previous)))))
(t/deftest create-build-retains-its-initial-release-evidence
(let [selected {:default-features? false :features ["feature-one" "feature-two"]}
build (artifacts/create-build @temporary-root selected provenance)
manifest (transit/decode-str (fs/readFileSync (:manifest-path build) "utf8"))]
(t/is (re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
(:id build)))
(t/is (= (path/join (artifacts/managed-root @temporary-root) "builds" (:id build))
(:dir build)))
(t/is (= (path/join (:dir build) "build.transit") (:manifest-path build)))
(t/is (= (path/join (:dir build) "index.html") (:index-path build)))
(t/is (= manifest (:manifest build)))
(t/is (= {:type :renderer-build :schema-version 1 :status :building}
(select-keys manifest [:type :schema-version :status])))
(t/is (= {:mode :release :default-features? false
:features ["feature-one" "feature-two"] :cljs-profile-marks false}
(:functional manifest)))
(t/is (= provenance (:provenance manifest)))
(t/is (= (:created-at manifest) (.toISOString (js/Date. (:created-at manifest)))))
(t/is (= (:created-at manifest) (:updated-at manifest)))
(t/is (= "" (fs/readFileSync (:log-path build) "utf8")))
(t/is (= (path/join (:dir build) "cases.cjs") (:cases-path build)))
(t/is (.isDirectory (fs/statSync (:browser-dir build))))
(t/is (.isDirectory (fs/statSync (:renderer-dir build))))))
(t/deftest ready-build-loads-all-selected-paths
(let [build (ready-build)
loaded (artifacts/load-build @temporary-root (:id build))]
(t/is (= build loaded))
(t/is (= (path/join (:dir build) "index.html") (:index-path loaded)))))
(t/deftest complete-building-files-can-be-checked-before-publishing-ready
(let [build (complete-files (create-build))]
(t/is (= build (artifacts/check-files build)))
(t/is (= :building (:status (transit/decode-str
(fs/readFileSync (:manifest-path build) "utf8")))))
(t/is (= ::artifacts/not-ready
(:type (ex-data (failure #(artifacts/load-build @temporary-root (:id build)))))))))
(t/deftest incomplete-building-files-are-rejected-before-publishing-ready
(doseq [relative ["cases.cjs" "browser/browser.js" "renderer/render-wasm.js"
"renderer/render-wasm.wasm" "renderer/shared.js" "index.html"]]
(let [build (complete-files (create-build))]
(fs/unlinkSync (path/join (:dir build) relative))
(t/is (some? (failure #(artifacts/check-files build))) relative)
(t/is (= :building (:status (transit/decode-str
(fs/readFileSync (:manifest-path build) "utf8"))))))))
(t/deftest building-and-failed-builds-are-not-loadable-and-retain-evidence
(let [building (create-build)
failed (create-build)
log "renderer compilation failed\n"]
(fs/appendFileSync (:log-path failed) log "utf8")
(artifacts/write-manifest failed (assoc (:manifest failed) :status :failed
:failure {:stage :renderer :message "compile failed"}))
(doseq [build [building failed]]
(t/is (= ::artifacts/not-ready
(:type (ex-data (failure #(artifacts/load-build @temporary-root (:id build))))))))
(t/is (= :failed (:status (transit/decode-str
(fs/readFileSync (:manifest-path failed) "utf8")))))
(t/is (= log (fs/readFileSync (:log-path failed) "utf8")))
(t/is (fs/existsSync (:dir building)))))
(t/deftest stale-references-cannot-reopen-terminal-builds
(doseq [status [:ready :failed]]
(let [build (create-build)
terminal (artifacts/write-manifest build (assoc (:manifest build) :status status))
saved (fs/readFileSync (:manifest-path build) "utf8")]
(t/is (= terminal (artifacts/write-manifest terminal (:manifest terminal))))
(doseq [next-status [:building :ready :failed]]
(let [attempt (assoc (:manifest terminal) :status next-status :extra "changed")]
(t/is (= ::artifacts/terminal-build
(:type (ex-data (failure #(artifacts/write-manifest build attempt))))))))
(t/is (= saved (fs/readFileSync (:manifest-path build) "utf8"))))))
(t/deftest unencodable-update-keeps-the-last-manifest-and-log
(let [build (create-build)
saved (fs/readFileSync (:manifest-path build) "utf8")]
(fs/appendFileSync (:log-path build) "saved diagnostic\n" "utf8")
(t/is (some? (failure #(artifacts/write-manifest
build (assoc (:manifest build) :callback (fn [] nil))))))
(t/is (= saved (fs/readFileSync (:manifest-path build) "utf8")))
(t/is (= "saved diagnostic\n" (fs/readFileSync (:log-path build) "utf8")))
(t/is (= #{"browser" "renderer" "build.log" "build.transit"}
(set (array-seq (fs/readdirSync (:dir build))))))))
(def ^:private manifest-reader
(str "const {parentPort, workerData} = require('worker_threads');"
"const fs = require('fs'); const stop = new Int32Array(workerData.stop);"
"let reads = 0; const errors = [];"
"function read() { try { JSON.parse(fs.readFileSync(workerData.path, 'utf8'));"
"reads++; } catch (error) { if (errors.length < 5) errors.push(error.message); } }"
"read(); parentPort.postMessage('ready');"
"while (Atomics.load(stop, 0) === 0) read();"
"parentPort.postMessage({reads, errors});"))
(defn- worker-message
[^js worker]
(js/Promise.
(fn [resolve reject]
(letfn [(received [value]
(.removeListener worker "error" failed)
(resolve value))
(failed [error]
(.removeListener worker "message" received)
(reject error))]
(.once worker "message" received)
(.once worker "error" failed)))))
(t/deftest ^:async manifest-replacements-never-expose-a-partial-file
(let [build (create-build)
stop (js/SharedArrayBuffer. 4)
^js worker (workers/Worker. manifest-reader
#js {:eval true
:workerData #js {:path (:manifest-path build) :stop stop}})]
(try
(await (worker-message worker))
(let [result (worker-message worker)]
(dotimes [n 24]
(artifacts/write-manifest
build (assoc (:manifest build) :progress n
:diagnostic (apply str (repeat (+ 8192 (* n 1024)) "evidence ")))))
(js/Atomics.store (js/Int32Array. stop) 0 1)
(let [^js observed (await result)]
(t/is (> (.-reads observed) 1) "a separate thread read during replacement")
(t/is (empty? (array-seq (.-errors observed)))
"every observed manifest remained a complete JSON document")))
(t/is (= 23 (:progress (transit/decode-str
(fs/readFileSync (:manifest-path build) "utf8")))))
(finally
(await (.terminate worker))))))
(t/deftest unsupported-manifests-and-incomplete-builds-are-rejected
(doseq [change [{:schema-version 2} {:type :run-record} {:id "another-build"}]]
(let [build (ready-build)]
(fs/writeFileSync (:manifest-path build) (codec/encode-str (merge (:manifest build) change))
"utf8")
(t/is (= ::artifacts/unsupported-manifest
(:type (ex-data (failure #(artifacts/load-build @temporary-root (:id build)))))))))
(doseq [relative ["cases.cjs" "browser/browser.js" "renderer/render-wasm.js"
"renderer/render-wasm.wasm" "renderer/shared.js" "index.html"]]
(let [build (ready-build)]
(fs/unlinkSync (path/join (:dir build) relative))
(t/is (some? (failure #(artifacts/load-build @temporary-root (:id build)))) relative))))
(t/deftest ids-cannot-select-or-delete-outside-paths
(let [build (ready-build)
outside (path/join @temporary-root "outside.txt")]
(write-file outside "keep this")
(doseq [id [nil "" "." ".." "../outside.txt" "safe/../../outside.txt"
"..\\outside.txt" "/tmp/outside" "id%2fother"]]
(t/is (= ::artifacts/invalid-id
(:type (ex-data (failure #(artifacts/load-build @temporary-root id))))))
(t/is (= ::artifacts/invalid-id
(:type (ex-data (failure #(artifacts/remove-builds
@temporary-root [(:id build) id])))))))
(t/is (= build (artifacts/load-build @temporary-root (:id build))))
(t/is (= "keep this" (fs/readFileSync outside "utf8")))))
(t/deftest safe-non-uuid-ids-can-load-existing-builds
(let [build (ready-build)
id "retained-build_1"
dir (path/join (path/dirname (:dir build)) id)]
(fs/renameSync (:dir build) dir)
(fs/writeFileSync (path/join dir "build.transit")
(codec/encode-str (assoc (:manifest build) :id id)) "utf8")
(t/is (= id (:id (artifacts/load-build @temporary-root id))))
(t/is (= dir (:dir (artifacts/load-build @temporary-root id))))))
(t/deftest build-and-artifact-symlinks-cannot-escape-the-managed-root
(let [build (ready-build)
outside (path/join @temporary-root "outside.txt")]
(write-file outside "private")
(fs/unlinkSync (:cases-path build))
(fs/symlinkSync outside (:cases-path build))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/check-files build))))))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/load-build @temporary-root (:id build))))))))
(let [build (ready-build)
outside (path/join @temporary-root "outside-build")]
(fs/renameSync (:dir build) outside)
(fs/symlinkSync outside (:dir build) "dir")
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/check-files build))))))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/load-build @temporary-root (:id build)))))))))
(t/deftest category-purge-deletes-only-the-requested-managed-subroots
(doseq [category [:builds :runs :all]]
(let [root (fs/mkdtempSync (path/join @temporary-root (str (name category) "-")))
building (artifacts/create-build root selection provenance)
failed (artifacts/create-build root selection provenance)
managed (artifacts/managed-root root)
run-file (path/join managed "runs" "saved-run" "record.transit")
boot (path/join managed "runner.cjs")
outside (path/join root "unmanaged.txt")]
(artifacts/write-manifest failed (assoc (:manifest failed) :status :failed))
(write-file run-file "retained run")
(write-file boot "boot executable")
(write-file outside "unmanaged")
(artifacts/purge root category)
(t/is (= (= category :runs) (fs/existsSync (:dir building))))
(t/is (= (= category :runs) (fs/existsSync (:dir failed))))
(t/is (= (= category :builds) (fs/existsSync run-file)))
(t/is (= "boot executable" (fs/readFileSync boot "utf8")))
(t/is (= "unmanaged" (fs/readFileSync outside "utf8")))
(artifacts/purge root category))))
(t/deftest purge-removes-selected-subroot-symlinks-without-deleting-their-targets
(let [managed (artifacts/managed-root @temporary-root)]
(fs/mkdirSync managed #js {:recursive true})
(doseq [category [:builds :runs]]
(let [outside (path/join @temporary-root (str "outside-" (name category)))
saved (path/join outside "keep.txt")
link (path/join managed (name category))]
(write-file saved "keep symlink target")
(fs/symlinkSync outside link "dir")
(artifacts/purge @temporary-root category)
(t/is (not (fs/existsSync link)))
(t/is (= "keep symlink target" (fs/readFileSync saved "utf8")))))))
(t/deftest managed-root-symlink-cannot-create-or-delete-outside-the-frontend
(let [root (path/join @temporary-root "frontend")
managed (path/join root "target" "performance" "render-wasm")
outside (path/join @temporary-root "outside-managed")
build-log (path/join outside "builds" "retained" "build.log")
run-file (path/join outside "runs" "retained" "record.transit")]
(write-file build-log "outside build")
(write-file run-file "outside run")
(fs/mkdirSync (path/dirname managed) #js {:recursive true})
(fs/symlinkSync outside managed "dir")
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/managed-root root))))))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/create-build root selection provenance))))))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/purge root :all))))))
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/remove-builds root ["retained"]))))))
(t/is (= "outside build" (fs/readFileSync build-log "utf8")))
(t/is (= "outside run" (fs/readFileSync run-file "utf8")))
(t/is (= #{"retained"} (set (array-seq (fs/readdirSync (path/join outside "builds"))))))))
(t/deftest escaping-target-ancestor-is-rejected-before-the-managed-path-exists
(let [root (path/join @temporary-root "frontend-ancestor")
outside (path/join @temporary-root "outside-target")]
(fs/mkdirSync root)
(fs/mkdirSync outside)
(fs/symlinkSync outside (path/join root "target") "dir")
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/create-build root selection provenance))))))
(t/is (empty? (array-seq (fs/readdirSync outside))))))
(t/deftest create-build-rejects-an-escaping-builds-parent-before-writing-files
(let [managed (artifacts/managed-root @temporary-root)
outside (path/join @temporary-root "outside-builds")
saved (path/join outside "retained" "build.log")]
(write-file saved "keep external build")
(fs/mkdirSync managed #js {:recursive true})
(fs/symlinkSync outside (path/join managed "builds") "dir")
(t/is (= ::artifacts/unsafe-path
(:type (ex-data (failure #(artifacts/create-build
@temporary-root selection provenance))))))
(t/is (= "keep external build" (fs/readFileSync saved "utf8")))
(t/is (= #{"retained"} (set (array-seq (fs/readdirSync outside)))))))
(t/deftest remove-builds-keeps-other-builds-runs-and-symlink-targets
(let [removed (create-build)
kept (ready-build)
managed (artifacts/managed-root @temporary-root)
run (path/join managed "runs" "saved" "record.transit")
outside (path/join @temporary-root "outside" "keep.txt")
link (path/join managed "builds" "outside-link")]
(write-file run "keep run")
(write-file outside "keep target")
(fs/symlinkSync (path/dirname outside) link "dir")
(artifacts/remove-builds @temporary-root [(:id removed) "outside-link" "absent-build"])
(t/is (not (fs/existsSync (:dir removed))))
(t/is (not (fs/existsSync link)))
(t/is (= kept (artifacts/load-build @temporary-root (:id kept))))
(t/is (= "keep run" (fs/readFileSync run "utf8")))
(t/is (= "keep target" (fs/readFileSync outside "utf8")))))
(defn- descriptor
[id]
{:id id
:scene :artifact-only
:scene-version 1
:scene-description "A descriptor supplied only by this build"
:scene-seed 42
:params {}
:view {:scale 1 :x 0 :y 0}
:context :fresh
:completion :render-full
:batch-size 1
:preparation {:version 1}})
(defn- write-catalog
[build loaded-id response]
(write-file
(:cases-path build)
(str "const identity = " (js/JSON.stringify (codec/encode-str {:build-id loaded-id})) ";"
"const response = " (js/JSON.stringify (codec/encode-str response)) ";"
"module.exports = {buildIdentity() {return identity;},"
"collectCases(encodedSelection) {return response;}};")))
(t/deftest catalogs-use-the-selected-commonjs-module-with-isolated-scope
(let [first-build (ready-build)
second-build (ready-build)
first-case (descriptor :artifact-only/first)
second-case (descriptor :artifact-only/second)
selection {:master-seed 42}]
(write-catalog first-build (:id first-build)
{:build-id (:id first-build) :cases [first-case]})
(write-catalog second-build (:id second-build)
{:build-id (:id second-build) :cases [second-case]})
(t/is (= [first-case] (catalog/collect first-build selection)))
(t/is (= [second-case] (catalog/collect second-build selection)))
(t/is (= [first-case] (catalog/collect first-build selection)))))
(t/deftest catalog-rejects-both-loaded-and-response-identity-mismatches
(doseq [boundary [:loaded :response]]
(let [build (ready-build)]
(write-catalog build (if (= boundary :loaded) "wrong-build" (:id build))
{:build-id (if (= boundary :response) "wrong-build" (:id build))
:cases [(descriptor :artifact-only/load)]})
(t/is (= ::identity/mismatch
(:type (ex-data (failure #(catalog/collect build {:master-seed 42})))))))))
(t/deftest catalog-rejects-malformed-descriptors-and-empty-responses
(doseq [cases [[(assoc (descriptor :artifact-only/load) :scene-seed -1)] [] nil]]
(let [build (ready-build)]
(write-catalog build (:id build) {:build-id (:id build) :cases cases})
(t/is (some? (failure #(catalog/collect build {:master-seed 42})))))))

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 performance-tests.render-wasm.browser-test
(:require
["fs" :as fs]
["http" :as http]
["net" :as net]
["os" :as os]
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.identity :as identity]
[benches.render-wasm.node.browser :as browser]
[benches.render-wasm.node.process :as process]
[benches.render-wasm.node.server :as server]
[cljs.test :as t :include-macros true]))
(def ^:private temporary-root (atom nil))
(def ^:private build-id "owned-browser-fixture")
(def ^:private viewport {:width 320 :height 240 :dpr 1})
(t/use-fixtures :each
{:before #(reset! temporary-root (fs/mkdtempSync (path/join (os/tmpdir) "penpot-browser-test-")))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
(defn- ^:async open-host
[actual-id ready?]
(let [identity-text (.stringify js/JSON (transit/encode-str {:build-id actual-id}))]
(fs/writeFileSync (path/join @temporary-root "index.html")
(str "<!doctype html><title>browser ownership</title><script>"
"window.__benchBridge={buildIdentity:()=>" identity-text "};"
"window.__benchReady=" (if ready? "true" "false") ";</script>")))
(await (server/open {:id build-id :dir @temporary-root} {:startup-timeout-ms 3000})))
(defn- request-status
[base-url request-path]
(js/Promise.
(fn [resolve reject]
(let [address (js/URL. base-url)
req (http/get #js {:hostname (.-hostname address) :port (.-port address)
:path request-path :agent false}
(fn [^js response]
(.once response "error" reject)
(.once response "end" #(resolve (.-statusCode response)))
(.resume response)))]
(.once ^js req "error" reject)
(.setTimeout ^js req 3000 #(.destroy ^js req (js/Error. "HTTP test timed out")))))))
(defn- socket-status
[url]
(js/Promise.
(fn [resolve _]
(let [address (js/URL. url)
^js socket (net/createConnection #js {:host (.-hostname address)
:port (js/Number (.-port address))})]
(.once socket "connect" #(do (.destroy socket) (resolve :open)))
(.once socket "error" #(do (.destroy socket) (resolve (.-code ^js %))))
(.setTimeout socket 3000 #(do (.destroy socket) (resolve :timeout)))))))
(defn- ^:async rejected
[promise]
(try
(await promise)
(t/is false "expected browser work to reject")
nil
(catch :default cause cause)))
(defn- ^:async check-stopped
[{:keys [endpoint user-data-dir]}]
(t/is (not (fs/existsSync user-data-dir)) "owned Chromium profile was removed")
(t/is (= "ECONNREFUSED" (await (socket-status endpoint))) "the owned CDP listener is gone"))
(defn- ^:async close-fixture
[owner host]
(try
(when owner
(await (browser/close owner)))
(finally
(await (server/close host)))))
(t/deftest ^:async successful-close-removes-the-profile-and-cdp-listener
(let [host (await (open-host build-id true))
owner-ref (atom nil)]
(try
(let [owner (await (browser/open host {:viewport viewport :startup-timeout-ms 30000}))]
(reset! owner-ref owner)
(t/is (= 200 (await (request-status (:endpoint owner) "/json/version"))))
(t/is (= viewport
(js->clj (await (.evaluate ^js (:page owner)
"({width:innerWidth,height:innerHeight,dpr:devicePixelRatio})"))
:keywordize-keys true)))
(await (browser/close owner))
(await (check-stopped owner))
(t/is (not (.isConnected ^js (:browser owner))))
(t/is (= 200 (await (request-status (:base-url host) "/"))) "browser shutdown leaves its host live")
(await (server/close host))
(t/is (= "ECONNREFUSED" (await (socket-status (:base-url host))))))
(finally
(await (close-fixture @owner-ref host))))))
(t/deftest ^:async identity-mismatch-closes-chromium-before-startup-rejects
(let [host (await (open-host "wrong-compiled-build" true))]
(try
(let [cause (await (rejected (browser/open host {:viewport viewport :startup-timeout-ms 30000})))
facts (ex-data cause)]
(t/is (= ::identity/mismatch (:type facts)))
(t/is (= "wrong-compiled-build" (:actual-id facts)))
(await (check-stopped facts)))
(finally
(await (server/close host))))))
(t/deftest ^:async abort-stops-a-synchronously-blocked-page
(let [host (await (open-host build-id true))
controller (js/AbortController.)
owner-ref (atom nil)
started-ref (atom nil)
started (js/Promise. (fn [resolve _] (reset! started-ref resolve)))]
(try
(let [owner (await (browser/open host {:viewport viewport :startup-timeout-ms 30000
:signal (.-signal controller)}))
^js page (:page owner)]
(reset! owner-ref owner)
(await (.exposeFunction page "__blockingStarted" (fn [] (@started-ref))))
(let [blocking (.evaluate page "window.__blockingStarted(); while (true) {}")]
(.catch blocking (fn [_] nil))
(await (browser/within (fn [] started)
{:deadline (process/deadline 5000) :phase :test-blocking-start}))
(let [cause (await (rejected (browser/within #(.evaluate page "1")
{:deadline (process/deadline 1000)
:phase :test-blocked-page})))]
(t/is (= ::browser/timeout (:type (ex-data cause)))))
(.abort controller)
(await (browser/close owner))
(await (check-stopped owner))
(t/is (not (.isConnected ^js (:browser owner))))
(t/is (instance? js/Error (await (rejected blocking))))))
(finally
(.abort controller)
(await (close-fixture @owner-ref host))))))
(t/deftest ^:async abort-during-readiness-cleans-the-starting-browser
(let [host (await (open-host build-id false))
controller (js/AbortController.)
requested (js/Promise.
(fn [resolve _]
(.once ^js (:server host) "request" (fn [_] (resolve nil)))))
opening (browser/open host {:viewport viewport :startup-timeout-ms 30000
:signal (.-signal controller)})]
(.catch opening (fn [_] nil))
(try
(await (browser/within (fn [] requested)
{:deadline (process/deadline 30000) :phase :test-host-request}))
(.abort controller (ex-info "caller cancelled browser readiness" {:type ::caller-abort}))
(let [cause (await (rejected opening))]
(t/is (= ::caller-abort (:type (ex-data cause))))
(await (check-stopped (ex-data cause))))
(finally
(.abort controller)
(let [owner (await (.catch opening (fn [_] nil)))]
(await (close-fixture owner host)))))))

View File

@ -0,0 +1,212 @@
;; 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.build-test
"Real preparation failures in temporary frontend/render-wasm checkouts.
A scripted compiler keeps these tests independent of Cargo and Skia while
exercising the process, filesystem and failure-retention boundary. Release
integration checks cover compiler success and Cargo feature forwarding."
(:require
["fs" :as fs]
["os" :as os]
["path" :as path]
[app.common.transit :as transit]
[benches.render-wasm.node.build :as build]
[benches.render-wasm.node.process :as process]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(def ^:private temporary-root (atom nil))
(defn- frontend-root
[]
(path/join @temporary-root "frontend"))
(defn- renderer-root
[]
(path/join @temporary-root "render-wasm"))
(t/use-fixtures :each
{:before (fn []
(reset! temporary-root
(fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-build-test-")))
(fs/mkdirSync (frontend-root))
(fs/mkdirSync (renderer-root)))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
(def ^:private renderer-wrapper
(str "#!/usr/bin/env node\n"
"const fs = require('node:fs');\n"
"const path = require('node:path');\n"
"const {spawnSync} = require('node:child_process');\n"
"const dir = path.dirname(process.env.FRONTEND_DEST);\n"
"const observation = {\n"
" cwd: process.cwd(),\n"
" manifest: fs.readFileSync(path.join(dir, 'build.transit'), 'utf8'),\n"
" log: fs.readFileSync(path.join(dir, 'build.log'), 'utf8'),\n"
" created: JSON.parse(fs.readFileSync(path.join(dir, 'created.json'), 'utf8'))\n"
"};\n"
"fs.writeFileSync(path.join(dir, 'renderer-observation.json'), JSON.stringify(observation));\n"
"const result = spawnSync('flock', [\n"
" '--exclusive', path.join(__dirname, 'build.lock'),\n"
" process.execPath, path.join(__dirname, 'compiler.cjs')\n"
"], {stdio: 'inherit'});\n"
"if (result.error) throw result.error;\n"
"process.exitCode = result.status === null ? 1 : result.status;\n"))
(def ^:private failing-compiler
(str "const fs = require('node:fs');\n"
"const path = require('node:path');\n"
"fs.writeFileSync(path.join(process.env.FRONTEND_DEST, 'partial.js'), 'partial renderer output\\n');\n"
"process.stdout.write('compiler stdout before failure\\n');\n"
"process.stderr.write('compiler stderr before failure\\n');\n"
"process.exitCode = 23;\n"))
(def ^:private sleeping-compiler
(str "const fs = require('node:fs');\n"
"const path = require('node:path');\n"
"fs.writeFileSync(path.join(process.env.FRONTEND_DEST, 'lock-acquired.txt'), 'held');\n"
"process.stdout.write('compiler lock acquired\\n');\n"
"process.stderr.write('waiting in compiler\\n');\n"
"setInterval(() => {}, 1000);\n"))
(defn- install-renderer
[compiler]
(fs/writeFileSync (path/join (renderer-root) "build") renderer-wrapper #js {:mode 493})
(fs/writeFileSync (path/join (renderer-root) "compiler.cjs") compiler "utf8"))
(defn- read-manifest
[build-ref]
(transit/decode-str (fs/readFileSync (:manifest-path build-ref) "utf8")))
(defn- record-created
[build-ref]
;; These reads must succeed before the executable can read created.json.
(let [observation {:id (:id build-ref)
:manifest (fs/readFileSync (:manifest-path build-ref) "utf8")
:log (fs/readFileSync (:log-path build-ref) "utf8")
:renderer-started? (fs/existsSync (path/join (:dir build-ref) "renderer-observation.json"))}]
(fs/writeFileSync (path/join (:dir build-ref) "created.json")
(js/JSON.stringify (clj->js observation)) "utf8")))
(defn- retained-build
[cause]
(let [id (:build-id (ex-data cause))
dir (path/join (frontend-root) "target" "performance" "render-wasm" "builds" id)]
{:id id :dir dir
:manifest-path (path/join dir "build.transit")
:log-path (path/join dir "build.log")
:renderer-dir (path/join dir "renderer")}))
(defn- ^:async rejected
[promise]
(try
(let [result (await promise)]
(t/is false (str "Expected preparation to fail, got " (pr-str result)))
nil)
(catch :default cause cause)))
(defn- complete
[promise done]
(.then promise
(fn [_] (done))
(fn [cause]
(t/is false (str "Unexpected test error: " cause))
(done))))
(t/deftest real-git-outside-a-repository-has-unknown-provenance
(t/async done
(complete
((^:async fn []
(let [git (await (build/git-provenance (frontend-root)
{:deadline (process/deadline 10000)}))]
(t/is (= {:sha nil :dirty nil} git)))))
done)))
(t/deftest nonzero-renderer-retains-created-evidence-output-and-failed-manifest
(t/async done
(complete
((^:async fn []
(install-renderer failing-compiler)
(let [cause (await (rejected (build/prepare {:root (frontend-root)
:build-timeout-ms 10000
:on-created record-created})))
data (ex-data cause)
child-data (ex-data (ex-cause cause))
retained (retained-build cause)
manifest (read-manifest retained)
log (fs/readFileSync (:log-path retained) "utf8")
observation (js->clj (js/JSON.parse
(fs/readFileSync (path/join (:dir retained) "renderer-observation.json") "utf8"))
:keywordize-keys true)
created (:created observation)
initial (transit/decode-str (:manifest created))
at-renderer (transit/decode-str (:manifest observation))]
(t/is (= ::build/preparation-failed (:type data)))
(t/is (= :renderer (:phase data)))
(t/is (= (:log-path retained) (:log-path data)))
(t/is (= :process-exit (:type child-data)))
(t/is (= 23 (:exit-code child-data)))
(t/is (= (path/join (renderer-root) "build") (:command child-data)))
(t/is (= (renderer-root) (:cwd observation)))
(t/is (= (:id retained) (:id created) (:id manifest)
(: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 (= :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)))
(t/deftest timed-out-lock-holder-retains-its-attempt-and-retry-gets-a-new-id
(t/async done
(complete
((^:async fn []
(install-renderer sleeping-compiler)
(let [cause (await (rejected (build/prepare {:root (frontend-root)
:build-timeout-ms 3000
:on-created record-created})))
retained (retained-build cause)
manifest (read-manifest retained)
before (fs/readFileSync (:manifest-path retained) "utf8")
log (fs/readFileSync (:log-path retained) "utf8")]
(t/is (= ::build/preparation-failed (:type (ex-data cause))))
(t/is (= :renderer (:phase (ex-data cause))))
(t/is (= (:log-path retained) (:log-path (ex-data cause))))
(t/is (= :process-timeout (:type (ex-data (ex-cause cause)))))
(t/is (= (:id retained) (:id manifest)))
(t/is (= :failed (:status manifest)))
(t/is (= :renderer (get-in manifest [:failure :phase])))
(t/is (= :process-timeout (get-in manifest [:failure :cause 0 :type])))
(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)
:build-timeout-ms 10000
:on-created record-created})))
retry (retained-build retry-cause)
retry-log (fs/readFileSync (:log-path retry) "utf8")]
(t/is (not= (:id retained) (:id retry)))
(t/is (= :renderer (:phase (ex-data retry-cause))))
(t/is (= 23 (:exit-code (ex-data (ex-cause retry-cause)))))
(t/is (= :failed (:status (read-manifest retry))))
(t/is (str/includes? retry-log "compiler stderr before failure\n"))
(t/is (= before (fs/readFileSync (:manifest-path retained) "utf8")))
(t/is (= log (fs/readFileSync (:log-path retained) "utf8")))
(t/is (= #{(:id retained) (:id retry)}
(set (array-seq (fs/readdirSync (path/dirname (:dir retained)))))))))))
done)))

View File

@ -0,0 +1,327 @@
// 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
// Opt-in: build the release runner and the test bundle first:
//
// pnpm run build:renderer-benchmarks:runner
// pnpm run build:renderer-benchmarks:tests
// RENDER_WASM_RUNNER_BOOT=target/performance/render-wasm/runner.cjs \
// node --test test/performance_tests/render_wasm/cli_integration.cjs
//
// The normal unit test build does not build this CLI.
const assert = require("node:assert/strict");
const { execFile } = require("node:child_process");
const { randomUUID } = require("node:crypto");
const fs = require("node:fs");
const os = require("node:os");
const path = require("node:path");
const { before, test } = require("node:test");
const { pathToFileURL } = require("node:url");
const { promisify } = require("node:util");
const execute = promisify(execFile);
const testOptions = { timeout: 60000 };
let bootstrap;
let frontendRoot;
let transit;
before(async () => {
assert.ok(
process.env.RENDER_WASM_RUNNER_BOOT,
"Set RENDER_WASM_RUNNER_BOOT to the release-compiled runner.cjs",
);
bootstrap = path.resolve(process.env.RENDER_WASM_RUNNER_BOOT);
assert.ok(
fs.existsSync(bootstrap) && fs.statSync(bootstrap).isFile(),
"Run pnpm run build:renderer-benchmarks:runner before the CLI tests",
);
bootstrap = fs.realpathSync(bootstrap);
frontendRoot = path.resolve(path.dirname(bootstrap), "../../..");
assert.ok(fs.statSync(path.join(frontendRoot, "deps.edn")).isFile());
assert.ok(
fs
.statSync(
path.join(frontendRoot, "performance", "benches", "render_wasm"),
)
.isDirectory(),
);
assert.ok(fs.statSync(path.join(frontendRoot, "node_modules")).isDirectory());
// Load the actual Transit JS library emitted by Shadow, without starting
// either the CLJS test runner or the production CLI in this process.
const transitModule = path.join(
frontendRoot,
"target/performance-tests/cljs-runtime/com.cognitect.transit.js",
);
assert.ok(
fs.existsSync(transitModule),
"Run pnpm run build:renderer-benchmarks:tests before the CLI tests",
);
await import(pathToFileURL(transitModule).href);
transit = globalThis.com.cognitect.transit;
});
function createFrontend(t) {
const temporary = fs.mkdtempSync(path.join(os.tmpdir(), "render-wasm-cli-"));
t.after(() => fs.rmSync(temporary, { recursive: true, force: true }));
const root = path.join(temporary, "frontend");
const managed = path.join(root, "target", "performance", "render-wasm");
const renderer = path.join(temporary, "render-wasm");
const runner = path.join(managed, "runner.cjs");
fs.mkdirSync(path.join(root, "performance", "benches", "render_wasm"), {
recursive: true,
});
fs.writeFileSync(path.join(root, "deps.edn"), "{}\n");
fs.mkdirSync(managed, { recursive: true });
fs.copyFileSync(bootstrap, runner);
fs.symlinkSync(
path.join(frontendRoot, "node_modules"),
path.join(root, "node_modules"),
"dir",
);
fs.mkdirSync(renderer);
fs.mkdirSync(path.join(managed, "compiler-cache"));
fs.writeFileSync(
path.join(managed, "compiler-cache", "retained.cache"),
"cache\n",
);
return {
managed,
runner,
compiler: path.join(renderer, "build"),
builds: path.join(managed, "builds"),
runs: path.join(managed, "runs"),
};
}
async function runCli(fixture, args) {
try {
const output = await execute(process.execPath, [fixture.runner, ...args], {
cwd: os.tmpdir(),
encoding: "utf8",
timeout: 15000,
killSignal: "SIGKILL",
maxBuffer: 1024 * 1024,
});
return { exitCode: 0, ...output };
} catch (error) {
// A timeout, signal or spawn failure must fail the test, rather than
// masquerade as the expected nonzero CLI exit.
if (!Number.isInteger(error.code) || error.killed || error.signal) {
throw error;
}
return {
exitCode: error.code,
stdout: error.stdout,
stderr: error.stderr,
};
}
}
function readManifest(file) {
return transit.reader("json").read(fs.readFileSync(file, "utf8"));
}
function manifestText(id, status, type) {
const k = transit.keyword;
return transit
.writer("json")
.write(
transit.map([
k("type"),
k(type),
k("schema-version"),
1,
k("id"),
id,
k("status"),
k(status),
]),
);
}
function seedBuilds(fixture) {
for (const status of ["building", "failed", "ready"]) {
const id = randomUUID();
const directory = path.join(fixture.builds, id);
fs.mkdirSync(directory, { recursive: true });
fs.writeFileSync(
path.join(directory, "build.transit"),
manifestText(id, status, "renderer-build"),
);
fs.writeFileSync(path.join(directory, "build.log"), `${status} build\n`);
}
}
function seedRuns(fixture) {
for (const status of ["complete", "failed"]) {
const id = randomUUID();
const directory = path.join(fixture.runs, id);
fs.mkdirSync(directory, { recursive: true });
fs.writeFileSync(
path.join(directory, "run.transit"),
manifestText(id, status, "renderer-run"),
);
}
}
function tree(directory) {
return fs
.readdirSync(directory, { withFileTypes: true })
.sort((a, b) => a.name.localeCompare(b.name))
.map((entry) => {
const file = path.join(directory, entry.name);
return [
entry.name,
entry.isDirectory() ? tree(file) : fs.readFileSync(file),
];
});
}
const failingCompiler = `#!/usr/bin/env node
const fs = require("node:fs");
const path = require("node:path");
const directory = path.dirname(process.env.FRONTEND_DEST);
fs.copyFileSync(
path.join(directory, "build.transit"),
path.join(directory, "before-compiler.transit")
);
fs.writeFileSync(
path.join(process.env.FRONTEND_DEST, "partial.js"),
"partial renderer output\\n"
);
process.stdout.write("compiler stdout before failure\\n");
process.stderr.write("compiler stderr before failure\\n");
process.exitCode = 23;
`;
test(
"build retains failure evidence and prints only its UUID",
testOptions,
async (t) => {
const fixture = createFrontend(t);
fs.writeFileSync(fixture.compiler, failingCompiler, { mode: 0o755 });
const args = ["build", "--build-timeout-ms", "10000"];
const result = await runCli(fixture, args);
assert.equal(result.exitCode, 1);
const id = result.stdout.trim();
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.deepEqual(fs.readdirSync(fixture.builds), [id]);
const directory = path.join(fixture.builds, id);
const logPath = path.join(directory, "build.log");
const initial = readManifest(
path.join(directory, "before-compiler.transit"),
);
const manifest = readManifest(path.join(directory, "build.transit"));
const k = transit.keyword;
assert.equal(initial.get(k("id")), id);
assert.equal(initial.get(k("status")).toString(), ":building");
assert.equal(manifest.get(k("id")), id);
assert.equal(manifest.get(k("status")).toString(), ":failed");
const failure = manifest.get(k("failure"));
assert.equal(failure.get(k("phase")).toString(), ":renderer");
assert.equal(
failure.get(k("cause"))[0].get(k("type")).toString(),
":process-exit",
);
assert.equal(
fs.readFileSync(path.join(directory, "renderer", "partial.js"), "utf8"),
"partial renderer output\n",
);
const log = fs.readFileSync(logPath, "utf8");
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/,
);
assert.ok(result.stderr.includes(`:build-id "${id}"`));
assert.ok(result.stderr.includes(`:log-path ${JSON.stringify(logPath)}`));
assert.match(result.stderr, /:phase :renderer/);
},
);
test("purge deletes only the selected artifacts", testOptions, async (t) => {
const fixture = createFrontend(t);
const retained = tree(fixture.managed);
seedBuilds(fixture);
seedRuns(fixture);
const runs = tree(fixture.runs);
assert.deepEqual(await runCli(fixture, ["purge", "--only-builds"]), {
exitCode: 0,
stdout: "",
stderr: "",
});
assert.equal(fs.existsSync(fixture.builds), false);
assert.deepEqual(tree(fixture.runs), runs);
assert.deepEqual(
tree(fixture.managed).filter(([name]) => name !== "runs"),
retained,
);
seedBuilds(fixture);
const builds = tree(fixture.builds);
assert.deepEqual(await runCli(fixture, ["purge", "--only-runs"]), {
exitCode: 0,
stdout: "",
stderr: "",
});
assert.equal(fs.existsSync(fixture.runs), false);
assert.deepEqual(tree(fixture.builds), builds);
assert.deepEqual(
tree(fixture.managed).filter(([name]) => name !== "builds"),
retained,
);
seedRuns(fixture);
assert.deepEqual(await runCli(fixture, ["purge"]), {
exitCode: 0,
stdout: "",
stderr: "",
});
assert.equal(fs.existsSync(fixture.builds), false);
assert.equal(fs.existsSync(fixture.runs), false);
assert.deepEqual(tree(fixture.managed), retained);
});
test(
"malformed purge categories leave all files intact",
testOptions,
async (t) => {
const fixture = createFrontend(t);
seedBuilds(fixture);
seedRuns(fixture);
const original = tree(fixture.managed);
for (const args of [
["purge", "--only-builds", "--only-runs"],
["purge", "--only-ready-builds"],
["purge", "--only-builds", "ready"],
]) {
const result = await runCli(fixture, args);
assert.equal(result.exitCode, 1, args.join(" "));
assert.equal(result.stdout, "");
assert.match(
result.stderr,
/:type :benches.render-wasm.node.runner\/invalid-args/,
);
assert.deepEqual(tree(fixture.managed), original, args.join(" "));
}
},
);

View File

@ -0,0 +1,61 @@
;; 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.pilot-test
(:require
[benches.render-wasm.node.pilot :as pilot]
[cljs.test :as t :include-macros true]))
(t/deftest diagnostic-budget-is-fixed-and-explicit
(let [defaults (pilot/parse-args [])
explicit (pilot/parse-args ["--warmups" "0" "--attempts" "1"])]
(t/is (= defaults explicit))
(t/is (= {:warmups 0 :attempts 1 :timeout-ms 30000
:build-timeout-ms 300000 :startup-timeout-ms 30000}
(select-keys defaults [:warmups :attempts :timeout-ms :build-timeout-ms :startup-timeout-ms]))))
(doseq [args [["--warmups" "1"] ["--attempts" "0"] ["--attempts" "2"]]]
(t/is (thrown-with-msg? js/Error #"requires --warmups 0 and --attempts 1"
(pilot/parse-args args)))))
(t/deftest retained-reuse-rejects-every-explicit-feature-selection
(t/is (= "retained-id" (:build-id (pilot/parse-args ["--build" "retained-id"]))))
(doseq [args [["--build" "retained-id" "--no-default-features"]
["--no-default-features" "--build" "retained-id"]
["--build" "retained-id" "--features" ""]
["--features" "functional" "--build" "retained-id"]]]
(t/is (thrown-with-msg? js/Error #"cannot be combined"
(pilot/parse-args args)))))
(t/deftest numeric-options-reject-prefix-parsing-and-invalid-bounds
(doseq [flag ["--seed" "--timeout-ms" "--build-timeout-ms" "--startup-timeout-ms"
"--warmups" "--attempts"]
value ["1ms" "1.5" "1e3" "NaN" "-1" "9007199254740992"]]
(t/is (thrown? js/Error (pilot/parse-args [flag value]))))
(doseq [args [["--seed" "4294967296"] ["--timeout-ms" "0"]
["--build-timeout-ms" "0"] ["--startup-timeout-ms" "0"]
["--timeout-ms" "2147483648"]]]
(t/is (thrown? js/Error (pilot/parse-args args))))
(t/is (= 4294967295 (:seed (pilot/parse-args ["--seed" "4294967295"])))))
(t/deftest diagnostic-options-keep-case-selection-for-the-retained-catalog
(let [opts (pilot/parse-args ["--case" "retained-scene/operation" "--seed" "7"
"--timeout-ms" "100" "--build-timeout-ms" "200"
"--startup-timeout-ms" "300" "--no-default-features"
"--features" "first, second" "--screenshot" "/tmp/pilot.png"])]
(t/is (= :retained-scene/operation (:case-id opts)))
(t/is (= {:default-features? false :features ["first" "second"]} (:features opts)))
(t/is (= {:seed 7 :timeout-ms 100 :build-timeout-ms 200 :startup-timeout-ms 300
:screenshot "/tmp/pilot.png"}
(select-keys opts [:seed :timeout-ms :build-timeout-ms :startup-timeout-ms :screenshot])))))
(t/deftest malformed-options-fail-at-the-cli-boundary
(doseq [args [["--build"] ["--case"] ["--seed"] ["--screenshot"]
["--build" ""] ["--screenshot" ""] ["--case" "load"]
["--features" "first,,second"] ["--timeout-ms" "--seed" "42"]
["--unknown"]]]
(t/is (thrown? js/Error (pilot/parse-args args))))
(t/is (:help? (pilot/parse-args ["--help"])))
(t/is (:help? (pilot/parse-args ["-h"]))))

View File

@ -0,0 +1,464 @@
;; 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.process-test
"Real Node/POSIX processes, files and Linux flock ownership."
(:require
["fs" :as fs]
["os" :as os]
["path" :as path]
[benches.render-wasm.node.process :as process]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(def ^:private temp-root (atom nil))
(def ^:private test-grace-ms 100)
(defn- file
[name]
(path/join @temp-root name))
(defn- pause
[ms]
(js/Promise. (fn [resolve _] (js/setTimeout resolve ms))))
(defn- within
"A broken lifecycle must fail the test rather than stall the test runner."
[promise]
(let [timer (volatile! nil)]
(-> (js/Promise.race
#js [promise
(js/Promise.
(fn [_ reject]
(vreset! timer
(js/setTimeout
#(reject (ex-info "Process test stalled" {:type :test-watchdog}))
5000))))])
(.finally #(js/clearTimeout @timer)))))
(defn- ^:async wait-for
[pred]
(let [limit (process/deadline 3000)]
(loop []
(when-not (pred)
(when (zero? (process/remaining limit))
(throw (ex-info "Process test did not become ready" {:type :test-watchdog})))
(await (pause 10))
(recur)))))
(defn- process-status
[pid]
(try
(let [stat (fs/readFileSync (str "/proc/" pid "/stat") "utf8")
fields (str/split (str/trim (subs stat (inc (.lastIndexOf stat ")")))) #"\s+")]
{:state (first fields)
:group (js/Number (nth fields 2))})
(catch :default cause
(if (contains? #{"ENOENT" "ESRCH"} (.-code cause))
nil
(throw cause)))))
(defn- running?
[pid]
(when-let [status (process-status pid)]
;; An orphan can remain as a zombie until init reaps it. It owns no pipes
;; or locks and cannot run; kill(pid, 0) alone does not distinguish it.
(not (contains? #{"Z" "X" "x"} (:state status)))))
(defn- read-pid
[name]
(js/Number (fs/readFileSync (file name) "utf8")))
(t/use-fixtures
:each
{:before
(fn []
(reset! temp-root
(fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-wasm-process-test-"))))
:after
(fn []
(t/async done
(let [cleanup (^:async fn []
(try
(let [pids (->> (array-seq (fs/readdirSync @temp-root))
(filter #(str/ends-with? % ".pid"))
(mapv read-pid))]
;; Also clean up when an assertion or watchdog exposes a regression.
;; Signal individual recorded PIDs so a missing detached flag cannot
;; make test teardown kill the test runner's own process group.
(doseq [pid pids]
(when (running? pid)
(try
(.kill js/process pid "SIGKILL")
(catch :default cause
(when-not (= "ESRCH" (.-code cause))
(throw cause))))))
(await (wait-for #(not-any? running? pids))))
(finally
(try
(fs/rmSync @temp-root #js {:recursive true :force true})
(finally
(reset! temp-root nil))))))]
(.then (cleanup)
(fn [_] (done))
(fn [cause]
(try
(t/is false (str "Process test cleanup failed: " cause))
(finally
(done))))))))})
(defn- node-source
[pid-file source]
(str "const fs = require('node:fs');\n"
"fs.writeFileSync(" (pr-str pid-file) ", String(process.pid));\n"
source))
(defn- node-options
[source overrides]
(merge {:command (.-execPath js/process)
:args ["-e" (node-source "root.pid" source)]
:cwd @temp-root
:deadline (process/deadline 3000)
:termination-grace-ms test-grace-ms}
overrides))
(defn- ^:async rejected
[promise]
(try
(let [result (await (within promise))]
(t/is false (str "Expected a process failure, got " (pr-str result)))
nil)
(catch :default cause
(t/is (some? (ex-data cause)) "failures carry ex-info data")
(ex-data cause))))
(defn- stubborn-descendant
[]
(let [grandchild (node-source
"grandchild.pid"
(str "process.on('SIGTERM', () => fs.writeFileSync('grandchild.term', 'seen'));\n"
"fs.writeFileSync('grandchild.ready', 'ready');\n"
"setInterval(() => {}, 1000);\n"))]
(node-source
"descendant.pid"
(str "process.on('SIGTERM', () => fs.writeFileSync('descendant.term', 'seen'));\n"
"require('node:child_process').spawn(process.execPath,\n"
" ['-e', " (pr-str grandchild) "], {stdio: ['ignore', 'inherit', 'inherit']});\n"
"const ready = setInterval(() => {\n"
" if (fs.existsSync('grandchild.ready')) {\n"
" clearInterval(ready); fs.writeFileSync('descendant.ready', 'ready');\n"
" process.stdout.write('descendant-ready\\n');\n"
" }\n"
"}, 10);\n"
"setInterval(() => fs.appendFileSync('heartbeat', '.'), 10);\n"))))
(defn- spawn-descendant
[]
(str "const child = require('node:child_process').spawn(process.execPath,\n"
" ['-e', " (pr-str (stubborn-descendant)) "],\n"
" {stdio: ['ignore', 'inherit', 'inherit']});\n"))
(defn- ^:async assert-tree-stopped
[]
(t/is (not (running? (read-pid "root.pid"))) "the owner has stopped")
(t/is (not (running? (read-pid "descendant.pid"))) "the descendant has stopped at settlement")
(t/is (not (running? (read-pid "grandchild.pid"))) "the grandchild has stopped at settlement")
(t/is (= "seen" (fs/readFileSync (file "descendant.term") "utf8"))
"the owned group receives SIGTERM before SIGKILL")
(t/is (= "seen" (fs/readFileSync (file "grandchild.term") "utf8"))
"SIGTERM also reaches the grandchild")
(let [heartbeat (when (fs/existsSync (file "heartbeat"))
(fs/readFileSync (file "heartbeat") "utf8"))]
(await (pause 30))
(t/is (= heartbeat (when (fs/existsSync (file "heartbeat"))
(fs/readFileSync (file "heartbeat") "utf8")))
"no descendant writes after the promise settles")))
(t/deftest ^:async deadlines-use-date-now-and-clamp-at-zero
(let [before (js/Date.now)
limit (process/deadline 20)]
(t/is (<= (+ before 20) limit (+ (js/Date.now) 20)))
(t/is (<= 0 (process/remaining limit) 20))
(await (pause 30))
(t/is (zero? (process/remaining limit)))
(t/is (zero? (process/remaining (- before 1000))))))
(t/deftest ^:async uses-real-cwd-literal-args-env-and-closed-stdin
(let [source (str "process.stdin.resume();\n"
"process.stdin.on('end', () => {\n"
" const fact = {cwd: process.cwd(), args: process.argv.slice(1),\n"
" value: process.env.RENDERER_PROCESS_TEST, path: process.env.PATH || null};\n"
" fs.writeFileSync('fact.json', JSON.stringify(fact));\n"
" process.stdout.write(JSON.stringify(fact));\n"
" process.stderr.write('stdin-ended\\n');\n"
"});\n")
args ["space ; $(touch unexpected)" "--literal"]]
(doseq [env [{:RENDERER_PROCESS_TEST "map value"}
#js {:RENDERER_PROCESS_TEST "map value"}]]
(let [options (node-options source {:env env})
result (await (within (process/run (update options :args into args))))
fact (js->clj (js/JSON.parse (:stdout result)) :keywordize-keys true)]
(t/is (= 0 (:exit-code result)))
(t/is (= "stdin-ended\n" (:stderr result)))
(t/is (= {:cwd @temp-root
:args args
:value "map value"
:path (or (.-PATH (.-env js/process)) nil)}
fact))
(t/is (= (:stdout result) (fs/readFileSync (file "fact.json") "utf8")))
(t/is (not (fs/existsSync (file "unexpected"))) "arguments do not pass through a shell")))))
(t/deftest ^:async routes-both-streams-before-the-child-can-finish
(let [seen (atom {:stdout "" :stderr ""})
source (str "process.stdout.write('ready\\n');\n"
"process.stderr.write('warning\\n');\n"
"const timer = setInterval(() => {\n"
" if (fs.existsSync('ack')) {\n"
" clearInterval(timer); fs.writeFileSync('done', 'yes');\n"
" process.stdout.write('complete\\n');\n"
" }\n"
"}, 10);\n")
result (await
(within
(process/run
(node-options
source
{:on-output
(fn [text stream]
(swap! seen update stream str text)
(when (str/includes? (:stdout @seen) "ready\n")
(fs/writeFileSync (file "ack") "yes")))}))))]
(t/is (= {:exit-code 0 :stdout "ready\ncomplete\n" :stderr "warning\n"} result))
(t/is (= (select-keys result [:stdout :stderr]) @seen))
(t/is (= "yes" (fs/readFileSync (file "done") "utf8")))))
(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"
"setTimeout(() => process.stdout.write(bytes.subarray(1)), 20);\n")
result (await (within (process/run (node-options source {}))))]
(t/is (= "Ω😀" (:stdout result)))))
(t/deftest ^:async streams-large-output-without-retaining-it
(let [sizes (atom {:stdout 0 :stderr 0})
source (str "process.stdout.write('x'.repeat(256 * 1024));\n"
"process.stderr.write('y'.repeat(128 * 1024));\n")
result (await
(within
(process/run
(node-options source
{:capture-output? false
:on-output (fn [text stream]
(swap! sizes update stream + (count text)))}))))]
(t/is (= {:exit-code 0 :stdout "" :stderr ""} result))
(t/is (= {:stdout (* 256 1024) :stderr (* 128 1024)} @sizes))))
(t/deftest ^:async nonzero-exit-keeps-code-command-and-output
(let [options (node-options
"process.stdout.write('fact\\n'); process.stderr.write('failed\\n'); process.exitCode = 17;"
{})
data (await (rejected (process/run options)))]
(t/is (= :process-exit (:type data)))
(t/is (= (:command options) (:command data)))
(t/is (= 17 (:exit-code data)))
(t/is (nil? (:signal data)))
(t/is (= "fact\n" (:stdout data)))
(t/is (= "failed\n" (:stderr data)))))
(t/deftest ^:async spawn-failure-keeps-os-evidence
(let [command (file "no-such-command")
data (await (rejected (process/run (node-options "" {:command command}))))]
(t/is (= :process-spawn (:type data)))
(t/is (= command (:command data)))
(t/is (= "ENOENT" (:code data)))
(t/is (nil? (:exit-code data)))
(t/is (nil? (:signal data)))))
(t/deftest ^:async expired-deadline-does-not-start-work
(let [data (await (rejected
(process/run
(node-options "fs.writeFileSync('started', 'yes');"
{:deadline (- (js/Date.now) 1)}))))]
(t/is (= :process-timeout (:type data)))
(t/is (= (.-execPath js/process) (:command data)))
(t/is (not (fs/existsSync (file "started"))))
(t/is (not (fs/existsSync (file "root.pid"))))))
(t/deftest ^:async already-aborted-signal-does-not-start-work
(let [controller (js/AbortController.)]
(.abort controller "already-cancelled")
(let [data (await (rejected
(process/run
(node-options "fs.writeFileSync('started', 'yes');"
{:signal (.-signal controller)}))))]
(t/is (= :process-cancelled (:type data)))
(t/is (= "already-cancelled" (:reason data)))
(t/is (not (fs/existsSync (file "started"))))
(t/is (not (fs/existsSync (file "root.pid")))))))
(t/deftest ^:async timeout-kills-the-owner-and-a-term-resistant-descendant
(let [limit (process/deadline 1000)
data (await
(rejected
(process/run
(node-options (str (spawn-descendant) "setInterval(() => {}, 1000);")
{:deadline limit}))))]
(t/is (= :process-timeout (:type data)))
(t/is (= limit (:deadline data)))
(t/is (= "SIGTERM" (:signal data)))
(t/is (fs/existsSync (file "descendant.ready")))
(await (assert-tree-stopped))))
(t/deftest ^:async cancellation-kills-the-whole-owned-group
(let [controller (js/AbortController.)
output (atom "")
groups (atom nil)
data (await
(rejected
(process/run
(node-options
(str (spawn-descendant) "setInterval(() => {}, 1000);")
{:signal (.-signal controller)
:on-output
(fn [text stream]
(when (= :stdout stream)
(swap! output str text)
(when (str/includes? @output "descendant-ready\n")
(reset! groups
{:root-pid (read-pid "root.pid")
:root (:group (process-status (read-pid "root.pid")))
:descendant (:group (process-status (read-pid "descendant.pid")))
:grandchild (:group (process-status (read-pid "grandchild.pid")))
:runner (:group (process-status (.-pid js/process)))})
(.abort controller "cancel-tree"))))}))))]
(t/is (= :process-cancelled (:type data)))
(t/is (= "cancel-tree" (:reason data)))
(t/is (= "SIGTERM" (:signal data)))
(t/is (= (:root-pid @groups) (:root @groups) (:descendant @groups) (:grandchild @groups))
"the root leads the group containing all generations")
(t/is (not= (:runner @groups) (:root @groups)) "the group is separate from the runner")
(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))))
(t/deftest ^:async successful-owner-exit-cleans-descendants-that-hold-the-pipes
(let [source (str (spawn-descendant)
"child.unref();\n"
"const timer = setInterval(() => {\n"
" if (fs.existsSync('descendant.ready')) {\n"
" clearInterval(timer); process.stdout.write('root-complete\\n');\n"
" }\n"
"}, 10);\n")
result (await (within (process/run (node-options source {}))))]
(t/is (= 0 (:exit-code result)))
(t/is (str/includes? (:stdout result) "root-complete\n"))
(t/is (str/includes? (:stdout result) "descendant-ready\n"))
(await (assert-tree-stopped))))
(t/deftest ^:async nonzero-owner-exit-also-cleans-descendants-that-hold-the-pipes
(let [source (str (spawn-descendant)
"child.unref();\n"
"const timer = setInterval(() => {\n"
" if (fs.existsSync('descendant.ready')) {\n"
" clearInterval(timer); process.stderr.write('root-failed\\n');\n"
" process.exitCode = 17;\n"
" }\n"
"}, 10);\n")
data (await (rejected (process/run (node-options source {}))))]
(t/is (= :process-exit (:type data)))
(t/is (= 17 (:exit-code data)))
(t/is (= "root-failed\n" (:stderr data)))
(await (assert-tree-stopped))))
(t/deftest ^:async lock-wait-times-out-and-cancelled-holder-releases-inherited-flock
(let [lock (file "build.lock")
controller (js/AbortController.)
holder (node-source
"holder.pid"
(str "process.on('SIGTERM', () => fs.writeFileSync('holder.term', 'seen'));\n"
"fs.writeFileSync('holder.ready', 'yes');\n"
"setInterval(() => {}, 1000);\n"))
held (rejected
(process/run
(node-options ""
{:command "flock"
:args ["--exclusive" lock (.-execPath js/process) "-e" holder]
:signal (.-signal controller)})))]
(try
(await (wait-for #(fs/existsSync (file "holder.ready"))))
(let [limit (process/deadline 150)
data (await
(rejected
(process/run
(node-options ""
{:command "flock"
:args ["--exclusive" lock (.-execPath js/process) "-e"
(node-source "waiter.pid" "fs.writeFileSync('waiter-acquired', 'yes');")]
:deadline limit}))))]
(t/is (= :process-timeout (:type data)))
(t/is (= limit (:deadline data)))
(t/is (not (fs/existsSync (file "waiter-acquired"))))
(t/is (running? (read-pid "holder.pid")) "the first owner still holds the lock"))
(.abort controller "release-lock")
(let [data (await held)]
(t/is (= :process-cancelled (:type data)))
(t/is (not (running? (read-pid "holder.pid")))))
(let [result (await
(within
(process/run
(node-options ""
{:command "flock"
:args ["--exclusive" "--nonblock" lock (.-execPath js/process) "-e"
(node-source "probe.pid" "fs.writeFileSync('probe-acquired', 'yes');")]}))))]
(t/is (= 0 (:exit-code result)))
(t/is (= "yes" (fs/readFileSync (file "probe-acquired") "utf8")))
(t/is (not (fs/existsSync (file "waiter-acquired"))))
(t/is (= "seen" (fs/readFileSync (file "holder.term") "utf8"))))
(finally
(.abort controller "test-cleanup")
(await held)))))
(t/deftest ^:async real-signals-reach-the-callback-and-remover-restores-listeners
(let [before-int (.listenerCount js/process "SIGINT")
before-term (.listenerCount js/process "SIGTERM")
received (atom [])
next-signal (volatile! nil)
remove (process/on-signals
(fn [signal]
(swap! received conj signal)
(@next-signal signal)))
receive (fn [signal]
(within
(js/Promise.
(fn [resolve _]
(vreset! next-signal resolve)
(.kill js/process (.-pid js/process) signal)))))]
(try
(t/is (= "SIGINT" (await (receive "SIGINT"))))
(t/is (= "SIGTERM" (await (receive "SIGTERM"))))
(t/is (= ["SIGINT" "SIGTERM"] @received))
(finally
(remove)))
(remove)
(t/is (= before-int (.listenerCount js/process "SIGINT")))
(t/is (= before-term (.listenerCount js/process "SIGTERM")))))

View File

@ -10,16 +10,23 @@
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]
[goog.object :as gobj]
[performance-tests.render-wasm.artifacts-test]
[performance-tests.render-wasm.boolean-test]
[performance-tests.render-wasm.browser-test]
[performance-tests.render-wasm.build-test]
[performance-tests.render-wasm.builder-test]
[performance-tests.render-wasm.containers-test]
[performance-tests.render-wasm.contracts-test]
[performance-tests.render-wasm.fingerprint-test]
[performance-tests.render-wasm.geometry-scenes-test]
[performance-tests.render-wasm.lifecycle-test]
[performance-tests.render-wasm.pilot-test]
[performance-tests.render-wasm.process-test]
[performance-tests.render-wasm.protocol-test]
[performance-tests.render-wasm.report-test]
[performance-tests.render-wasm.scene-snapshot-test]))
[performance-tests.render-wasm.runner-test]
[performance-tests.render-wasm.scene-snapshot-test]
[performance-tests.render-wasm.server-test]))
(enable-console-print!)
@ -33,16 +40,23 @@
(.exit js/process 1)))
(def test-namespaces
['performance-tests.render-wasm.boolean-test
['performance-tests.render-wasm.artifacts-test
'performance-tests.render-wasm.boolean-test
'performance-tests.render-wasm.browser-test
'performance-tests.render-wasm.build-test
'performance-tests.render-wasm.builder-test
'performance-tests.render-wasm.containers-test
'performance-tests.render-wasm.contracts-test
'performance-tests.render-wasm.fingerprint-test
'performance-tests.render-wasm.geometry-scenes-test
'performance-tests.render-wasm.lifecycle-test
'performance-tests.render-wasm.pilot-test
'performance-tests.render-wasm.process-test
'performance-tests.render-wasm.protocol-test
'performance-tests.render-wasm.report-test
'performance-tests.render-wasm.scene-snapshot-test])
'performance-tests.render-wasm.runner-test
'performance-tests.render-wasm.scene-snapshot-test
'performance-tests.render-wasm.server-test])
(assert (every? find-ns-obj test-namespaces)
"test-namespaces contains a namespace that isn't required in runner.cljs")
@ -67,22 +81,22 @@
(let [args (->> (.-argv js/process)
(array-seq)
(drop 2))]
;; `pnpm run test:performance-tests -- --focus ...` forwards the separator to
;; the node process, so drop one leading `--` before handing args to
;; `pnpm run test:renderer-benchmarks -- --focus ...` forwards the separator
;; to the node process, so drop one leading `--` before handing args to
;; tools.cli.
(cond-> args
(= "--" (first args)) rest)))
(defn- usage
[summary]
(str "Usage: pnpm run test:performance-tests -- [options]\n\n"
(str "Usage: pnpm run test:renderer-benchmarks -- [options]\n\n"
"Options:\n"
summary "\n\n"
"Focus examples:\n"
" pnpm run test:performance-tests -- --focus performance-tests.render-wasm.contracts-test\n"
" pnpm run test:performance-tests -- --focus performance-tests.render-wasm.contracts-test/some-test-var\n\n"
" pnpm run test:renderer-benchmarks -- --focus performance-tests.render-wasm.contracts-test\n"
" pnpm run test:renderer-benchmarks -- --focus performance-tests.render-wasm.contracts-test/some-test-var\n\n"
"Log level example (quiets app logging during the run):\n"
" pnpm run test:performance-tests -- --focus performance-tests.render-wasm.contracts-test --log-level warn"))
" pnpm run test:renderer-benchmarks -- --focus performance-tests.render-wasm.contracts-test --log-level warn"))
(defn- fail!
[message]

View File

@ -0,0 +1,81 @@
;; 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.runner-test
(:require
[benches.render-wasm.node.process :as process]
[benches.render-wasm.node.runner :as runner]
[cljs.test :as t :include-macros true]
[clojure.string :as str]))
(t/deftest build-parses-defaults-and-explicit-functional-feature-selection
(let [{:keys [command options]} (runner/parse-args ["build"])]
(t/is (= "build" command))
(t/is (true? (:default-features options)))
(t/is (= process/default-build-timeout-ms (:build-timeout-ms options))))
(let [{:keys [command options]} (runner/parse-args
["--" "build" "--no-default-features"
"--features" "functional_b,functional-a,functional_b"
"--build-timeout-ms" "1250"])]
(t/is (= "build" command))
(t/is (= {:default-features false
:features ["functional-a" "functional_b"]
:build-timeout-ms 1250}
(select-keys options [:default-features :features :build-timeout-ms])))))
(t/deftest diagnostic-and-malformed-features-fail-at-the-parser-boundary
(doseq [feature ["stats" "profile" "profile-macros" "profile-raf"]]
(t/is (thrown-with-msg? js/Error #"diagnostic Cargo features"
(runner/parse-args ["build" "--features" (str "functional," feature)]))))
(doseq [feature ["" "functional,,other" "functional/other"]]
(t/is (thrown-with-msg? js/Error #"invalid Cargo feature selection"
(runner/parse-args ["build" "--features" feature]))))
(t/is (thrown? js/Error (runner/parse-args ["build" "--features"]))))
(t/deftest preparation-budget-requires-a-complete-positive-safe-integer-number
;; Number accepts whitespace and exponent notation when the result is an
;; integer; these are valid CLI budgets, not partial numeric parses.
(doseq [[text expected] [["1" 1] [" 1000 " 1000] ["1e3" 1000]]]
(t/is (= expected (get-in (runner/parse-args ["build" "--build-timeout-ms" text])
[:options :build-timeout-ms]))))
(doseq [text ["" "0" "-1" "1.5" "1000ms" "NaN" "Infinity" "9007199254740992"]]
(t/is (thrown-with-msg? js/Error #"Must be a positive integer"
(runner/parse-args ["build" "--build-timeout-ms" text]))))
(t/is (thrown? js/Error (runner/parse-args ["build" "--build-timeout-ms"]))))
(t/deftest purge-categories-and-build-flags-cannot-be-mixed
(doseq [[args selected] [[["purge"] {}]
[["purge" "--only-builds"] {:only-builds true}]
[["purge" "--only-runs"] {:only-runs true}]]]
(let [{:keys [command options]} (runner/parse-args args)]
(t/is (= "purge" command))
(t/is (= selected (select-keys options [:only-builds :only-runs])))))
(t/is (thrown-with-msg? js/Error #"mutually exclusive"
(runner/parse-args ["purge" "--only-builds" "--only-runs"])))
(doseq [flag ["--only-builds" "--only-runs"]]
(t/is (thrown-with-msg? js/Error #"purge category flags require purge"
(runner/parse-args ["build" flag]))))
(doseq [args [["purge" "--default-features"]
["purge" "--no-default-features"]
["purge" "--features" "functional"]
["purge" "--build-timeout-ms" "1000"]
["purge" "--features=functional"]
["purge" "--build-timeout-ms=1000"]]]
(t/is (thrown-with-msg? js/Error #"build options require build"
(runner/parse-args args)))))
(t/deftest help-needs-no-command-and-other-command-lines-must-be-valid
(doseq [args [["--help"] ["-h"] ["build" "--help"]]]
(let [{:keys [options summary]} (runner/parse-args args)
help (runner/usage summary)]
(t/is (true? (:help options)))
(t/is (str/includes? help "runner build"))
(t/is (str/includes? help "runner purge"))
(t/is (str/includes? help "--build-timeout-ms"))))
(t/is (thrown-with-msg? js/Error #"expected build or purge"
(runner/parse-args [])))
(doseq [args [["unknown"] ["build" "purge"] ["build" "--unknown"]]]
(t/is (thrown? js/Error (runner/parse-args args)))))

View File

@ -0,0 +1,185 @@
;; 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 INC
(ns performance-tests.render-wasm.server-test
(:require
["fs" :as fs]
["http" :as http]
["net" :as net]
["os" :as os]
["path" :as path]
[benches.render-wasm.node.server :as server]
[cljs.test :as t :include-macros true]))
(def ^:private temporary-root (atom nil))
(def ^:private wasm-bytes [0 97 115 109 1 0 0 0])
(defn- write-file
[file content]
(fs/mkdirSync (path/dirname file) #js {:recursive true})
(fs/writeFileSync file content))
(t/use-fixtures :each
{:before (fn []
(let [root (fs/mkdtempSync (path/join (os/tmpdir) "penpot-render-http-"))
dir (path/join root "selected")]
(reset! temporary-root root)
(write-file (path/join dir "index.html") "<!doctype html><title>selected</title>")
(write-file (path/join dir "browser" "browser.js") "export const selected = true;")
(write-file (path/join dir "cases.cjs") "module.exports = {};")
(write-file (path/join dir "renderer" "render-wasm.wasm")
(js/Buffer.from (to-array wasm-bytes)))
(write-file (path/join root "selected-outside" "secret.txt") "private sibling")
(write-file (path/join root "outside.txt") "private file")))
:after #(fs/rmSync @temporary-root #js {:recursive true :force true})})
(defn- build
[]
{:id "selected-http-build" :dir (path/join @temporary-root "selected")})
(defn- request
[host request-path method]
(js/Promise.
(fn [resolve reject]
(let [address (js/URL. (:base-url host))
req (http/request
;; Supplying a raw path avoids URL normalization hiding traversal.
#js {:hostname (.-hostname address)
:port (.-port address)
:path request-path
:method method
:agent false}
(fn [response]
(let [chunks (atom [])]
(.on ^js response "data" #(swap! chunks conj %))
(.once ^js response "error" reject)
(.once ^js response "end"
#(resolve {:status (.-statusCode response)
:headers (js->clj (.-headers response))
:body (js/Buffer.concat (to-array @chunks))})))))]
(.once ^js req "error" reject)
(.setTimeout ^js req 3000 #(.destroy ^js req (js/Error. "test request timed out")))
(.end ^js req)))))
(defn- ^:async request-failure
[host]
(try
(await (request host "/" "GET"))
nil
(catch :default error error)))
(t/deftest ^:async serves-only-the-selected-build-with-head-and-artifact-mime-types
(let [selected (build)
host (await (server/open selected))]
(try
(t/is (= selected (:build host)))
(t/is (re-matches #"http://127\.0\.0\.1:[0-9]+" (:base-url host)))
(let [index (await (request host "/?unused=query" "GET"))
browser (await (request host "/browser/browser.js" "GET"))
cjs (await (request host "/cases.cjs" "GET"))
wasm (await (request host "/renderer/render-wasm.wasm" "GET"))
head (await (request host "/renderer/render-wasm.wasm" "HEAD"))]
(t/is (= 200 (:status index)))
(t/is (= "<!doctype html><title>selected</title>" (.toString (:body index) "utf8")))
(t/is (= "text/html; charset=utf-8" (get-in index [:headers "content-type"])))
(t/is (= "export const selected = true;" (.toString (:body browser) "utf8")))
(t/is (= "application/javascript" (get-in browser [:headers "content-type"])))
(t/is (= "application/javascript" (get-in cjs [:headers "content-type"])))
(t/is (= "application/wasm" (get-in wasm [:headers "content-type"])))
(t/is (zero? (js/Buffer.compare (:body wasm) (js/Buffer.from (to-array wasm-bytes)))))
(t/is (= 200 (:status head)))
(t/is (= "8" (get-in head [:headers "content-length"])))
(t/is (zero? (.-length (:body head)))))
(t/is (= 404 (:status (await (request host "/selected-outside/secret.txt" "GET")))))
(t/is (= 405 (:status (await (request host "/" "POST")))))
(finally
(await (server/close host))))))
(t/deftest ^:async rejects-raw-traversal-and-outside-file-and-directory-symlinks
(let [selected (build)
dir (:dir selected)]
(fs/symlinkSync (path/join @temporary-root "outside.txt") (path/join dir "escape.txt"))
(fs/symlinkSync (path/join @temporary-root "selected-outside") (path/join dir "linked") "dir")
(let [host (await (server/open selected))]
(try
(doseq [request-path ["/../selected-outside/secret.txt"
"/%2e%2e/selected-outside/secret.txt"
"/%2e%2e%2fselected-outside%2fsecret.txt"
"/%5c..%5cselected-outside%5csecret.txt"
"/escape.txt" "/linked/secret.txt"]]
(let [response (await (request host request-path "GET"))]
(t/is (= 403 (:status response)) request-path)
(t/is (= "forbidden" (.toString (:body response) "utf8")) request-path)))
(t/is (= 400 (:status (await (request host "/%zz" "GET")))))
(t/is (= 403 (:status (await (request host "/%00" "GET")))))
(t/is (= 404 (:status (await (request host "/missing-file" "GET")))))
(t/is (= 404 (:status (await (request host "/browser" "GET")))))
(finally
(await (server/close host)))))))
(defn- connect
[host]
(js/Promise.
(fn [resolve reject]
(let [address (js/URL. (:base-url host))
socket (net/createConnection #js {:host "127.0.0.1" :port (js/Number (.-port address))})]
(.once ^js socket "error" reject)
(.once ^js socket "connect" #(resolve socket))))))
(defn- bounded
[promise]
(js/Promise.
(fn [resolve reject]
(let [timer (js/setTimeout #(reject (js/Error. "test shutdown timed out")) 3000)]
(.then promise
(fn [value] (js/clearTimeout timer) (resolve value))
(fn [error] (js/clearTimeout timer) (reject error)))))))
(t/deftest ^:async close-destroys-owned-connections-and-keeps-other-servers-live
(let [host (await (server/open (build)))]
(try
(let [other (await (server/open (build)))]
(try
(let [socket (await (connect host))
closed (js/Promise. (fn [resolve _] (.once ^js socket "close" resolve)))]
(try
(await (bounded (js/Promise.all (to-array [(server/close host) (server/close host)]))))
(await (bounded closed))
(t/is (some? (await (request-failure host))))
(let [response (await (request other "/" "GET"))]
(t/is (= 200 (:status response)))
(t/is (= "<!doctype html><title>selected</title>" (.toString (:body response) "utf8"))))
(await (server/close host))
(finally
(.destroy ^js socket))))
(finally
(await (server/close other)))))
(finally
(await (server/close host))))))
(defn- ^:async startup-failure
[opening]
(try
(let [host (await opening)]
(await (server/close host))
nil)
(catch :default error error)))
(t/deftest ^:async startup-rejects-already-aborted-and-in-flight-signals
(let [already (js/AbortController.)]
(.abort already)
(let [error (await (startup-failure (server/open (build) {:signal (.-signal already)})))]
(t/is (= ::server/aborted (:type (ex-data error))))))
(let [controller (js/AbortController.)
opening (server/open (build) {:signal (.-signal controller)})]
(.abort controller)
(let [error (await (startup-failure opening))]
(t/is (= ::server/aborted (:type (ex-data error))))))
(let [host (await (server/open (build) {:startup-timeout-ms 3000}))]
(try
(t/is (= 200 (:status (await (request host "/" "GET")))))
(finally
(await (server/close host))))))