github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Run the composable component cases on the JVM

Browse Source 
The composable test engine, nodes, setups and cases lived in the
frontend test tree, so only the frontend interpreter could run them.

Move them to CLJC test helpers under app.common.test-helpers.composable
and add a pure runner (comp.runner) that does what the workspace does
around each operation, without the frontend store:
- after a user operation it syncs the changed components until none is
  left, as the frontend watcher does with one pass per sync commit;
- the operation and its syncs form one undo group, and the undo node
  reverts the latest one;
- it validates the file once the sync or the undo has settled.

Each node declares its kind: assembly, user, undo or frontend-only.
User nodes record the production changes they apply, and the runner
throws when a node breaks that. The swap and switch nodes build their
changes with the production clv/generate-component-swap-in-place.
Rotate and ChangeHeight need the frontend placement step, so the pure
runner rejects them.

The cases are zero-arg functions in comp.cases, shared by the frontend
interpreter and common-tests.logic.composable-sync-test. The latter
runs cases B to M and the new case O, a switch of an overridden copy,
on the JVM and in JS. Case N and the rotation case stay frontend-only.
This commit is contained in:
alonso.torres 2026-10-09 11:51:04 +02:00
parent 33e9caead3
commit 00c7823098
11 changed files with 1313 additions and 531 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
.serena/memories/frontend/composable-component-tests.md
View File

@ -4,8 +4,10 @@ A framework concept for systematically testing Penpot's component subsystem
(synchronisation/propagation, swaps, variant switches, nesting, overrides), implemented in TWO test
suites that share the principles below:
1. **ClojureScript suite** — in the frontend test tree (`frontend/test/frontend_tests/
composable_tests/`), driving a minimally-assembled real app headlessly. The original.
1. **ClojureScript suite** — engine, nodes and setups in common
(`common/src/app/common/test_helpers/composable/`, CLJC), interpreter and cases in the
frontend test tree (`frontend/test/frontend_tests/composable_tests/`), driving a
minimally-assembled real app headlessly. The original.
2. **TypeScript suite** — a Penpot plugin (`plugins/apps/composable-test-suite/`), driving the FULL
production app end-to-end through the Plugin API, with a slightly more elaborate set of
abstractions. Runs interactively (panel), remotely (Playwright), and headlessly in CI. Its
@ -55,20 +57,58 @@ tests.
---
# ClojureScript suite (frontend test tree)
# ClojureScript suite
Test-only `.cljs` code in the frontend test tree (nothing "common" about it). A **situation** =
The engine, nodes and setups are CLJC test helpers in common and load on the JVM and in
CLJS; only the interpreter and the cases are frontend code. A **situation** =
the in-memory file value + named roles + `:vars` + an ordered applied-log. Operations are records
implementing `IOperation`/`apply-to` (`apply` collides with core). Assertions = inline `Test` ops
and/or a trailing asserter; the runner makes no judgment. Failures carry `describe-applied` (the
transcript), which is what makes a failing variant in a sweep identifiable.
Layout: `core.cljs` (the domain-agnostic engine: situation, identity/transcript, roles/targets,
operators, runners), `comp/setups.cljs` (setups + role accessors), `comp/nodes.cljs` (the component
operations and their check duals), `interpreter.cljs` (runs cases against the real frontend),
`comp/sync_test.cljs` (the cases; registered in `frontend_tests/runner.cljs`). Case letters B..N;
Layout:
- common, `app.common.test-helpers.composable.*`: `core.cljc` (the domain-agnostic engine:
situation, identity/transcript, roles/targets, operators, runners), `comp/setups.cljc`
(setups + role accessors), `comp/nodes.cljc` (the component operations and their check
duals), `comp/runner.cljc` (pure runner), `comp/cases.cljc` (THE cases, shared by both
runners). No frontend requires allowed here.
- frontend, `frontend-tests.composable-tests.*`: `interpreter.cljs` (runs cases against the
real frontend), `comp/sync_test.cljs` (one `t/async` deftest per shared case; registered in
`frontend_tests/runner.cljs`).
- JVM/JS: `common-tests.logic.composable-sync-test` runs the shared cases through the pure
runner; all except N and the rotation case (placement step). Same assertion counts as the
frontend for the shared subset (174).
A case is a zero-arg fn in `cases.cljc` returning `{:setup :operation :asserter}`; assertions
use `clojure.test` (aliased to `cljs.test` in CLJS), inline (`test-that`) or in `:asserter`.
`ftm/check done case-map` reads `:asserter` from the map. Write a new case there, then add a
wrapper deftest in BOTH test namespaces (or only the frontend one if it needs frontend code).
Two pure runners (no store, JVM + CLJS):
- `core/run-variant`/`run-all`: apply nodes only (no sync, `n/undo` throws). For engine tests.
- `comp.runner/run-variant`/`run-all`: the case runner. Every comp node declares its kind via
`n/IComponentOperation` (`op-kind`: `:assembly`, `:user`, `:undo`, `:frontend-only`); the
runner and the interpreter's `sync-op?` dispatch on it. A NEW node MUST implement it. User ops
record their production changes (`n/record-changes`, nil when nothing changed); the runner
throws if a `:user` op records nothing or another kind records changes. After a user op the
runner syncs to a fixpoint (`ch/components-changed` + `generate-sync-file-changes`, one pass
per cascade level, like the frontend watcher) and pushes op + syncs as one undo group.
`n/undo` reverts the latest group, no re-sync. The runner validates the file (against the
situation's files) once settled: after the sync fixpoint and after an undo group; never
between cascade passes, where an outer copy still points at the component its main dropped
(`:component-id-mismatch`), nor with `{:sync? false}`. Assembly ops (create/instantiate/nest/variant
container): no sync, no undo group. `ResetCopyInstance` is a user op here (sync + undo),
unlike the interpreter (file install). `{:sync? false}` disables sync. `Rotate`/`ChangeHeight`
are `:frontend-only` and throw `::runner/frontend-only` (the placement step is frontend code). Swap and switch nodes use the production
`clv/generate-component-swap-in-place` (+ `clv/find-switch-target` for switch), the same code the
frontend events call. Not modelled: the `:modified-at` bump, and the swap/switch event follow-ups
(token propagation, WASM text resize, layout update). Tests:
`common-tests.logic.composable-runner-test`.
- Label map gotcha: running a second variant re-registers labels, so assert on a situation
before running the next one (`thi/id` then points at the new run's shapes). Case letters B..O;
the sweeps (K: depth × edit-precedence; L: swaps; M: variant switches; N: rotated-instance
geometry, on the #10109 fix branch until merged) are the flagship pattern — read them before
geometry, on the #10109 fix branch until merged; O: switch of an overridden copy, mains
agreeing or not) are the flagship pattern — read them before
writing a new sweep.
**Scenario lineage model** (behind the sweeps): scenario ops track named component lineages as
@ -92,7 +132,8 @@ STORE-SWAP IMMUNITY: other test namespaces `set!` `st/state`/`st/stream` and nev
the `app.main.refs` lenses stay bound to the ORIGINAL atoms — propagation then dies silently. The
interpreter captures the atoms at namespace-load time and re-`set!`s them per variant.
Running: `cd frontend && pnpm run build:test`, then
Running (JVM): `cd common && clojure -M:dev:test --focus common-tests.logic.composable-sync-test`.
Running (frontend): `cd frontend && pnpm run build:test`, then
`node target/tests/test.js --focus frontend-tests.composable-tests.comp.sync-test`
(var-level focus for one case).
@ -103,7 +144,7 @@ unwired subscription and verify by PROBING store state, not by trusting a green
**Caveats:** inline `Test` exceptions are UNCAUGHT on the frontend (crash the runner — assert in
the trailing asserter). `(optional (in-sequence …))` is not flattened for the interpreter — use
independent optionals. The Serena/clj-kondo cache for `nodes.cljs` goes stale (phantom symbols) —
independent optionals. The Serena/clj-kondo cache for `nodes.cljc` goes stale (phantom symbols) —
trust the build. Cross-namespace global-state leaks land in this suite first; suspect them before
the framework on inexplicable full-run-only failures. Case H's `sync-file` schedules a delayed RPC
that fails headless (benign; absorbed by per-op grace).

430
common/src/app/common/test_helpers/composable/comp/cases.cljc Normal file
View File

@ -0,0 +1,430 @@
;; 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 app.common.test-helpers.composable.comp.cases
"Component-behaviour cases authored on the composable test model, shared by
both runners: the frontend interpreter (the real app, in
`frontend-tests.composable-tests.comp.sync-test`) and the pure runner
(`app.common.test-helpers.composable.comp.runner`, in
`common-tests.logic.composable-sync-test`).
Each case is a zero-arg function returning `{:setup :operation :asserter}`.
Assertions use `clojure.test` (`cljs.test` in CLJS), inline through `Test`
operations and/or in the optional trailing `:asserter`, which receives the
resulting situation of each enumerated variant. A case contains only the user
edits: the runner syncs copies on its own, and that is what the cases
assert.
The cases (see `mem:frontend/composable-component-tests` for details):
B — an override on a copy child survives a later main change (touched gate).
C — a sweep (one-of) over several attribute changes, each propagating.
D — a shape added to the main is structurally propagated (ref-integrity).
E — a middle shape removed from the main; survivors keep order.
F — reordering a shape in the main; order propagates, identity preserved.
H — locality: a library main's change reaches the consuming file's copy on
the explicit library sync (cross-file propagation).
I — undo reverses an edit AND its propagation.
K — the synchronisation sweep: depth x edit-targets, with override-precedence
and reset checkpoints.
L — the swap sweep: swaps at any subset of nesting levels.
M — the variant-switch sweep: case L with variant switches.
O — a variant switch keeps a copy override only where the mains agree.
N — geometry sync with rotated instances (needs the frontend placement step).
Rotation — a touched copy child survives a main rotation (frontend only too)."
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
[app.common.test-helpers.composable.comp.nodes :as n]
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.files :as thf]
[app.common.types.component :as ctk]
[app.common.types.shape-tree :as ctst]
[clojure.test :as t]))
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
(def ^:private blue "#0000ff")
;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.)
(defn copy-override-survives-later-main-change
"Case B."
[]
(let [override (n/change-attr :copy-child :fills green)] ; touch the copy first
{:setup setup/simple-component-with-labeled-copy
;; override the copy, then change the main; sync runs after each edit. The
;; override must survive (touched-flag gate).
:operation (tm/in-sequence
[override
(n/change-attr :main-child :fills red)])
:asserter (fn [situation]
(let [copy-child (setup/copy-instance situation)]
(t/is (n/has-attr? override copy-child))
(t/is (contains? (:touched copy-child) :fill-group))
(t/is (some? (:shape-ref copy-child)))))}))
(defn attribute-sweep-propagates-to-clean-copy
"Case C."
[]
(let [sweep (tm/one-of
[(n/change-attr :main-child :fills red)
(n/change-attr :main-child :opacity 0.5)])]
{:setup setup/simple-component-with-copy
:operation (tm/in-sequence [sweep])
:asserter (fn [situation]
(let [chosen (tm/get-choice situation sweep)]
(t/is (some? chosen))
(t/is (n/has-attr? chosen (setup/copy-instance situation)))))}))
(defn add-shape-to-main-propagates-to-clean-copy
"Case D."
[]
(let [add (n/add-child :main-root :main-child-2)]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [add])
:asserter (fn [situation]
(let [copy-root (setup/copy-root situation)
main-new (n/added-shape add situation)
copy-new (n/materialized-instance-child add situation copy-root)]
(t/is (some? copy-new))
(t/is (ctk/is-main-of? main-new copy-new))
(t/is (ctst/parent-of? copy-root copy-new))
(t/is (nil? (:touched copy-new)))))}))
(defn remove-shape-from-main-propagates-to-clean-copy
"Case E."
[]
(let [removal (n/remove-child :main-child2)]
{:setup setup/component-with-many-children
:operation (tm/in-sequence [removal])
:asserter (fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c3 (setup/copy-child situation 3)]
(t/is (= 2 (count order)))
(t/is (= (nth order 0) (:id c1)))
(t/is (= (nth order 1) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c3)))
(t/is (nil? (:touched copy-root)))))}))
(defn move-shape-in-main-propagates-order-to-clean-copy
"Case F."
[]
(let [move (n/move-child :main-child1 :main-root 2)]
{:setup setup/component-with-many-children
:operation (tm/in-sequence [move])
:asserter (fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c2 (setup/copy-child situation 2)
c3 (setup/copy-child situation 3)]
(t/is (= (nth order 0) (:id c2)))
(t/is (= (nth order 1) (:id c1)))
(t/is (= (nth order 2) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c2)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c2)))
(t/is (nil? (:touched c3)))))}))
(defn undo-reverts-edit-and-its-propagation
"Case I. Change the main (which propagates to the clean copy), then undo. A
single undo reverses the whole logical action — the edit AND its
propagation — so the copy returns to baseline and is left untouched."
[]
(let [original "#abcdef" ; the labeled setup's starting fill
baseline (n/change-attr :main-child :fills original) ; expected-VALUE descriptor
change (n/change-attr :main-child :fills red)]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [change (n/undo)])
:asserter (fn [situation]
(let [copy (setup/copy-instance situation)
main (setup/main-instance situation)]
;; the edit was reversed on the main …
(t/is (n/has-attr? baseline main))
;; … and on the copy (the propagation was reversed too) …
(t/is (n/has-attr? baseline copy))
;; … leaving the copy clean.
(t/is (nil? (:touched copy)))))}))
(defn library-change-propagates-across-file-boundary-on-sync
"Case H. The main lives in a linked LIBRARY, the copy in the consuming
(current) file. The library main has diverged (setup applied `red` to it,
leaving the copy stale). In-file sync does NOT cross the file boundary; the
app propagates via the library-UPDATE action, so the operation is
`sync-from-library`. `expected` is only an expected-VALUE descriptor (its
target is irrelevant; `has-attr?` uses just attr+value)."
[]
(let [expected (n/change-attr :main-child :fills red)]
{:setup #(setup/cross-file-component-with-copy red)
:operation (tm/in-sequence [(n/sync-from-library)])
:asserter (fn [situation]
(t/is (n/has-attr? expected (setup/copy-instance situation))))}))
(defn synchronisation-scenarios
"Case K. CONSOLIDATED SCENARIO SWEEP — one composition standing in for many
cases. Built from the sync-scenario operations on an empty situation. It
sweeps:
- DEPTH 0/1/2 via two independent `(optional (make-nested-component ...))`
- which EDITS were made via three independent `(optional change-*)`
and asserts, at INLINE checkpoints, the override-precedence and reset rules.
The change targets are the tracked lineage rects, so the same composition
holds at any depth. Subsumes the flat/nested propagation cases (A/G/J)."
[]
(let [m "main"
change-remote (n/change-property (n/remote-rect-of m) :fills red)
change-main (n/change-property (n/main-rect-of m) :fills green)
change-copy (n/change-property (n/copy-rect-of m) :fills blue)
copy-rect (fn [s] (n/lineage-copy-rect s m))
;; precedence at the copy: copy override wins; else main; else remote.
expected-after-edits
(fn [s]
(cond
(tm/applied? s change-copy) (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-main) (n/has-property-of change-main (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-remote) (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s)))
:else true))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
;; depth sweep: two independent optionals give depths 0/1/2
;; (depth 1 appears twice — harmless) without nesting a
;; Sequence inside an optional.
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(n/instantiate-copy m)
(tm/optional change-remote)
(tm/optional change-main)
(tm/optional change-copy)
(tm/test-that (fn [s] (t/is (expected-after-edits s))))
;; force a copy override, observe it wins, then reset it away
change-copy
(tm/test-that
(fn [s] (t/is (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s))))))
(n/reset-copy-instance m)
(tm/test-that
(fn [s]
;; after reset: main's value if main changed, else remote's
;; if remote changed (else the original — not asserted).
(cond
(tm/applied? s change-main) (t/is (n/has-property-of change-main (tm/shape-by-id s (copy-rect s))))
(tm/applied? s change-remote) (t/is (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s))))
:else true)))])}))
(defn- level-color
"The fill colour of the rect currently at lineage `name`'s nesting level `i`."
[s name i]
(-> (tm/shape-by-id s (n/level-rect s name i)) :fills first :fill-color))
(def ^:private base-color "#aaaaaa")
(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets
(defn swap-scenarios
"Case L. SWAP SWEEP — build a 3-level nesting, then OPTIONALLY swap the
nested component at each level for a differently-coloured one, and assert
the colour that surfaces at every level. A swap at level i propagates to
level i and every OUTER (higher-index) level, until a swap at a higher level
overrides it. So the colour at level i is the swap at the HIGHEST index
j <= i that was applied, else the base colour."
[]
(let [m "main"
targets ["s0" "s1" "s2"]
;; swap[i] swaps level i's nested component for target lineage i (color i)
swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3))
expected-at
(fn [s i]
;; the colour of the applied swap at the highest j <= i, else base
(or (some (fn [j] (when (tm/applied? s (nth swaps j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
[(n/create-component m base-color)]
;; a target lineage per level
(map-indexed (fn [i c] (n/create-component (nth targets i) c)) swap-colors)
[(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)]
;; optionally swap at each level
(map (fn [sw] (tm/optional sw)) swaps)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))
(defn variant-switch-scenarios
"Case M. VARIANT-SWITCH SWEEP — the variant-switch flavour of case L. Build
a variant SET of peer members and nest the base member at EVERY level (so
each level has a variant head, just as case L's swap target exists at every
level). Then OPTIONALLY switch the variant head at each level to a
differently-coloured sibling and assert the colour that surfaces at every
level. A variant switch is a keep-touched swap, so it propagates like case
L: the colour at level i is the switch at the HIGHEST index j <= i that was
applied, else the base member's colour."
[]
(let [m "main" ; the nesting lineage (holds the nesting-data)
vset "vset" ; the variant set
vals ["v0" "v1" "v2" "v3"]
colors (into [base-color] swap-colors) ; base + sibling colours
;; switch[i] switches level i's variant head to member i+1 (colour i). The
;; single variant instance has a corresponding (switchable) head at every
;; level — `nested-head` IS the deepest instance there — so we can switch at
;; ANY level, exactly like case L's per-level swap.
switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth vals (inc i))))
(range 3))
expected-at
(fn [s i]
;; same precedence as case L
(or (some (fn [j] (when (tm/applied? s (nth switches j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
;; the nesting lineage, and the variant set (members = [value color])
[(n/create-component m base-color)
(n/make-variant-container vset (mapv vector vals colors))]
;; introduce the variant instance ONCE (innermost), then wrap it
;; with plain nesting so each outer level CONTAINS the one below
;; (progressive nesting, like case L). nested-head at every level
;; is then the variant (the deepest instance), so a switch at
;; level i targets it and propagates OUTWARD — exactly like case
;; L's swap.
[(n/make-nested-component-with-variant m vset "v0")
(n/make-nested-component m)
(n/make-nested-component m)]
;; optionally switch each level's variant head to its target sibling
(map (fn [sw] (tm/optional sw)) switches)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))
(defn variant-switch-keeps-override-only-where-mains-agree
"Case O. A copy overrides the fill of its nested variant's rect, then the
variant head inside the copy is switched to the other member. Sweeps a
variant set whose members agree on the rect fill and one where they
differ. Per decision (a) of `mem:common/component-sync-contract`, the
override is carried only when the old and new mains agree: then the rect
keeps it and stays touched; otherwise it takes the new member's fill and
is not touched."
[]
(let [m "main"
agree (n/make-variant-container "vset" [["a" base-color] ["b" base-color]])
differ (n/make-variant-container "vset" [["a" base-color] ["b" red]])
override (n/change-property (n/copy-rect-of m) :fills green)
;; the variant head inside the copy holds the copy rect
copy-head (fn [s] (:parent-id (tm/shape-by-id s (n/lineage-copy-rect s m))))
;; after the switch, the copy rect is the one copying member b's rect
switched (fn [s]
(let [b-rect (:rect-id (n/variant-member s "vset" "b"))
objects (:objects (thf/current-page (tm/file s)))]
(d/seek #(= b-rect (:shape-ref %)) (vals objects))))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color)
(tm/one-of [agree differ])
(n/make-nested-component-with-variant m "vset" "a")
(n/instantiate-copy m)
override
(n/switch-variant copy-head "b")])
:asserter (fn [situation]
(let [rect (switched situation)]
(t/is (some? rect))
(if (tm/applied? situation agree)
(do
(t/is (n/has-property-of override rect))
(t/is (contains? (:touched rect) :fill-group)))
(do
(t/is (= red (-> rect :fills first :fill-color)))
(t/is (not (contains? (:touched rect) :fill-group)))))))}))
(defn geometry-sync-with-rotated-instances
"Case N. Regression sweep for #10109, with #13267's semantics as its
complement: an instance root's transformation is inherited, overridable
content — asymmetric to position, which is free per-instance placement.
On the simple component-with-copy, sweep three axes: optionally rotate the
COPY as a whole (an override of its root's placement — must not block
propagation), optionally rotate the MAIN as a whole (inherited content — an
untouched copy must follow it), and apply ONE of a property edit (fills) or
a geometry edit (height) to the main child. In EVERY variant the chosen edit
must arrive at the copy child; the copy's rotation is its own 45° if the
copy was rotated (override wins), else the main's 45° if the main was
rotated (clean copy follows), else 0; and only a rotated copy's ROOT is
touched (:geometry-group) — its child merely follows and stays untouched."
[]
(let [rotate-copy (n/rotate :copy-root 45)
rotate-main (n/rotate :main-root 45)
edits (tm/one-of
[(n/change-attr :main-instance :fills red)
(n/change-height :main-instance 80)])]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(tm/optional rotate-copy)
(tm/optional rotate-main)
edits])
:asserter (fn [situation]
(let [chosen (tm/get-choice situation edits)
copy-root (setup/copy-root situation)
copy-child (setup/copy-instance situation)
expected-rotation (cond
(tm/applied? situation rotate-copy) 45
(tm/applied? situation rotate-main) 45
:else 0)]
;; the chosen main edit arrived at the copy child, in every variant
(t/is (some? chosen))
(t/is (n/has-property-of chosen copy-child))
;; the copy shows the expected rotation (own override > followed main > none)
(t/is (mth/close? (or (:rotation copy-root) 0) expected-rotation))
(t/is (mth/close? (or (:rotation copy-child) 0) expected-rotation))
;; only a rotated copy's ROOT is an override; the child merely follows
(t/is (= (if (tm/applied? situation rotate-copy) #{:geometry-group} nil)
(:touched copy-root)))
(t/is (nil? (:touched copy-child)))))}))
(defn touched-copy-child-survives-main-rotation
"A copy whose ROOT is rotated (a geometry override) AND whose CHILD has its
own geometry override (resized) must keep the child exactly in place when
the MAIN is later rotated: the child's placement is its own, shielded by its
touched :geometry-group. We capture the child's position relative to the
copy root before the main rotation and assert it is unchanged after."
[]
(let [before (atom nil)
rel-pos (fn [situation]
(let [child (setup/copy-instance situation)
root (setup/copy-root situation)]
(-> (gpt/subtract (grc/rect->center (:selrect child))
(grc/rect->center (:selrect root)))
(gpt/transform (:transform-inverse root (gmt/matrix))))))
capture (tm/test-that (fn [s] (reset! before (rel-pos s)) (t/is (some? @before))))]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/rotate :copy-root 30)
(n/change-height :copy-instance 60)
capture
(n/rotate :main-root 40)])
:asserter (fn [situation]
(let [copy-child (setup/copy-instance situation)
copy-root (setup/copy-root situation)
after (rel-pos situation)]
;; both overrides are recorded as geometry touches
(t/is (contains? (:touched copy-root) :geometry-group))
(t/is (contains? (:touched copy-child) :geometry-group))
;; the child keeps its own overridden height
(t/is (mth/close? (:height copy-child) 60))
;; and its position relative to the copy root is unchanged by the main rotation
(t/is (mth/close? (:x @before) (:x after) 0.5) (str "rel-x " (:x @before) " -> " (:x after)))
(t/is (mth/close? (:y @before) (:y after) 0.5) (str "rel-y " (:y @before) " -> " (:y after)))))}))

262
frontend/test/frontend_tests/composable_tests/comp/nodes.cljs → common/src/app/common/test_helpers/composable/comp/nodes.cljc
View File

@ -4,14 +4,14 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.comp.nodes
(ns app.common.test-helpers.composable.comp.nodes
"Component-specific operation nodes for the test model.
These are the `IOperation` implementations whose subject is Penpot component
behaviour: they wrap component/shape operations and drive the real production
change pipeline. This namespace sits behind the `comp` boundary precisely
because it is about components; the generic engine in
`frontend-tests.composable-tests.core` has no domain terms. See
`app.common.test-helpers.composable.core` has no domain terms. See
`mem:frontend/composable-component-tests`.
Nodes deliberately call the production change pipeline directly
@ -26,6 +26,7 @@
[app.common.data :as d]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.files.shapes-helpers :as cfsh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.logic.libraries :as cll]
@ -33,13 +34,52 @@
[app.common.logic.variants :as clv]
[app.common.math :as mth]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm]
[frontend-tests.composable-tests.core :as tm]))
[app.common.types.modifiers :as ctm]))
;; ---------------------------------------------------------------------------
;; Operation kinds and the production changes of user operations
;;
;; Every component node declares its kind, which tells a runner how to treat
;; it:
;; :assembly builds the configuration with test helpers; no sync, no
;; undo group, and it records no changes.
;; :user a user action the app commits. It stores the production
;; changes it applied with `record-changes` (nil when it
;; changed nothing). The pure runner
;; (`app.common.test-helpers.composable.comp.runner`) takes
;; them to sync the file and to build its undo stack.
;; :undo reverts the latest user action; needs a runner's undo
;; stack.
;; :frontend-only its production result needs frontend code; the pure
;; runner rejects it.
;; The pure runner checks that a :user node recorded its changes and that
;; no other kind did.
;; ---------------------------------------------------------------------------
(defprotocol IComponentOperation
(op-kind [op]
"How a runner treats `op`: :assembly, :user, :undo or :frontend-only."))
(defn record-changes
"Store `changes`, the production changes a user operation applied (nil when
it changed nothing), in `situation` for the runner to take."
[situation changes]
(assoc situation ::changes changes))
(defn take-changes
"The changes recorded by the last operation and the situation without them,
as `[recorded? changes situation]`. `recorded?` is false when the operation
did not call `record-changes`."
[situation]
[(contains? situation ::changes)
(::changes situation)
(dissoc situation ::changes)])
;; ---------------------------------------------------------------------------
;; Properties — an OPEN, extensible vocabulary of "what about a shape can change"
@ -77,6 +117,9 @@
{:property property}))))
(defrecord ChangeProperty [target property value]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
;; Goes through the production change path, exactly like tho/update-color,
@ -96,6 +139,7 @@
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :property property :value value})))))
(defn change-property
@ -142,9 +186,13 @@
;; what these operations exist to exercise. The synchronous `apply-to` fallback
;; below performs the geometrically equivalent transform through the production
;; math, but cannot classify placement (that code is frontend-only), so cases
;; using these operations are meant to run through the interpreter.
;; using these operations are meant to run through the interpreter. The pure
;; runner rejects them.
(defrecord Rotate [target angle]
IComponentOperation
(op-kind [_] :frontend-only)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -164,6 +212,7 @@
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :angle angle})))))
(defn rotate
@ -175,6 +224,9 @@
(tm/assign-id (->Rotate target angle)))
(defrecord ChangeHeight [target value]
IComponentOperation
(op-kind [_] :frontend-only)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -194,6 +246,7 @@
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :value value})))))
(defn change-height
@ -388,6 +441,9 @@
;; ---------------------------------------------------------------------------
(defrecord CreateComponent [name color]
IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [this situation]
;; fresh, name-scoped labels so several lineages don't clash
@ -496,6 +552,9 @@
(tm/record-application op {:component name :level level :outer outer-id}))))
(defrecord MakeNestedComponent [name]
IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [this situation]
;; nest a COPY of the lineage's own current component. Seek the FIXED deepest
@ -526,6 +585,9 @@
;; ---------------------------------------------------------------------------
(defrecord InstantiateCopy [name]
IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -564,6 +626,9 @@
;; ---------------------------------------------------------------------------
(defrecord ResetCopyInstance [name]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
;; Production reset path (generate-reset-component), validation OFF — mirrors
@ -584,6 +649,7 @@
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:component name :reset copy-id})))))
(defn reset-copy-instance
@ -592,14 +658,22 @@
[name]
(tm/assign-id (->ResetCopyInstance name)))
(defn- libraries
"The situation's files by id, as the production code expects them: the
current file and any auxiliary (library) files."
[situation]
(let [the-file (tm/file situation)]
(assoc (tm/aux-files situation) (:id the-file) the-file)))
;; ---------------------------------------------------------------------------
;; swap-component — replace a nested subinstance head with an instance of a
;; different component (the general "Swap component" action), in place.
;;
;; Targets lineage `name`'s nesting level `level` (its `nesting-data[level]
;; .nested-head`) and swaps it for lineage `target`'s component
;; (`:main-component-id`). Drives the production `generate-component-swap`
;; (validation off). The `apply-to` below is the pure realisation; the frontend
;; (`:main-component-id`). Drives the production `generate-component-swap-in-place`
;; (validation off), the changes the `component-swap` event commits. The
;; `apply-to` below is the pure realisation; the frontend
;; interpreter instead dispatches the real `dwl/component-swap` event, so the
;; watcher auto-propagates the swap. keep-touched? defaults
;; false (the general swap discards overrides; variant-switch would pass true).
@ -611,29 +685,29 @@
;; ---------------------------------------------------------------------------
(defrecord SwapComponent [name level target keep-touched?]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
page (thf/current-page the-file)
objects (:objects page)
nested-head (:nested-head (lineage-nesting situation name level))
shape (get objects nested-head)
shape (get (:objects page) nested-head)
target-id (lineage-component-id situation target)
libraries {(:id the-file) the-file}
orig-shapes (when keep-touched?
(cfh/get-children-with-self objects nested-head))
[new-shape _parents changes]
(cll/generate-component-swap (pcb/empty-changes)
objects shape (:data the-file) page libraries
target-id 0 nil {} (boolean keep-touched?))
[changes _] (if keep-touched?
(clv/generate-keep-touched changes new-shape shape orig-shapes
page libraries (:data the-file))
[changes nil])
[new-shape changes _]
(clv/generate-component-swap-in-place (pcb/empty-changes nil (:id page))
page
(libraries situation)
(:data the-file)
shape
target-id
(boolean keep-touched?))
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
;; record the swapped-in head id on the level (its parent is unchanged)
(tm/with-file file')
(record-changes changes)
(update-component-obj
name
(fn [o] (assoc-in o [:nesting-data level :swapped-head] (:id new-shape))))
@ -658,14 +732,14 @@
;; it routes through the SAME `generate-component-swap` as `swap-component` and
;; the watcher auto-propagates it across nesting levels exactly like a swap.
;;
;; OP SPLIT: only the SWITCH is a real workspace event (`variant-switch` has no
;; pure generator to call directly), so `SwitchVariant` is an EVENT-op: its
;; `apply-to` throws, and the frontend interpreter realises it by dispatching the
;; event. The container build and the variant nesting are SYNC-ops (test-helper
;; assembly + the shared nesting helper), applied via `apply-to` against the live
;; store file; they record the variant-set in vars. Event-ops do NOT run
;; `apply-to` (only sync-ops do), but the switch needs no bookkeeping: the
;; asserter re-resolves heads via the swap-stable :nested-head-parent
;; OP SPLIT: the SWITCH is a user action. The frontend interpreter dispatches
;; the real `variants-switch` event; its pure `apply-to` builds the same changes
;; with the production `find-switch-target` and
;; `generate-component-swap-in-place`. The container build and the variant
;; nesting are SYNC-ops (test-helper assembly + the shared nesting helper),
;; applied via `apply-to` against the live store file; they record the
;; variant-set in vars. The switch needs no bookkeeping: the asserter
;; re-resolves heads via the swap-stable :nested-head-parent
;; (`nested-head-of`/`level-rect`), exactly as case L does for swaps.
;;
;; Member SELECTOR: `make-variant-container` assigns each member an EXPLICIT property
@ -732,6 +806,9 @@
;; ---------------------------------------------------------------------------
(defrecord MakeVariantContainer [name members]
IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [this situation]
;; Build the set exactly as the variant test-helpers' `add-variant` do (the
@ -809,6 +886,9 @@
;; ---------------------------------------------------------------------------
(defrecord MakeNestedComponentWithVariant [name set-name value]
IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [this situation]
(let [member (variant-member situation set-name value)
@ -839,11 +919,12 @@
;; switch-variant — switch a variant copy head to a sibling member
;;
;; The variant-switch action: switch the variant copy head bound to `target` to the
;; sibling member whose selector property (pos 0) has `value`. FRONTEND-only:
;; dispatches the production `variants-switch`, which DISCOVERS the sibling by value
;; within the variant container and routes through `component-swap` with
;; keep-touched? true — so the watcher auto-propagates it across nesting levels
;; exactly like case L's swap. A switch REPLACES the head in place; the head's
;; sibling member whose selector property (pos 0) has `value`. The production
;; switch DISCOVERS the sibling by value within the variant container and swaps
;; with keep-touched? true, so sync propagates it across nesting levels exactly
;; like case L's swap. On the frontend it is the `variants-switch` event. The
;; event's follow-ups (token propagation, WASM text resize, layout update) are
;; frontend code and the pure `apply-to` does not run them. A switch REPLACES the head in place; the head's
;; :parent is unchanged, so assertions re-resolve parent -> current head -> rect.
;;
;; `target` is the head to switch, resolved by the standard `target-shape-id` (role
@ -853,13 +934,43 @@
;; ---------------------------------------------------------------------------
(defrecord SwitchVariant [target value]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [_ _]
(throw (ex-info (str "switch-variant is an EVENT-op with no pure `apply-to` realisation: "
"it is the real `variants-switch` workspace event (which discovers the "
"sibling via the variant container), dispatched by the frontend "
"interpreter. See the VARIANT operations note above.")
{:type ::switch-variant-is-event-op}))))
(apply-to [this situation]
(let [the-file (tm/file situation)
page (thf/current-page the-file)
objects (:objects page)
libraries (libraries situation)
shape (get objects (tm/target-shape-id situation target))
component (clv/find-switch-target libraries shape 0 value)]
(cond
;; the value is already `value`, or no sibling has it: nothing happens
(nil? component)
(-> situation
(record-changes nil)
(tm/record-application this {:target-component nil}))
(clv/swap-nesting-loop? objects
shape
(get-in libraries [(:component-file shape) :data])
(:id component))
(throw (ex-info "switch-variant: the switch would nest a component inside itself"
{:type ::switch-nesting-loop
:shape (:id shape)
:component (:id component)}))
:else
(let [ldata (get-in libraries [(:component-file shape) :data])
[_ changes _] (clv/generate-component-swap-in-place
(pcb/empty-changes nil (:id page))
page libraries ldata shape (:id component) true)
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target-component (:id component)})))))))
(defn switch-variant
"Switch the variant copy head bound to `target` to the sibling member whose
@ -867,7 +978,7 @@
machinery (which discovers the sibling within the container). Propagates across
nesting exactly like case L's swap. `target` is resolved like any operation target
(role | label | (situation -> id) fn, e.g. `nested-head-of`), so the op is
structure-agnostic. FRONTEND-only."
structure-agnostic."
[target value]
(tm/assign-id (->SwitchVariant target value)))
@ -900,6 +1011,9 @@
;; ---------------------------------------------------------------------------
(defrecord SyncFromLibrary []
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -919,6 +1033,7 @@
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:library-id library-id})))))
(defn sync-from-library
@ -938,18 +1053,21 @@
;; inverse changes. "Test undo everywhere" = append this node after any case; the
;; post-undo assertion is an ordinary condition about the resulting state.
;;
;; A pure `apply-to` realisation is NOT built: it would require every node to
;; stash its produced change value (the engine `:undo-changes`) into its record
;; so this node could apply the inverse — a retrofit across all nodes that no
;; case needs. It therefore throws loudly rather than pretending.
;; The pure runner (`app.common.test-helpers.composable.comp.runner`) realises
;; it from the changes that user operations record (`record-changes`). A bare
;; `apply-to` has no undo stack to read, so it throws loudly rather than
;; pretending.
;; ---------------------------------------------------------------------------
(defrecord Undo []
IComponentOperation
(op-kind [_] :undo)
tm/IOperation
(apply-to [_ _]
(throw (ex-info (str "Undo is an EVENT-op with no pure `apply-to` realisation (change "
"values are not stashed per-node). It is realised by the frontend "
"interpreter via the real undo event.")
(throw (ex-info (str "Undo has no `apply-to` realisation: it needs an undo stack. "
"Run it through the pure runner (comp.runner) or the frontend "
"interpreter.")
{:type ::undo-is-event-op}))))
(defn undo
@ -963,10 +1081,10 @@
;; add-child — add a new shape into a (main) component, structurally
;;
;; This is STRUCTURAL modification (changes the tree shape), as opposed to
;; change-attr (attribute modification). It mirrors the established
;; comp-sync-test "add shape" pattern: create a free shape on the page, then
;; relocate it INTO the target parent via the production `generate-relocate`
;; path. Propagation then materializes a corresponding child in copies.
;; change-attr (attribute modification). It builds the new shape under the
;; target parent with `prepare-add-shape`, the same changes the frontend
;; `add-shape` event commits, so one undo removes it whole. Propagation then
;; materializes a corresponding child in copies.
;;
;; `parent` is the binding name of the shape to add the new child under (e.g.
;; :main-root). `new-label` is the label assigned to the created shape, so a
@ -974,26 +1092,30 @@
;; ---------------------------------------------------------------------------
(defrecord AddChild [parent new-label shape-params]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
(let [the-file (tm/file situation)
;; strict-presence on the parent (it must exist before we add under it)
parent-id (tm/resolve-shape-id situation parent)
;; 1) create the free shape on the page (registers `new-label`)
file-1 (ths/add-sample-shape the-file new-label (or shape-params {}))
page (thf/current-page file-1)
new-id (thi/id new-label)
;; 2) relocate it into the parent through the production change path
changes (cls/generate-relocate
(-> (pcb/empty-changes nil)
(pcb/with-page-id (:id page))
(pcb/with-objects (:objects page)))
parent-id ; parent-id
0 ; to-index
#{new-id}) ; ids to move
file' (thf/apply-changes file-1 changes)]
parent-id (tm/resolve-shape-id situation parent)
page (thf/current-page the-file)
objects (:objects page)
parent-obj (get objects parent-id)
;; registers `new-label`
shape (-> (ths/sample-shape new-label (or shape-params {}))
(assoc :parent-id parent-id
:frame-id (if (cfh/frame-shape? parent-obj)
parent-id
(:frame-id parent-obj))))
[_ changes] (cfsh/prepare-add-shape (pcb/empty-changes nil (:id page))
shape
objects)
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:parent parent :new-label new-label})))))
(defn add-child
@ -1017,6 +1139,9 @@
;; ---------------------------------------------------------------------------
(defrecord RemoveChild [target]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -1033,6 +1158,7 @@
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target})))))
(defn remove-child
@ -1056,6 +1182,9 @@
;; ---------------------------------------------------------------------------
(defrecord MoveChild [target parent to-index]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
@ -1072,6 +1201,7 @@
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :parent parent :to-index to-index})))))
(defn move-child

221
common/src/app/common/test_helpers/composable/comp/runner.cljc Normal file
View File

@ -0,0 +1,221 @@
;; 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 app.common.test-helpers.composable.comp.runner
"Pure runner for composable component cases. It runs a case on the in-memory
file, without the frontend store, on the JVM and in CLJS, and adds what the
frontend workspace does around each operation:
- Sync. After a user operation (kind `:user`, see
`n/IComponentOperation`), it syncs each component that
`ch/components-changed` reports, then the components each sync changed,
until none is left. The frontend component watcher does the same, one
pass per sync commit.
- Undo. A user operation and the syncs it caused form one undo group.
`n/undo` reverts the latest group and syncs nothing, as in the frontend,
where an undo commit only bumps the component's `:modified-at`.
Assembly operations (create, instantiate, nest) change the file with no sync
and no undo group, like the frontend interpreter's file installs.
Operations whose result needs frontend code (kind `:frontend-only`) are
rejected. Not modelled: the `:modified-at` bump of a changed component,
and the frontend follow-ups of a swap or switch (token propagation, WASM
text resize, layout update)."
(:require
[app.common.files.changes :as ch]
[app.common.files.changes-builder :as pcb]
[app.common.logic.libraries :as cll]
[app.common.test-helpers.composable.comp.nodes :as n]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.files :as thf]))
(def ^:private default-opts
{:sync? true})
;; A guard against a sync cascade that never settles.
(def ^:private max-sync-passes 100)
(defn- changed-components
"Ids of the components whose main `changes` modified, judged against
`old-data`, the file data before `changes` applied."
[old-data changes]
(into #{}
(mapcat (partial ch/components-changed old-data))
(:redo-changes changes)))
(defn- libraries
"The situation's files by id, with `file` as its current file."
[situation file]
(assoc (tm/aux-files situation) (:id file) file))
(defn- validate-settled!
"Validate the situation's file, resolving components against its other
files. Only a settled file is valid: between two passes of a sync cascade,
an outer copy can still point at the component its main no longer uses.
Throws when the file is invalid."
[situation]
(let [file (tm/file situation)]
(thf/validate-file! file (libraries situation file))
situation))
(defn- component-sync-changes
"The changes that sync the copies of `component-id` in `file`, as the
frontend `sync-file` event builds them for a local component."
[situation file component-id]
(let [file-id (:id file)]
(cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
file-id
component-id
file-id
(libraries situation file)
file-id)))
(defn- sync-file
"Sync `situation`'s file, starting from the components that `changes`
modified (judged against `old-data`), until no component is left to sync,
and validate the result. Returns `[situation syncs]`, with `syncs` the
applied sync changes in order."
[situation old-data changes]
(loop [file (tm/file situation)
pending (vec (changed-components old-data changes))
syncs []
passes 0]
(cond
(empty? pending)
[(validate-settled! (tm/with-file situation file)) syncs]
(>= passes max-sync-passes)
(throw (ex-info "Component sync did not settle"
{:type ::sync-not-settled
:pending pending
:passes passes}))
:else
(let [component-id (first pending)
sync (component-sync-changes situation file component-id)
file' (thf/apply-changes file sync :validate? false)
more (->> (changed-components (:data file) sync)
(remove (set pending)))]
(recur file'
(into (subvec pending 1) more)
(cond-> syncs (seq (:redo-changes sync)) (conj sync))
(inc passes))))))
(defn- push-undo-group
"Add `group`, the changes of one user operation and its syncs in order, to
the undo stack. Changes with nothing to undo are left out, as the frontend
undo stack leaves out commits with no undo changes."
[situation group]
(let [group (filterv (comp seq :undo-changes) group)]
(cond-> situation
(seq group) (update ::undo-stack (fnil conj []) group))))
(defn- run-undo
"Revert the latest undo group, newest changes first, and validate the
result. With an empty stack it changes nothing, like the frontend undo."
[situation op]
(let [stack (get situation ::undo-stack [])
group (peek stack)
file (reduce (fn [file changes]
(thf/apply-changes file
{:redo-changes (:undo-changes changes)}
:validate? false))
(tm/file situation)
(rseq (or group [])))]
(-> situation
(tm/with-file file)
(validate-settled!)
(assoc ::undo-stack (if (seq stack) (pop stack) stack))
(tm/record-application op {:undone (count group)}))))
(defn- op-kind
"The kind of a leaf operation (see `n/IComponentOperation`), or nil for an
engine operation such as `Test` or `Skip`."
[op]
(when (satisfies? n/IComponentOperation op)
(n/op-kind op)))
(defn- check-recorded-changes!
"Throw unless `op` recorded its changes exactly when it is a user operation."
[op kind recorded?]
(cond
(and (= kind :user) (not recorded?))
(throw (ex-info (str "User operation " (pr-str (type op)) " recorded no "
"changes. Call `n/record-changes`, with nil when it "
"changed nothing.")
{:type ::changes-not-recorded
:op op}))
(and (not= kind :user) recorded?)
(throw (ex-info (str (pr-str (type op)) " recorded changes but its kind is "
(pr-str kind) ". Only user operations record them.")
{:type ::unexpected-changes
:op op
:kind kind}))))
(defn- run-node
"Apply one leaf operation of `kind`. A user operation is followed by its sync
(when `:sync?`) and pushes its undo group."
[situation op kind {:keys [sync?]}]
(let [old-data (:data (tm/file situation))
[recorded? changes situation] (n/take-changes (tm/apply-to op situation))]
(check-recorded-changes! op kind recorded?)
(if (nil? changes)
situation
(let [[situation syncs] (if sync?
(sync-file situation old-data changes)
[situation []])]
(push-undo-group situation (into [changes] syncs))))))
(defn- run-op
[situation op opts]
(cond
(tm/sequence? op)
(reduce #(run-op %1 %2 opts) situation (:steps op))
(tm/recorded-choice? op)
(-> (tm/record-choice situation op)
(run-op (tm/choice-of op) opts))
:else
(let [kind (op-kind op)]
(case kind
:undo
(run-undo situation op)
:frontend-only
(throw (ex-info (str "The pure runner cannot run " (pr-str (type op))
": its production result needs frontend code. "
"Run the case through the frontend interpreter.")
{:type ::frontend-only
:op op}))
(run-node situation op kind opts)))))
(defn undo-depth
"How many undo groups the runner holds in `situation`."
[situation]
(count (get situation ::undo-stack)))
(defn run-variant
"Run one concrete (already enumerated) variant: build a fresh situation with
`setup` and run `operation` with sync and undo, returning the resulting
situation. Options: `:sync?` (default true) syncs after each user
operation."
([case-map] (run-variant case-map {}))
([{:keys [setup operation]} opts]
(run-op (setup) operation (merge default-opts opts))))
(defn run-all
"Enumerate `operation` into its concrete variants and run each with
`run-variant`, resetting the label map before each setup. Returns the
resulting situations in enumeration order."
([case-map] (run-all case-map {}))
([case-map opts]
(tm/run-all case-map #(run-variant % opts))))

6
frontend/test/frontend_tests/composable_tests/comp/setups.cljs → common/src/app/common/test_helpers/composable/comp/setups.cljc
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.comp.setups
(ns app.common.test-helpers.composable.comp.setups
"Component-specific setups for the test model: named functions that build an
in-memory file value for a particular component configuration. They are the
subject-specific counterpart to the generic engine; a 'simple component with
@ -25,11 +25,11 @@
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[frontend-tests.composable-tests.core :as tm]))
[app.common.test-helpers.shapes :as ths]))
(defn simple-component-with-copy
"A situation with a simple component (root + one child) and one clean copy.

50
frontend/test/frontend_tests/composable_tests/core.cljs → common/src/app/common/test_helpers/composable/core.cljc
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.core
(ns app.common.test-helpers.composable.core
"The domain-agnostic ENGINE of the composable test model (see
`mem:frontend/composable-component-tests`):
@ -22,7 +22,7 @@
event-dispatching counterpart and the test-facing entry point).
No Penpot domain terms live here; the component-specific operations sit
behind the `comp` boundary (`frontend-tests.composable-tests.comp.*`).
behind the `comp` boundary (`app.common.test-helpers.composable.comp.*`).
Shape references use the existing label->uuid system (`app.common.test-helpers.ids-map`)
rather than a parallel binding map: a binding name in an operation IS a
@ -133,7 +133,8 @@
per-node boilerplate, faithful to the actual type). E.g. a ChangeAttr record
yields \"change-attr\"."
[node]
(let [cls (or (some-> node type .-name (str/split #"\.") last)
(let [cls (or #?(:clj (some-> ^Class (type node) .getSimpleName)
:cljs (some-> node type .-name (str/split #"\.") last))
"node")
;; CamelCase -> kebab-case
kebab (-> cls
@ -447,6 +448,8 @@
;; multiplies out correctly via the sequence's cartesian product.
;; ---------------------------------------------------------------------------
(declare record-choice)
(defrecord RecordedChoice [one-of-id chosen]
;; Internal node produced by OneOf enumeration. Applying it records, under the
;; originating one-of's identity, which alternative was chosen, then applies
@ -454,11 +457,9 @@
;; one-of) recovers the choice from the resulting situation. It is already
;; concrete, so it enumerates to itself.
IOperation
(apply-to [_ situation]
(-> situation
(assoc-in [:node-data one-of-id] {:chosen chosen})
(update :applied conj one-of-id)
(->> (apply-to chosen))))
(apply-to [this situation]
(->> (record-choice situation this)
(apply-to chosen)))
IEnumerable
(-enumerate [this] [this]))
@ -566,13 +567,17 @@
setup so per-variant setups don't clobber labels). Returns a vector of the
resulting situations, one per enumerated variant, in enumeration order. Makes
no judgment and does not touch clojure.test — see `check` (in
`frontend-tests.composable-tests.interpreter`) for the test-facing entry point that asserts."
[{:keys [setup operation]}]
(->> (enumerate operation)
(mapv (fn [variant]
(thi/reset-idmap!)
(run-variant {:setup setup
:operation variant})))))
`frontend-tests.composable-tests.interpreter`) for the test-facing entry point that asserts.
`run-variant-fn` runs one variant from `{:setup :operation}` (default
`run-variant`); other runners pass their own."
([case-map] (run-all case-map run-variant))
([{:keys [setup operation]} run-variant-fn]
(->> (enumerate operation)
(mapv (fn [variant]
(thi/reset-idmap!)
(run-variant-fn {:setup setup
:operation variant}))))))
(defn sequence-ops
@ -594,6 +599,11 @@
:else
[variant]))
(defn sequence?
"True if `op` is a `Sequence`; its ordered steps are under `:steps`."
[op]
(instance? Sequence op))
(defn recorded-choice?
"True if `op` is a one-of's enumerated choice wrapper."
[op]
@ -609,3 +619,13 @@
interpreter can record the choice under it, enabling `get-choice`)."
[recorded-choice]
(:one-of-id recorded-choice))
(defn record-choice
"Record in `situation` the alternative `recorded-choice` selected, under its
one-of's identity, so `get-choice` finds it. Runners call it before applying
the chosen operation."
[situation recorded-choice]
(-> situation
(assoc-in [:node-data (choice-one-of-id recorded-choice)]
{:chosen (choice-of recorded-choice)})
(update :applied conj (choice-one-of-id recorded-choice))))

262
common/test/common_tests/logic/composable_runner_test.cljc Normal file
View File

@ -0,0 +1,262 @@
;; 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 common-tests.logic.composable-runner-test
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.composable.comp.nodes :as n]
[app.common.test-helpers.composable.comp.runner :as r]
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.uuid :as uuid]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(def ^:private original "#abcdef")
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
(defn- fill-of
[shape]
(-> shape :fills first :fill-color))
(t/deftest main-edit-syncs-to-clean-copy
(let [situation (r/run-variant
{:setup setup/simple-component-with-labeled-copy
:operation (n/change-property :main-child :fills red)})
copy (setup/copy-instance situation)]
(t/is (= red (fill-of copy)))
(t/is (nil? (:touched copy)))))
(t/deftest main-edit-without-sync-leaves-copy-stale
(let [situation (r/run-variant
{:setup setup/simple-component-with-labeled-copy
:operation (n/change-property :main-child :fills red)}
{:sync? false})]
(t/is (= red (fill-of (setup/main-instance situation))))
(t/is (= original (fill-of (setup/copy-instance situation))))))
(t/deftest copy-override-survives-main-edit
(let [situation (r/run-variant
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence
[(n/change-property :copy-child :fills green)
(n/change-property :main-child :fills red)])})
copy (setup/copy-instance situation)]
(t/is (= green (fill-of copy)))
(t/is (contains? (:touched copy) :fill-group))))
(t/deftest sync-cascades-through-nested-components
;; The edit is on the deepest main. Its copy inside the outer main changes,
;; so the outer component syncs in a second pass and reaches the outer copy.
(let [m "main"
situation (r/run-variant
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m original)
(n/make-nested-component m)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/change-property (n/remote-rect-of m) :fills red)])})
copy-rect (tm/shape-by-id situation (n/lineage-copy-rect situation m))]
(t/is (= red (fill-of copy-rect)))
(t/is (nil? (:touched copy-rect)))))
(t/deftest undo-reverts-edit-and-its-sync
(let [situation (r/run-variant
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence
[(n/change-property :main-child :fills red)
(n/undo)])})
copy (setup/copy-instance situation)]
(t/is (= original (fill-of (setup/main-instance situation))))
(t/is (= original (fill-of copy)))
(t/is (nil? (:touched copy)))
(t/is (zero? (r/undo-depth situation)))))
(t/deftest undo-reverts-the-whole-sync-cascade
(let [m "main"
situation (r/run-variant
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m original)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/change-property (n/remote-rect-of m) :fills red)
(n/undo)])})]
(t/is (= original (fill-of (tm/shape-by-id situation (n/lineage-rect situation m)))))
(t/is (= original (fill-of (tm/shape-by-id situation (n/lineage-copy-rect situation m)))))))
(t/deftest undo-reverts-only-the-latest-user-operation
(let [situation (r/run-variant
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence
[(n/change-property :main-child :fills red)
(n/change-property :main-child :fills green)
(n/undo)])})]
(t/is (= red (fill-of (setup/main-instance situation))))
(t/is (= red (fill-of (setup/copy-instance situation))))
(t/is (= 1 (r/undo-depth situation)))))
(t/deftest undo-of-a-reset-restores-the-override
(let [m "main"
situation (r/run-variant
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m original)
(n/instantiate-copy m)
(n/change-property (n/copy-rect-of m) :fills green)
(n/reset-copy-instance m)
(n/undo)])})
copy-rect (tm/shape-by-id situation (n/lineage-copy-rect situation m))]
(t/is (= green (fill-of copy-rect)))
(t/is (contains? (:touched copy-rect) :fill-group))
(t/is (= 1 (r/undo-depth situation)))))
(t/deftest assembly-operations-push-no-undo-group
(let [m "main"
situation (r/run-variant
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m original)
(n/instantiate-copy m)
(n/undo)])})]
(t/is (zero? (r/undo-depth situation)))
(t/is (some? (tm/shape-by-id situation (n/lineage-copy-rect situation m))))))
(t/deftest added-child-reaches-copy
(let [add (n/add-child :main-root :new-child)
situation (r/run-variant
{:setup setup/simple-component-with-copy
:operation add})]
(t/is (some? (n/materialized-instance-child add situation (setup/copy-root situation))))))
(t/deftest undo-removes-added-child-from-main-and-copy
(let [situation (r/run-variant
{:setup setup/simple-component-with-copy
:operation (tm/in-sequence
[(n/add-child :main-root :new-child)
(n/undo)])})]
(t/is (nil? (tm/shape-by-id situation (thi/id :new-child))))
(t/is (= 1 (count (:shapes (setup/main-root situation)))))
(t/is (= 1 (count (:shapes (setup/copy-root situation)))))))
(defn- error-type
"The `:type` of the error that running `op` on a simple component throws, or
nil when it throws none."
[op]
(try
(r/run-variant {:setup setup/simple-component-with-copy
:operation op})
nil
(catch #?(:clj Exception :cljs :default) e
(:type (ex-data e)))))
(t/deftest frontend-only-operations-are-rejected
(t/is (= ::r/frontend-only (error-type (n/rotate :main-root 45))))
(t/is (= ::r/frontend-only (error-type (n/change-height :main-root 50)))))
;; A user operation that forgets to record its changes.
(defrecord UnrecordedEdit []
n/IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [_ situation] situation))
;; An assembly operation that records changes as if it were a user operation.
(defrecord RecordingAssembly []
n/IComponentOperation
(op-kind [_] :assembly)
tm/IOperation
(apply-to [_ situation] (n/record-changes situation (pcb/empty-changes))))
(t/deftest user-operation-must-record-its-changes
(t/is (= ::r/changes-not-recorded (error-type (->UnrecordedEdit)))))
(t/deftest only-user-operations-record-changes
(t/is (= ::r/unexpected-changes (error-type (->RecordingAssembly)))))
;; A user operation that points the copy root at a main shape that does not
;; exist, leaving the file invalid.
(defrecord BreakCopyRef []
n/IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [_ situation]
(let [file (tm/file situation)
page (thf/current-page file)
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(:id (setup/copy-root situation))}
#(assoc % :shape-ref (uuid/next))
(:objects page)
{})]
(-> situation
(tm/with-file (thf/apply-changes file changes :validate? false))
(n/record-changes changes)))))
(t/deftest settled-file-is-validated
(t/is (= :validation (error-type (->BreakCopyRef)))))
(t/deftest run-all-records-each-choice
(let [to-red (n/change-property :main-child :fills red)
to-green (n/change-property :main-child :fills green)
choice (tm/one-of [to-red to-green])
results (r/run-all {:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [choice])})]
(t/is (= [to-red to-green] (mapv #(tm/get-choice % choice) results)))
(t/is (= [red green] (mapv (comp fill-of setup/copy-instance) results)))))
(defn- level-fill
[situation name level]
(fill-of (tm/shape-by-id situation (n/level-rect situation name level))))
(def ^:private switch-scenario
;; The variant head is nested at level 0; level 1 wraps level 0, so it holds
;; a copy of it that only sync updates.
(let [m "main"]
[(n/create-component m original)
(n/make-variant-container "vset" [["a" original] ["b" red]])
(n/make-nested-component-with-variant m "vset" "a")
(n/make-nested-component m)
(n/switch-variant (n/nested-head-of m 0) "b")]))
(t/deftest variant-switch-syncs-to-outer-level
(let [situation (r/run-variant {:setup setup/empty-situation
:operation (tm/in-sequence switch-scenario)})]
(t/is (= red (level-fill situation "main" 0)))
(t/is (= red (level-fill situation "main" 1)))))
(t/deftest variant-switch-without-sync-leaves-outer-level
(let [situation (r/run-variant {:setup setup/empty-situation
:operation (tm/in-sequence switch-scenario)}
{:sync? false})]
(t/is (= red (level-fill situation "main" 0)))
(t/is (= original (level-fill situation "main" 1)))))
(t/deftest undo-reverts-variant-switch-and-its-sync
(let [situation (r/run-variant {:setup setup/empty-situation
:operation (tm/in-sequence (conj switch-scenario (n/undo)))})]
(t/is (= original (level-fill situation "main" 0)))
(t/is (= original (level-fill situation "main" 1)))))
(t/deftest variant-switch-to-current-value-changes-nothing
(let [m "main"
situation (r/run-variant
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m original)
(n/make-variant-container "vset" [["a" original] ["b" red]])
(n/make-nested-component-with-variant m "vset" "a")
(n/switch-variant (n/nested-head-of m 0) "a")])})]
(t/is (= original (level-fill situation m 0)))
(t/is (zero? (r/undo-depth situation)))))

59
common/test/common_tests/logic/composable_sync_test.cljc Normal file
View File

@ -0,0 +1,59 @@
;; 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 common-tests.logic.composable-sync-test
"Runs the shared composable component cases through the pure runner, on the
JVM and in JS. Case N and the rotation case need the frontend placement
step, so only the frontend interpreter runs them."
(:require
[app.common.test-helpers.composable.comp.cases :as cases]
[app.common.test-helpers.composable.comp.runner :as r]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.ids-map :as thi]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(defn- check
"Run every variant of `case-map` and apply its asserter to each result."
[{:keys [asserter] :as case-map}]
(doseq [situation (r/run-all case-map)]
(when asserter
(t/testing (str "operations:\n " (tm/describe-applied situation))
(asserter situation)))))
(t/deftest case-b-copy-override-survives-later-main-change
(check (cases/copy-override-survives-later-main-change)))
(t/deftest case-c-attribute-sweep-propagates-to-clean-copy
(check (cases/attribute-sweep-propagates-to-clean-copy)))
(t/deftest case-d-add-shape-to-main-propagates-to-clean-copy
(check (cases/add-shape-to-main-propagates-to-clean-copy)))
(t/deftest case-e-remove-shape-from-main-propagates-to-clean-copy
(check (cases/remove-shape-from-main-propagates-to-clean-copy)))
(t/deftest case-f-move-shape-in-main-propagates-order-to-clean-copy
(check (cases/move-shape-in-main-propagates-order-to-clean-copy)))
(t/deftest case-h-library-change-propagates-across-file-boundary-on-sync
(check (cases/library-change-propagates-across-file-boundary-on-sync)))
(t/deftest case-i-undo-reverts-edit-and-its-propagation
(check (cases/undo-reverts-edit-and-its-propagation)))
(t/deftest case-k-synchronisation-scenarios
(check (cases/synchronisation-scenarios)))
(t/deftest case-l-swap-scenarios
(check (cases/swap-scenarios)))
(t/deftest case-m-variant-switch-scenarios
(check (cases/variant-switch-scenarios)))
(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree
(check (cases/variant-switch-keeps-override-only-where-mains-agree)))

4
common/test/common_tests/runner.cljc
View File

@ -65,6 +65,8 @@
[common-tests.logic.comp-reset-test]
[common-tests.logic.comp-sync-test]
[common-tests.logic.comp-touched-test]
[common-tests.logic.composable-runner-test]
[common-tests.logic.composable-sync-test]
[common-tests.logic.copying-and-duplicating-test]
[common-tests.logic.duplicated-pages-test]
[common-tests.logic.move-shapes-test]
@ -173,6 +175,8 @@
'common-tests.logic.comp-reset-test
'common-tests.logic.comp-sync-test
'common-tests.logic.comp-touched-test
'common-tests.logic.composable-runner-test
'common-tests.logic.composable-sync-test
'common-tests.logic.copying-and-duplicating-test
'common-tests.logic.duplicated-pages-test
'common-tests.logic.move-shapes-test

408
frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs
View File

@ -5,43 +5,19 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.comp.sync-test
"Component-behaviour cases authored on the composable test model, run against
the REAL app (frontend interpreter). In-file propagation is AUTOMATIC: a case
contains ONLY the user edit(s) (no propagate op); the app's component-change
watcher syncs copies on its own, and that is what we assert.
The cases (see `mem:frontend/composable-component-tests` for details):
B — an override on a copy child survives a later main change (touched gate).
C — a sweep (one-of) over several attribute changes, each auto-propagating.
D — a shape added to the main is structurally auto-propagated (ref-integrity).
E — a middle shape removed from the main; survivors keep order.
F — reordering a shape in the main; order auto-propagates, identity preserved.
H — locality: a library main's change reaches the consuming file's copy on
the explicit library sync (cross-file propagation).
I — undo reverses an edit AND its auto-propagation.
K — the synchronisation sweep: depth x edit-targets, with override-precedence
and reset checkpoints.
L — the swap sweep: swaps at any subset of nesting levels.
M — the variant-switch sweep: case L with variant switches.
"Runs the shared composable component cases
(`app.common.test-helpers.composable.comp.cases`) against the REAL app
(frontend interpreter). In-file propagation is AUTOMATIC: a case contains
ONLY the user edit(s) (no propagate op); the app's component-change watcher
syncs copies on its own, and that is what the cases assert.
Async: each deftest uses `t/async`; `ftm/check` drives the store and calls
`done` when finished."
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
[app.common.types.component :as ctk]
[app.common.types.shape-tree :as ctst]
[app.common.test-helpers.composable.comp.cases :as cases]
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.comp.nodes :as n]
[frontend-tests.composable-tests.comp.setups :as setup]
[frontend-tests.composable-tests.core :as tm]
[frontend-tests.composable-tests.interpreter :as ftm]))
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
;; Disable thumbnail rendering for the duration of each (async) test: the
;; propagation watcher schedules thumbnail renders that reach `window`, absent in
;; the headless runner. `:each` `:after` runs only after the test's `done` fires
@ -51,383 +27,41 @@
{:before ftm/install-thumbnail-noop!
:after ftm/restore-thumbnail!})
;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.)
(t/deftest case-b-copy-override-survives-later-main-change
(t/async
done
(let [override (n/change-attr :copy-child :fills green)] ; touch the copy first
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
;; override the copy, then change the main; the watcher auto-syncs after
;; each edit. The override must survive (touched-flag gate).
:operation (tm/in-sequence
[override
(n/change-attr :main-child :fills red)])}
(fn [situation]
(let [copy-child (setup/copy-instance situation)]
(t/is (n/has-attr? override copy-child))
(t/is (contains? (:touched copy-child) :fill-group))
(t/is (some? (:shape-ref copy-child)))))))))
(t/async done (ftm/check done (cases/copy-override-survives-later-main-change))))
(t/deftest case-c-attribute-sweep-auto-propagates-to-clean-copy
(t/async
done
(let [sweep (tm/one-of
[(n/change-attr :main-child :fills red)
(n/change-attr :main-child :opacity 0.5)])]
(ftm/check
done
{:setup setup/simple-component-with-copy
:operation (tm/in-sequence [sweep])}
(fn [situation]
(let [chosen (tm/get-choice situation sweep)]
(t/is (some? chosen))
(t/is (n/has-attr? chosen (setup/copy-instance situation)))))))))
(t/async done (ftm/check done (cases/attribute-sweep-propagates-to-clean-copy))))
(t/deftest case-d-add-shape-to-main-auto-propagates-to-clean-copy
(t/async
done
(let [add (n/add-child :main-root :main-child-2)]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [add])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
main-new (n/added-shape add situation)
copy-new (n/materialized-instance-child add situation copy-root)]
(t/is (some? copy-new))
(t/is (ctk/is-main-of? main-new copy-new))
(t/is (ctst/parent-of? copy-root copy-new))
(t/is (nil? (:touched copy-new)))))))))
(t/async done (ftm/check done (cases/add-shape-to-main-propagates-to-clean-copy))))
(t/deftest case-e-remove-shape-from-main-auto-propagates-to-clean-copy
(t/async
done
(let [removal (n/remove-child :main-child2)]
(ftm/check
done
{:setup setup/component-with-many-children
:operation (tm/in-sequence [removal])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c3 (setup/copy-child situation 3)]
(t/is (= 2 (count order)))
(t/is (= (nth order 0) (:id c1)))
(t/is (= (nth order 1) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c3)))
(t/is (nil? (:touched copy-root)))))))))
(t/async done (ftm/check done (cases/remove-shape-from-main-propagates-to-clean-copy))))
(t/deftest case-f-move-shape-in-main-auto-propagates-order-to-clean-copy
(t/async
done
(let [move (n/move-child :main-child1 :main-root 2)]
(ftm/check
done
{:setup setup/component-with-many-children
:operation (tm/in-sequence [move])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c2 (setup/copy-child situation 2)
c3 (setup/copy-child situation 3)]
(t/is (= (nth order 0) (:id c2)))
(t/is (= (nth order 1) (:id c1)))
(t/is (= (nth order 2) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c2)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c2)))
(t/is (nil? (:touched c3)))))))))
(t/async done (ftm/check done (cases/move-shape-in-main-propagates-order-to-clean-copy))))
(t/deftest case-i-undo-reverts-edit-and-its-auto-propagation
(t/async
done
;; UNDO axis (case I), built on case A: change the main (which auto-propagates
;; to the clean copy), then UNDO. A single undo reverses the whole logical
;; action — the edit AND its propagation — so the copy returns to baseline and
;; is left untouched. Undo is just another op (`n/undo`); the engine owns
;; reversal (frontend realisation dispatches the real `dwu/undo`).
(let [original "#abcdef" ; the labeled setup's starting fill
baseline (n/change-attr :main-child :fills original) ; expected-VALUE descriptor
change (n/change-attr :main-child :fills red)]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [change (n/undo)])}
(fn [situation]
(let [copy (setup/copy-instance situation)
main (setup/main-instance situation)]
;; the edit was reversed on the main …
(t/is (n/has-attr? baseline main))
;; … and on the copy (the propagation was reversed too) …
(t/is (n/has-attr? baseline copy))
;; … leaving the copy clean.
(t/is (nil? (:touched copy)))))))))
(t/async done (ftm/check done (cases/undo-reverts-edit-and-its-propagation))))
(t/deftest case-h-library-change-propagates-across-file-boundary-on-sync
(t/async
done
;; LOCALITY axis: the main lives in a linked LIBRARY, the copy in the consuming
;; (current) file. The library main has diverged (setup applied `red` to it,
;; leaving the copy stale). Unlike the in-file cases, the watcher does NOT cross the
;; file boundary; the real app propagates via the library-UPDATE action, so the
;; transformation is `sync-from-library` (dispatches the real `sync-file`).
;; `expected` is only an expected-VALUE descriptor (its target is irrelevant;
;; `has-attr?` uses just attr+value), so the asserter reads exactly like case A.
(let [expected (n/change-attr :main-child :fills red)]
(ftm/check
done
{:setup #(setup/cross-file-component-with-copy red)
:operation (tm/in-sequence [(n/sync-from-library)])}
(fn [situation]
(t/is (n/has-attr? expected (setup/copy-instance situation))))))))
(def ^:private blue "#0000ff")
(t/async done (ftm/check done (cases/library-change-propagates-across-file-boundary-on-sync))))
(t/deftest case-k-synchronisation-scenarios
(t/async
done
;; CONSOLIDATED SCENARIO SWEEP — one composition standing in for many cases.
;; Built from the sync-scenario operations on an empty situation. It sweeps:
;; - DEPTH 0/1/2 via two independent `(optional (make-nested-component ...))`
;; - which EDITS were made via three independent `(optional change-*)`
;; and asserts, at INLINE checkpoints, the override-precedence and reset rules.
;; The change targets are the tracked ROLES (:remote/:main/:copy-child-rect), so
;; the same composition holds at any depth. Propagation is AUTOMATIC (no
;; propagate op). Subsumes the flat/nested propagation cases (A/G/J).
(let [m "main"
change-remote (n/change-property (n/remote-rect-of m) :fills red)
change-main (n/change-property (n/main-rect-of m) :fills green)
change-copy (n/change-property (n/copy-rect-of m) :fills blue)
copy-rect (fn [s] (n/lineage-copy-rect s m))
;; precedence at the copy: copy override wins; else main; else remote.
expected-after-edits
(fn [s]
(cond
(tm/applied? s change-copy) (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-main) (n/has-property-of change-main (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-remote) (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s)))
:else true))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
;; depth sweep: two independent optionals give depths 0/1/2
;; (depth 1 appears twice — harmless) without nesting a
;; Sequence inside an optional.
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(n/instantiate-copy m)
(tm/optional change-remote)
(tm/optional change-main)
(tm/optional change-copy)
(tm/test-that (fn [s] (t/is (expected-after-edits s))))
;; force a copy override, observe it wins, then reset it away
change-copy
(tm/test-that
(fn [s] (t/is (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s))))))
(n/reset-copy-instance m)
(tm/test-that
(fn [s]
;; after reset: main's value if main changed, else remote's
;; if remote changed (else the original — not asserted).
(cond
(tm/applied? s change-main) (t/is (n/has-property-of change-main (tm/shape-by-id s (copy-rect s))))
(tm/applied? s change-remote) (t/is (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s))))
:else true)))])}))))
(defn- level-color
"The fill colour of the rect currently at lineage `name`'s nesting level `i`."
[s name i]
(-> (tm/shape-by-id s (n/level-rect s name i)) :fills first :fill-color))
(def ^:private base-color "#aaaaaa")
(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets
(t/async done (ftm/check done (cases/synchronisation-scenarios))))
(t/deftest case-l-swap-scenarios
(t/async
done
;; SWAP SWEEP — build a 3-level nesting, then OPTIONALLY swap the nested
;; component at each level for a differently-coloured one, and assert the colour
;; that surfaces at every level. A swap at level i propagates (automatically, via
;; the watcher) to level i and every OUTER (higher-index) level, until a swap at
;; a higher level overrides it. So the colour at level i is the swap at the
;; HIGHEST index j <= i that was applied, else the base colour. (Generalises the
;; "single swap in copy" diagram across which levels are swapped.)
(let [m "main"
targets ["s0" "s1" "s2"]
;; swap[i] swaps level i's nested component for target lineage i (color i)
swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3))
expected-at
(fn [s i]
;; the colour of the applied swap at the highest j <= i, else base
(or (some (fn [j] (when (tm/applied? s (nth swaps j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
[(n/create-component m base-color)]
;; a target lineage per level
(map-indexed (fn [i c] (n/create-component (nth targets i) c)) swap-colors)
[(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)]
;; optionally swap at each level
(map (fn [sw] (tm/optional sw)) swaps)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))))
(t/async done (ftm/check done (cases/swap-scenarios))))
(t/deftest case-m-variant-switch-scenarios
(t/async
done
;; VARIANT-SWITCH SWEEP — the variant-switch flavour of case L. Build a variant
;; SET of peer members and nest the base member at EVERY level (so each level has
;; a variant head, just as case L's swap target exists at every level). Then
;; OPTIONALLY switch the variant head at each level to a differently-coloured
;; sibling and assert the colour that surfaces at every level. A variant switch
;; routes through the SAME component-swap as case L (keep-touched? true), so the
;; watcher auto-propagates it identically: the colour at level i is the switch at
;; the HIGHEST index j <= i that was applied, else the base member's colour. Same
;; asserter as L — the test of "a variant switch propagates like a swap".
(let [m "main" ; the nesting lineage (holds the nesting-data)
vset "vset" ; the variant set
vals ["v0" "v1" "v2" "v3"]
colors (into [base-color] swap-colors) ; base + sibling colours
;; switch[i] switches level i's variant head to member i+1 (colour i). The
;; single variant instance has a corresponding (switchable) head at every
;; level — `nested-head` IS the deepest instance there — so we can switch at
;; ANY level, exactly like case L's per-level swap.
switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth vals (inc i))))
(range 3))
expected-at
(fn [s i]
;; same precedence as case L: the colour at level i is the switch at the
;; HIGHEST index j <= i that was applied (a switch propagates outward),
;; else base.
(or (some (fn [j] (when (tm/applied? s (nth switches j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
;; the nesting lineage, and the variant set (members = [value color])
[(n/create-component m base-color)
(n/make-variant-container vset (mapv vector vals colors))]
;; introduce the variant instance ONCE (innermost), then wrap it
;; with plain nesting so each outer level CONTAINS the one below
;; (progressive nesting, like case L's make-nested-component x3). nested-head
;; at every level is then the variant (the deepest instance), so a
;; switch at level i targets it and propagates OUTWARD via the
;; watcher — exactly like case L's swap.
[(n/make-nested-component-with-variant m vset "v0")
(n/make-nested-component m)
(n/make-nested-component m)]
;; optionally switch each level's variant head to its target sibling
(map (fn [sw] (tm/optional sw)) switches)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))))
(t/async done (ftm/check done (cases/variant-switch-scenarios))))
(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree
(t/async done (ftm/check done (cases/variant-switch-keeps-override-only-where-mains-agree))))
(t/deftest case-n-geometry-sync-with-rotated-instances
;; Regression sweep for #10109, with #13267's semantics as its complement: an
;; instance root's transformation is inherited, overridable content —
;; asymmetric to position, which is free per-instance placement.
;;
;; On the simple component-with-copy, sweep three axes: optionally rotate the
;; COPY as a whole (an override of its root's placement — must not block
;; propagation), optionally rotate the MAIN as a whole (inherited content —
;; an untouched copy must follow it), and apply ONE of a property edit
;; (fills) or a geometry edit (height) to the main child. In EVERY variant
;; the chosen edit must arrive at the copy child; the copy's rotation is its
;; own 45° if the copy was rotated (override wins), else the main's 45° if
;; the main was rotated (clean copy follows), else 0; and only a rotated
;; copy's ROOT is touched (:geometry-group) — its child merely follows and
;; stays untouched.
(t/async
done
(let [rotate-copy (n/rotate :copy-root 45)
rotate-main (n/rotate :main-root 45)
edits (tm/one-of
[(n/change-attr :main-instance :fills red)
(n/change-height :main-instance 80)])]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(tm/optional rotate-copy)
(tm/optional rotate-main)
edits])}
(fn [situation]
(let [chosen (tm/get-choice situation edits)
copy-root (setup/copy-root situation)
copy-child (setup/copy-instance situation)
expected-rotation (cond
(tm/applied? situation rotate-copy) 45
(tm/applied? situation rotate-main) 45
:else 0)]
;; the chosen main edit arrived at the copy child, in every variant
(t/is (some? chosen))
(t/is (n/has-property-of chosen copy-child))
;; the copy shows the expected rotation (own override > followed main > none)
(t/is (mth/close? (or (:rotation copy-root) 0) expected-rotation))
(t/is (mth/close? (or (:rotation copy-child) 0) expected-rotation))
;; only a rotated copy's ROOT is an override; the child merely follows
(t/is (= (if (tm/applied? situation rotate-copy) #{:geometry-group} nil)
(:touched copy-root)))
(t/is (nil? (:touched copy-child)))))))))
(t/async done (ftm/check done (cases/geometry-sync-with-rotated-instances))))
(t/deftest case-touched-copy-child-survives-main-rotation
;; A copy whose ROOT is rotated (a geometry override) AND whose CHILD has its
;; own geometry override (resized) must keep the child exactly in place when the
;; MAIN is later rotated: the child's placement is its own, shielded by its
;; touched :geometry-group. We capture the child's position relative to the copy
;; root before the main rotation and assert it is unchanged after.
(t/async
done
(let [before (atom nil)
rel-pos (fn [situation]
(let [child (setup/copy-instance situation)
root (setup/copy-root situation)]
(-> (gpt/subtract (grc/rect->center (:selrect child))
(grc/rect->center (:selrect root)))
(gpt/transform (:transform-inverse root (gmt/matrix))))))
capture (tm/test-that (fn [s] (reset! before (rel-pos s)) (t/is (some? @before))))]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/rotate :copy-root 30)
(n/change-height :copy-instance 60)
capture
(n/rotate :main-root 40)])}
(fn [situation]
(let [copy-child (setup/copy-instance situation)
copy-root (setup/copy-root situation)
after (rel-pos situation)]
;; both overrides are recorded as geometry touches
(t/is (contains? (:touched copy-root) :geometry-group))
(t/is (contains? (:touched copy-child) :geometry-group))
;; the child keeps its own overridden height
(t/is (mth/close? (:height copy-child) 60))
;; and its position relative to the copy root is unchanged by the main rotation
(t/is (mth/close? (:x @before) (:x after) 0.5) (str "rel-x " (:x @before) " -> " (:x after)))
(t/is (mth/close? (:y @before) (:y after) 0.5) (str "rel-y " (:y @before) " -> " (:y after)))))))))
(t/async done (ftm/check done (cases/touched-copy-child-survives-main-rotation))))

79
frontend/test/frontend_tests/composable_tests/interpreter.cljs
View File

@ -7,7 +7,7 @@
(ns frontend-tests.composable-tests.interpreter
"FRONTEND interpreter + test-facing `check` for the composable test model.
The generic engine lives in `frontend-tests.composable-tests.core` and the
The generic engine lives in `app.common.test-helpers.composable.core` and the
component instruments (operation records, setups, role accessors, inspection
methods) behind the `comp` boundary. What lives HERE is:
1. `op->events` — the event realisation of each EVENT-op: the real
@ -37,6 +37,8 @@
`setup-store`), because the watcher reads `refs/workspace-data` which derives
from `st/state`. State is re-installed per variant for isolation."
(:require
[app.common.test-helpers.composable.comp.nodes :as n]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
@ -51,8 +53,6 @@
[app.main.store :as st]
[beicon.v2.core :as rx]
[cljs.test :as t]
[frontend-tests.composable-tests.comp.nodes :as n]
[frontend-tests.composable-tests.core :as tm]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
@ -119,7 +119,7 @@
(defn op->events
"Map a comp operation record to the real workspace event(s) it dispatches.
`op` is one of the comp node records (frontend-tests.composable-tests.comp.nodes);
`op` is one of the comp node records (app.common.test-helpers.composable.comp.nodes);
`situation` provides cross-file context (e.g. the library id) for ops that need
it.
@ -267,21 +267,15 @@
(defn- record-op
"Record an operation's application onto the situation (after its effect settled),
re-reading the file from the store. For a RecordedChoice (one-of), record the
chosen op's application AND the choice under the one-of identity (so the
asserter's `get-choice` works), mirroring `RecordedChoice`'s own `apply-to`."
choice under the one-of identity (so the asserter's `get-choice` works) and
then the chosen op's application, in the order `RecordedChoice`'s own
`apply-to` uses."
[situation op]
(let [situation (tm/with-file situation (current-file))]
(if (tm/recorded-choice? op)
(let [chosen (tm/choice-of op)
descriptor (dissoc (into {} chosen) :frontend-tests.composable-tests.core/id)]
(-> situation
;; record the chosen op under its own identity …
(tm/record-application chosen descriptor)
;; … and the choice under the one-of's identity, keyed for get-choice
(update :node-data assoc (tm/choice-one-of-id op) {:chosen chosen})
(update :applied conj (tm/choice-one-of-id op))))
(let [descriptor (dissoc (into {} op) :frontend-tests.composable-tests.core/id)]
(tm/record-application situation op descriptor)))))
(let [situation (tm/with-file situation (current-file))
[situation op] (if (tm/recorded-choice? op)
[(tm/record-choice situation op) (tm/choice-of op)]
[situation op])]
(tm/record-application situation op (dissoc (into {} op) ::tm/id))))
(defn- op-events
"The workspace events to dispatch for an op unit (a plain op or a one-of's
@ -306,32 +300,24 @@
(defn- sync-op?
"Whether `op` is a SYNCHRONOUS, `apply-to`-based operation rather than one that
dispatches a workspace event and needs settling. Two kinds:
- FILE-TRANSFORMING (`make-nested-component`, `skip`): a pure file-value transformation
that arranges the CONFIGURATION (deepens it, re-points roles) — applied by
running `apply-to` against the live store file and writing the result back.
The property under test is still exercised by the SUBSEQUENT real-event ops.
- FILE-TRANSFORMING: the `:assembly` nodes (see `n/IComponentOperation`) and
`skip`, which arrange the CONFIGURATION (create, nest, instantiate,
re-point roles) — applied by running `apply-to` against the live store
file and writing the result back. The property under test is still
exercised by the SUBSEQUENT real-event ops.
- `Test`: an inline assertion checkpoint — its `apply-to` runs the assertion
against the current situation and returns it unchanged.
Both are handled by `run-sync-op` (no async settle — any store write is a
synchronous UpdateEvent)."
[op]
(let [op (if (tm/recorded-choice? op) (tm/choice-of op) op)]
(or (instance? n/MakeNestedComponent op)
;; the structural building blocks are also file-transforming: they arrange
;; the configuration via the shared `apply-to`. ResetCopyInstance is also a
;; file-op: the real reset event transitively reads browser globals (CSS
;; vars), so it cannot run headless; the shared apply-to runs the production
;; reset generator with validation off.
(instance? n/CreateComponent op)
(instance? n/InstantiateCopy op)
(instance? n/ResetCopyInstance op)
;; the variant container (test-helper assembly) and variant nesting (the
;; shared nesting helper) are file-transforming sync-ops; the SWITCH is the
;; real `variants-switch` workspace event (handled by op->events), not here.
(instance? n/MakeVariantContainer op)
(instance? n/MakeNestedComponentWithVariant op)
(instance? tm/Skip op)
(instance? tm/Test op))))
(or (instance? tm/Skip op)
(instance? tm/Test op)
(= :assembly (n/op-kind op))
;; A user operation, but the real reset event transitively reads browser
;; globals (CSS vars), so it cannot run headless; the shared apply-to runs
;; the production reset generator with validation off.
(instance? n/ResetCopyInstance op))))
(defn- run-sync-op
"Apply a synchronous (`sync-op?`) operation: run its shared `apply-to` against a
@ -341,16 +327,10 @@
file is unchanged; for `make-nested-component`/`skip` it writes back the transformed file.
Synchronous."
[situation op]
(let [op' (if (tm/recorded-choice? op) (tm/choice-of op) op)
situation (tm/with-file situation (current-file))
situation (tm/apply-to op' situation)]
(let [situation (tm/with-file situation (current-file))
situation (tm/apply-to op situation)]
(st/emit! (install-file-event (tm/file situation)))
;; record the choice too, if this came wrapped in a one-of
(if (tm/recorded-choice? op)
(-> situation
(update :node-data assoc (tm/choice-one-of-id op) {:chosen op'})
(update :applied conj (tm/choice-one-of-id op)))
situation)))
situation))
(defn- op-grace-ms
"Extra wait AFTER an event-op has settled, before proceeding. Always zero:
@ -464,8 +444,9 @@
success (recording calls) and `rx/timer` fires instantly, so the
`SyncFromLibrary` op's delayed RPC does not produce network errors.
Arities: `(check done case-map)` or `(check done case-map asserter)`."
([done case-map] (check done case-map nil))
Arities: `(check done case-map)`, which takes the asserter from the case
map's `:asserter`, or `(check done case-map asserter)`."
([done case-map] (check done case-map (:asserter case-map)))
([done {:keys [setup operation]} asserter]
(mock/with-mocks
{rp/cmd! mock/rpc-cmd-mock