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

♻️ Tidy the composable suite and make its cases stricter

Browse Source 
A review of the suite after the new operations:
- Dead helpers and duplicate nodes go; the lineage reset and swap
  nodes are constructors of reset and swap-shape.
- Repeated helpers are shared: grid boards (tho/add-grid-frame,
  tho/place-in-grid-columns), n/nested-head-under, n/child-shape,
  r/sync-cascade (the benchmark uses it too), the frontend fixture and
  fill helpers, and the plugin getMainComponent.
- Runner tests that repeated cases B, C and D go.
- Comments say what the code does, and the wrong ones are fixed.
- Case K's remote edit painted red on red and its unedited variants
  asserted nothing; it starts grey and every variant asserts.
- F43 is pinned in one case, AJ, by the value one undo leaves. L, M, Q
  and K get real frame sizes, since their pins depended on when the
  100 ms layout buffer flushed.
- make-nested-component takes a level count and depth-sweep gives each
  depth once, so K, Q, R, T and W stop running depth 1 twice.
- The completion-contract tests no longer depend on fixed pauses or
  on how the watcher batches its events.

Benchmark against the baseline (lower quantile): ratios 0.92 to 1.03,
no world flagged.
This commit is contained in:
alonso.torres 2026-10-09 22:31:16 +02:00
parent 124b799a63
commit 158a8e1dba
23 changed files with 983 additions and 2006 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -99,8 +99,8 @@ Two pure runners (no store, JVM + CLJS):
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`/`MoveShape`
container): no sync, no undo group. `n/reset` (`reset-copy-instance` resets a lineage's latest copy) is a user op here (sync +
undo), unlike the interpreter (file install). `{:sync? false}` disables sync. `Rotate`/`ChangeHeight`/`MoveShape`
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
@ -143,8 +143,10 @@ Two pure runners (no store, JVM + CLJS):
- `n/create-component` builds 0.01-sized frames unless given `:size`. The transform math
writes float noise into those sizes, so frontend syncs emit reflows whose commits lose
their undo group (F43) at timing-dependent points (`initialize-shape-layout` buffers
`:layout/update` in 100 ms windows): undo pins over such reflows can be nondeterministic.
`:layout/update` in 100 ms windows): undo pins over such reflows are nondeterministic.
New cases that are not about geometry pass `:size` (nesting sizes the outer frames too).
F43 lives in case AJ only (frontend only, round trip off): it pins the value one undo
leaves, which does not depend on how many entries the reflow makes.
- Case assertions a known bug breaks use `tm/known-failure bug expected pinned actual`: a
strict expected failure at assertion level (passes only while `actual` is the pinned wrong
value). The undo-check marks cover only round-trip failures.
@ -153,8 +155,11 @@ Two pure runners (no store, JVM + CLJS):
setup `simple-text-component-with-copy` (text named after its content).
- The interpreter unwraps nested choices (`(tm/optional (tm/one-of …))`); `(optional
(in-sequence …))` is still not flattened.
- Depth sweeps: `depth-sweep` in `cases.cljc`, a one-of over skip,
`(n/make-nested-component name)` and `(n/make-nested-component name 2)`; asserters read
`n/nesting-depth`. Two independent nesting optionals run depth 1 twice.
- General target-based nodes: `n/swap-shape target to` (`to` a lineage name or a component label), `n/move-to-cell board child row column`, `n/reset target` (a file install
in the interpreter, like `reset-copy-instance`). `n/nested-head-in name` finds a copy's nested
in the interpreter). `n/swap-component name level to` is `swap-shape` on `n/nested-head-of`. `n/nested-head-in name` (and the general `n/nested-head-under parent-target`) finds a copy's nested
head through its parent, so it survives swaps and switches (they keep the head id anyway).
Careful: `n/lineage-component-id` is the OUTER component after nesting.
- `n/undo-before-sync` (frontend-only) emits an edit and `dwu/undo` in one step, so the undo
@ -163,7 +168,7 @@ Two pure runners (no store, JVM + CLJS):
before running the next one (`thi/id` then points at the new run's shapes). Case letters B..Z, then AA..;
the sweeps (K: depth × edit-precedence; L: swaps; M: variant switches; N: rotated-instance
geometry, on the #10109 fix branch until merged; O: switch of an overridden copy, mains
agreeing or not; Q: detach at depth 0..2, nested copies stay linked; R: update-main at depth 0..2 with two copies; S: delete/restore with a copy on another page; T: duplicate a copy at depth 0..2; U: move a copy into a main with a copy; V: new edit after undo empties redo; W: `(n/undo 3)` over nested cascades; X: undo before the edit's sync, frontend only; Y: text override × main text change, per subgroup; Z: main child move, frontend only; AA..AE: swap outcomes asserted on values, not slot storage, so they survive the Phase 2b swap model; AF: grid cell move vs a swapped copy child, setup `grid-component-with-copy`; AG/AH/AI: ports of the plugin's slot-alignment cases, setup `component-with-sibling-instances`, check `setup/misaligned-sub-heads`) are the flagship pattern — read them before
agreeing or not; Q: detach at depth 0..2, nested copies stay linked; R: update-main at depth 0..2 with two copies; S: delete/restore with a copy on another page; T: duplicate a copy at depth 0..2; U: move a copy into a main with a copy; V: new edit after undo empties redo; W: `(n/undo 3)` over nested cascades; X: undo before the edit's sync, frontend only; AJ: F43, one undo after a nested sync reverts only the reflow, frontend only; Y: text override × main text change, per subgroup; Z: main child move, frontend only; AA..AE: swap outcomes asserted on values, not slot storage, so they survive the Phase 2b swap model; AF: grid cell move vs a swapped copy child, setup `grid-component-with-copy`; AG/AH/AI: ports of the plugin's slot-alignment cases, setup `component-with-sibling-instances`, check `setup/misaligned-sub-heads`) are the flagship pattern — read them before
writing a new sweep.
**Scenario lineage model** (behind the sweeps): scenario ops track named component lineages as
@ -250,7 +255,7 @@ Distinguishing abstractions (the OOP articulation of the shared principles):
- `OpDetach`/`OpSwap`/`OpReset` wait for pending propagation before acting (a script could
otherwise act inside the sync window, which no user can). `swapComponent` keeps touched (F33).
The suite pins published `@penpot/plugin-types` 1.4.2, which lacks `resetOverrides` (typed cast).
- Known bugs: `Assert.knownFailure(bug, actual, expected, pinned, equals)`, the counterpart of
- Known bugs: `Assert.knownFailure(bug, expected, pinned, actual, equals)` (same order as `tm/known-failure`), the counterpart of
`tm/known-failure`.
- Panel checkboxes carry stable DOM ids (case identifier / `Identifier-N` composites) for remote
control via Playwright; recipe in the README.

42
common/dev/bench/component_sync.clj
View File

@ -16,12 +16,12 @@
Run from `common/` with `scripts/bench-components` (`record` writes the
baseline, `compare`, the default, checks against it)."
(:require
[app.common.files.changes :as ch]
[app.common.files.changes-builder :as pcb]
[app.common.logic.libraries :as cll]
[app.common.logic.shapes :as cls]
[app.common.logic.variants :as clv]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.composable.comp.runner :as r]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
@ -54,35 +54,6 @@
[file changes]
(thf/apply-changes file changes :validate? false))
(defn- changed-components
"Ids of the components whose main `changes` modified, judged against
`old-data`, the file data before them."
[old-data changes]
(into #{} (mapcat (partial ch/components-changed old-data)) (:redo-changes changes)))
(defn- sync-cascade
"Sync the copies of `component-ids` in `file`, then those of the components
each sync changed, until none is left. `libraries` are the other files.
Returns `[file passes]`."
[file libraries component-ids]
(loop [file file
pending (vec component-ids)
passes 0]
(if (empty? pending)
[file passes]
(let [file-id (:id file)
changes (cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
file-id
(first pending)
file-id
(assoc libraries file-id file)
file-id)
file' (apply-changes file changes)
more (remove (set pending) (changed-components (:data file) changes))]
(recur file' (into (subvec pending 1) more) (inc passes))))))
(defn- edit
"`file` after `f` changed the shape `label` through the production path,
and the ids of the components that changed."
@ -93,7 +64,14 @@
f
(:objects page)
{})]
[(apply-changes file changes) (changed-components (:data file) changes)]))
[(apply-changes file changes) (r/changed-components (:data file) changes)]))
(defn- sync-cascade
"`[file passes]` after syncing the copies of `component-ids` in `file` to
a fixpoint (see `r/sync-cascade`)."
[file libraries component-ids]
(let [{:keys [file passes]} (r/sync-cascade file libraries component-ids)]
[file passes]))
(defn- red
[shape]
@ -196,7 +174,7 @@
page libs (:data file) shape (:id target) true)]
(sync-cascade (apply-changes file changes)
{}
(changed-components (:data file) changes))))]
(r/changed-components (:data file) changes))))]
{:key :variant-switch-into-copies
:describe "a variant copy in a main switches; 100 copies of the main sync"
:run switch

625
common/src/app/common/test_helpers/composable/comp/cases.cljc
View File

@ -5,20 +5,15 @@
;; 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`).
"Component cases of the composable test model, run by the frontend
interpreter (`frontend-tests.composable-tests.comp.sync-test`) and by the
pure runner (`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.
A case is a zero-arg fn returning `{:setup :operation :asserter}`; the
asserter gets the resulting situation of each variant. A case holds only
user actions: the runners sync the copies, and the cases assert on that.
The cases (see `mem:frontend/composable-component-tests` for details):
The cases (`mem:frontend/composable-component-tests`):
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).
@ -28,8 +23,8 @@
the explicit library sync (cross-file propagation).
I — undo reverses an edit AND its propagation.
P — redo applies an undone edit and its propagation again.
K — the synchronisation sweep: depth x edit-targets, with override-precedence
and reset checkpoints.
K — edits at depth 0..2: the copy's own, else its main's, else the
remote's; a reset keeps the main's.
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.
@ -42,6 +37,8 @@
W — one undo node undoes several steps over nested cascades.
X — an undo committed before the edit's sync leaves copies unchanged
(frontend only).
AJ — one undo after a nested sync reverts only the reflow (F43, frontend
only).
Y — a text override merges with a main text change per subgroup.
Z — a move of a main child reaches the copies (frontend only).
AA..AE — swap outcomes: a copy's swap survives main changes; reset of a
@ -51,7 +48,7 @@
AG — a main reorder keeps the copy's nested copies aligned.
AH, AI — a copy deleting a nested copy keeps the others aligned (AI also
reflows, frontend only).
N — geometry sync with rotated instances (needs the frontend placement step).
N — main edits reach rotated copies (frontend only).
Rotation — a touched copy child survives a main rotation (frontend only too)."
(:require
[app.common.data :as d]
@ -72,40 +69,50 @@
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
(def ^:private blue "#0000ff")
(def ^:private base-color "#aaaaaa")
;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.)
(defn- fill-color
[shape]
(-> shape :fills first :fill-color))
(defn- depth-sweep
"One variant per nesting depth 0, 1 and 2 of lineage `name`."
[name]
(tm/one-of [(tm/skip)
(n/make-nested-component name)
(n/make-nested-component name 2)]))
(defn copy-override-survives-later-main-change
"Case B."
"Case B. A copy overrides its child's fill, then the main changes it. The
override survives, touched."
[]
(let [override (n/change-attr :copy-child :fills green)] ; touch the copy first
(let [override (n/change-property :copy-child :fills green)]
{: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)])
(n/change-property :main-child :fills red)])
:asserter (fn [situation]
(let [copy-child (setup/copy-instance situation)]
(t/is (n/has-attr? override copy-child))
(t/is (n/has-property-of 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."
"Case C. A main change of fill or opacity reaches a clean copy."
[]
(let [sweep (tm/one-of
[(n/change-attr :main-child :fills red)
(n/change-attr :main-child :opacity 0.5)])]
[(n/change-property :main-child :fills red)
(n/change-property :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)))))}))
(t/is (n/has-property-of chosen (setup/copy-instance situation)))))}))
(defn add-shape-to-main-propagates-to-clean-copy
"Case D."
"Case D. A shape added to the main appears in the copy, linked to it and
untouched."
[]
(let [add (n/add-child :main-root :main-child-2)]
{:setup setup/simple-component-with-labeled-copy
@ -120,7 +127,8 @@
(t/is (nil? (:touched copy-new)))))}))
(defn remove-shape-from-main-propagates-to-clean-copy
"Case E."
"Case E. The middle of three main children is deleted; the copy loses it
and keeps the others in order, linked and untouched."
[]
(let [removal (n/remove-child :main-child2)]
{:setup setup/component-with-many-children
@ -140,7 +148,8 @@
(t/is (nil? (:touched copy-root)))))}))
(defn move-shape-in-main-propagates-order-to-clean-copy
"Case F."
"Case F. The main moves its first child to the end; the copy follows, its
children linked and untouched."
[]
(let [move (n/move-child :main-child1 :main-root 2)]
{:setup setup/component-with-many-children
@ -168,245 +177,147 @@
(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."
single undo reverses the edit and its propagation, so main and copy are
back to the first fill and the copy is 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)))))}))
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/change-property :main-child :fills red) (n/undo)])
:asserter (fn [situation]
(let [copy (setup/copy-instance situation)]
(t/is (= setup/labeled-fill (fill-color (setup/main-instance situation))))
(t/is (= setup/labeled-fill (fill-color copy)))
(t/is (nil? (:touched copy)))))})
(defn redo-reapplies-edit-and-its-propagation
"Case P. Change the main (which propagates to the clean copy), undo, then
redo. The redo applies the edit and its propagation again, so the copy
shows the main's new value and is left untouched."
[]
(let [change (n/change-attr :main-child :fills red)]
(let [change (n/change-property :main-child :fills red)]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [change (n/undo) (n/redo)])
:asserter (fn [situation]
(let [copy (setup/copy-instance situation)
main (setup/main-instance situation)]
(t/is (n/has-attr? change main))
(t/is (n/has-attr? change copy))
(t/is (n/has-property-of change main))
(t/is (n/has-property-of change copy))
(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)."
"Case H. The main lives in a linked library, the copy in the consuming
(current) file. The library main has diverged (the setup filled it `red`,
leaving the copy stale). In-file sync does not cross the file boundary;
the app propagates through the library update action, so the operation is
`sync-from-library`."
[]
(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))))}))
{:setup #(setup/cross-file-component-with-copy red)
:operation (tm/in-sequence [(n/sync-from-library)])
:asserter (fn [situation]
(t/is (= red (fill-color (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)."
"Case K. At nesting depth 0, 1 or 2, optionally the remote main, the main
and the copy change their rect. The copy shows its own change, else the
main's, else the remote's, else the first fill. Then the copy overrides
its rect and resets: it shows the main's change, else the remote's, else
the first fill."
[]
(let [m "main"
(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))]
force-copy (n/change-property (n/copy-rect-of m) :fills blue)
copy-color (fn [s] (fill-color (tm/shape-by-id s (n/lineage-copy-rect s m))))
main-color (fn [s]
(cond
(tm/applied? s change-main) green
(tm/applied? s change-remote) red
:else base-color))]
{: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/create-component m base-color :size 100)
(depth-sweep 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)))])}))
(t/is (= (if (tm/applied? s change-copy) blue (main-color s))
(copy-color s)))))
force-copy
(tm/test-that (fn [s] (t/is (= blue (copy-color s)))))
(n/reset-copy-instance m)
(tm/test-that (fn [s] (t/is (= (main-color s) (copy-color s)))))])}))
(defn- level-color
"The fill colour of the rect currently at lineage `name`'s nesting level `i`."
"The fill of the rect 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))
(fill-color (tm/shape-by-id s (n/level-rect s name i))))
(def ^:private base-color "#aaaaaa")
(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets
(def ^:private level-0-reflow-left
;; what one undo of a first step at level 0 leaves in place
#{[:object :sync-main-innercopy-0 :component-id]
[:object :sync-main-innercopy-0 :shape-ref]
[:object :sync-main-innercopy-0 :shapes]
[:object :sync-main-innercopy-0 :touched]
[:object :sync-main-innercopy-0 :width]
[:object :sync-main-innercopy-0 :height]
[:object :sync-main-innercopy-0 :selrect]
[:object :sync-main-innercopy-1 :width]
[:object :sync-main-innercopy-1 :height]
[:object :sync-main-innercopy-1 :selrect]
[:object :sync-main-innercopy-2 :width]
[:object :sync-main-innercopy-2 :height]
[:object :sync-main-innercopy-2 :selrect]
[:object :unlabelled :component-id]
[:object :unlabelled :shapes]
[:object :unlabelled :missing]
[:object :unlabelled :extra]})
(def ^:private level-1-reflow-left
;; what one undo of a first step at level 1 leaves in place
#{[:object :unlabelled :component-id]
[:object :unlabelled :shape-ref]
[:object :unlabelled :shapes]
[:object :unlabelled :touched]
[:object :unlabelled :missing]
[:object :unlabelled :extra]
[:object :sync-main-innercopy-1 :width]
[:object :sync-main-innercopy-1 :height]
[:object :sync-main-innercopy-1 :selrect]
[:object :sync-main-innercopy-2 :width]
[:object :sync-main-innercopy-2 :height]
[:object :sync-main-innercopy-2 :selrect]})
(defn- first-steps-break-undo
"Known failures of the frontend round trip for the sweeps over `steps`, the
optional steps at levels 0, 1 and 2: the first of them to run at level 0 or
1 reflows the nested frames, and that reflow lands in undo entries of its
own (F43), so one undo does not revert the whole step."
[steps]
(let [mark (fn [op pred left entries]
{:bug "F43"
:fails {:undo left
:undo-index #{[:undo-index entries]}}
:op op
:runners #{:frontend}
:when pred})]
[(mark (nth steps 0) (constantly true) level-0-reflow-left 5)
(mark (nth steps 1) #(not (tm/applied? % (nth steps 0))) level-1-reflow-left 2)]))
(defn- expected-level-color
"The color at nesting level `i` after the optional per-level `steps` (swaps
or switches; step j gives `swap-colors` j): a step at level j reaches
every level from j outwards, so it is the color of the applied step at
the highest j <= i, else the base color."
[s steps i]
(or (some #(when (tm/applied? s (nth steps %)) (nth swap-colors %))
(range i -1 -1))
base-color))
(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."
"Case L. A three-level nesting optionally swaps the nested component at
each level for one of its own colour. Each level shows the colour of
`expected-level-color`."
[]
(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
:undo-check {:known-failures (first-steps-break-undo swaps)}
: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)))))]))}))
;; swap i swaps level i for lineage i, of colour i
swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3))]
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
[(n/create-component m base-color :size 100)]
(map-indexed (fn [i c] (n/create-component (nth targets i) c :size 100))
swap-colors)
[(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)]
(map (fn [sw] (tm/optional sw)) swaps)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-level-color s swaps 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."
"Case M. Case L with variant switches: a variant member nested and wrapped
twice, so every level holds its image, and an optional switch at each
level to a member of its own colour."
[]
(let [m "main" ; the nesting lineage (holds the nesting-data)
vset "vset" ; the variant set
vals ["v0" "v1" "v2" "v3"]
values ["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
:undo-check {:known-failures (first-steps-break-undo switches)}
: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)))))]))}))
;; switch i switches level i to member i+1, of colour i
switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth values (inc i))))
(range 3))]
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
[(n/create-component m base-color :size 100)
(n/make-variant-container vset (mapv vector values colors) :size 100)]
;; each outer level holds the one below, so a switch
;; reaches the outer levels
[(n/make-nested-component-with-variant m vset "v0")
(n/make-nested-component m)
(n/make-nested-component m)]
(map (fn [sw] (tm/optional sw)) switches)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-level-color s switches 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
@ -444,7 +355,7 @@
(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 (= red (fill-color rect)))
(t/is (not (contains? (:touched rect) :fill-group)))))))}))
(defn detach-keeps-nested-copies-linked
@ -458,65 +369,30 @@
remote main."
[]
(let [m "main"
nest-1 (n/make-nested-component m)
nest-2 (n/make-nested-component m)
change-main (n/change-property (n/main-rect-of m) :fills green)
change-remote (n/change-property (n/remote-rect-of m) :fills blue)
;; at depth 2 the sync of the remote change reflows the nested
;; frames, and the reflow lands in an undo entry of its own (F43)
reflow-mark (fn [main? left entries]
{:bug "F43"
:fails {:undo left
:undo-index #{[:undo-index entries]}}
:op change-remote
:runners #{:frontend}
:when #(and (tm/applied? % nest-1)
(tm/applied? % nest-2)
(= main? (tm/applied? % change-main)))})]
{:setup setup/empty-situation
:undo-check {:known-failures
[(reflow-mark true
#{[:object :sync-main-innercopy-0 :width]
[:object :sync-main-innercopy-0 :height]
[:object :sync-main-innercopy-0 :selrect]
[:object :sync-main-rect :fills]
[:object :unlabelled :fills]}
2)
(reflow-mark false
#{[:object :sync-main-innercopy-0 :width]
[:object :sync-main-innercopy-0 :height]
[:object :sync-main-innercopy-0 :selrect]
[:object :sync-main-innercopy-1 :width]
[:object :sync-main-innercopy-1 :height]
[:object :sync-main-innercopy-1 :selrect]
[:object :sync-main-copyhead-0 :width]
[:object :sync-main-copyhead-0 :height]
[:object :sync-main-copyhead-0 :selrect]
[:object :sync-main-rect :fills]
[:object :unlabelled :fills]}
3)]}
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional nest-1)
(tm/optional nest-2)
(n/instantiate-copy m)
(tm/optional change-main)
(n/detach (n/copy-head-of m))
change-remote])
:asserter (fn [s]
(let [rect (tm/shape-by-id s (n/lineage-copy-rect s m))
color (-> rect :fills first :fill-color)
nested? (or (tm/applied? s nest-1) (tm/applied? s nest-2))
main? (tm/applied? s change-main)]
(if nested?
(do
(t/is (some? (:shape-ref rect)))
(t/is (= (if main? green blue) color))
(t/is (= main? (contains? (:touched rect) :fill-group))))
(do
(t/is (nil? (:shape-ref rect)))
(t/is (nil? (:touched rect)))
(t/is (= (if main? green red) color))))))}))
change-remote (n/change-property (n/remote-rect-of m) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red :size 100)
(depth-sweep m)
(n/instantiate-copy m)
(tm/optional change-main)
(n/detach (n/copy-head-of m))
change-remote])
:asserter (fn [s]
(let [rect (tm/shape-by-id s (n/lineage-copy-rect s m))
color (fill-color rect)
nested? (pos? (n/nesting-depth s m))
main? (tm/applied? s change-main)]
(if nested?
(do
(t/is (some? (:shape-ref rect)))
(t/is (= (if main? green blue) color))
(t/is (= main? (contains? (:touched rect) :fill-group))))
(do
(t/is (nil? (:shape-ref rect)))
(t/is (nil? (:touched rect)))
(t/is (= (if main? green red) color))))))}))
(defn update-main-reaches-other-copies
"Case R. A component at nesting depth 0, 1 or 2 has two copies. The first
@ -528,14 +404,11 @@
the main when it had none."
[]
(let [m "main"
nest-1 (n/make-nested-component m)
nest-2 (n/make-nested-component m)
other-override (n/change-property (n/nth-copy-rect-of m 1) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional nest-1)
(tm/optional nest-2)
(depth-sweep m)
(n/instantiate-copy m)
(n/instantiate-copy m)
(tm/optional other-override)
@ -543,18 +416,17 @@
(n/update-main (n/nth-copy-head-of m 0))])
:asserter (fn [s]
(let [rect (fn [id] (tm/shape-by-id s id))
color (fn [shape] (-> shape :fills first :fill-color))
fill? (fn [shape] (contains? (:touched shape) :fill-group))
nested? (or (tm/applied? s nest-1) (tm/applied? s nest-2))
nested? (pos? (n/nesting-depth s m))
other? (tm/applied? s other-override)
main (rect (n/lineage-rect s m))
copy-0 (rect (n/lineage-nth-copy-rect s m 0))
copy-1 (rect (n/lineage-nth-copy-rect s m 1))]
(t/is (= green (color main)))
(t/is (= green (fill-color main)))
(t/is (= nested? (fill? main)))
(t/is (= green (color copy-0)))
(t/is (= green (fill-color copy-0)))
(t/is (not (fill? copy-0)))
(t/is (= (if other? blue green) (color copy-1)))
(t/is (= (if other? blue green) (fill-color copy-1)))
(t/is (= other? (fill? copy-1)))))}))
(defn deleted-component-copies-sync-again-after-restore
@ -568,8 +440,7 @@
(let [override (n/change-property :copy-instance :fills green)
first-change (n/change-property :main-instance :fills red)
deletion (n/delete-component :main-root)
second-change (n/change-property :main-instance :fills blue)
color (fn [shape] (-> shape :fills first :fill-color))]
second-change (n/change-property :main-instance :fills blue)]
{:setup setup/simple-component-with-copies-on-two-pages
:operation (tm/in-sequence
[(tm/optional override)
@ -581,16 +452,16 @@
other (setup/other-page-copy-instance s)]
(t/is (some? (:shape-ref copy)))
(t/is (some? (:shape-ref other)))
(t/is (= (if (tm/applied? s override) green red) (color copy)))
(t/is (= red (color other))))))
(t/is (= (if (tm/applied? s override) green red) (fill-color copy)))
(t/is (= red (fill-color other))))))
(n/restore-component deletion)
second-change])
:asserter (fn [s]
(let [copy (setup/copy-instance s)
other (setup/other-page-copy-instance s)]
(t/is (= blue (color (setup/main-instance s))))
(t/is (= (if (tm/applied? s override) green blue) (color copy)))
(t/is (= blue (color other)))
(t/is (= blue (fill-color (setup/main-instance s))))
(t/is (= (if (tm/applied? s override) green blue) (fill-color copy)))
(t/is (= blue (fill-color other)))
(t/is (nil? (:touched other)))))}))
(defn duplicated-copy-keeps-overrides-and-link
@ -607,8 +478,7 @@
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(depth-sweep m)
(n/instantiate-copy m)
(tm/optional override)
duplication
@ -619,9 +489,9 @@
copy-rect (tm/shape-by-id s (n/lineage-copy-rect s m))
expected (if (tm/applied? s override) green blue)]
(t/is (some? (:shape-ref dup-rect)))
(t/is (= expected (-> dup-rect :fills first :fill-color)))
(t/is (= expected (fill-color dup-rect)))
(t/is (= (:touched copy-rect) (:touched dup-rect)))
(t/is (= expected (-> copy-rect :fills first :fill-color)))))}))
(t/is (= expected (fill-color copy-rect)))))}))
(defn nested-copy-reaches-copies-of-the-receiving-main
"Case U. A copy of an inner component is moved into the main of an outer
@ -652,14 +522,14 @@
:asserter (fn [s]
(let [moved (tm/shape-by-id s (n/lineage-copy-rect s inner))
nested (tm/shape-by-id s (nested-rect s))]
(t/is (= blue (-> moved :fills first :fill-color)))
(t/is (= blue (fill-color moved)))
(t/is (nil? (:touched moved)))
(if (tm/applied? s override)
(do
(t/is (= green (-> nested :fills first :fill-color)))
(t/is (= green (fill-color nested)))
(t/is (contains? (:touched nested) :fill-group)))
(do
(t/is (= blue (-> nested :fills first :fill-color)))
(t/is (= blue (fill-color nested)))
(t/is (nil? (:touched nested)))))))}))
(defn new-edit-after-undo-clears-redo
@ -687,14 +557,11 @@
with the minimal one, the frontend reflows after the remote change land in
undo entries of their own (F43), so three undos stop short."
[]
(let [m "main"
rect (fn [s id] (tm/shape-by-id s id))
colour (fn [shape] (-> shape :fills first :fill-color))]
(let [m "main"]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red :size 100)
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(depth-sweep m)
(n/instantiate-copy m)
(n/change-property (n/remote-rect-of m) :fills blue)
(n/change-property (n/main-rect-of m) :fills green)
@ -704,8 +571,9 @@
(doseq [id [((n/remote-rect-of m) s)
((n/main-rect-of m) s)
(n/lineage-copy-rect s m)]]
(t/is (= red (colour (rect s id))))
(t/is (empty? (:touched (rect s id))))))}))
(let [rect (tm/shape-by-id s id)]
(t/is (= red (fill-color rect)))
(t/is (empty? (:touched rect))))))}))
(defn undo-before-sync-leaves-copies-unchanged
"Case X (frontend only). An edit to the main is undone in the same step, so
@ -713,14 +581,40 @@
to its state before the edit: the main and its copy show the first value
and the copy is untouched."
[]
(let [original (n/change-property :main-instance :fills "#abcdef")]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/undo-before-sync :main-instance :fills red)])
:asserter (fn [s]
(let [copy (setup/copy-instance s)]
(t/is (n/has-property-of original (setup/main-instance s)))
(t/is (n/has-property-of original copy))
(t/is (nil? (:touched copy)))))}))
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/undo-before-sync :main-instance :fills red)])
:asserter (fn [s]
(let [copy (setup/copy-instance s)]
(t/is (= setup/labeled-fill (fill-color (setup/main-instance s))))
(t/is (= setup/labeled-fill (fill-color copy)))
(t/is (nil? (:touched copy)))))})
(defn reflow-after-nested-sync-is-its-own-undo-step
"Case AJ (frontend only). A component nested two levels deep, with the
minimal frame size, has a copy; its remote main changes the rect, then one
undo runs. The transform math rewrites the minimal nested frames with float
noise, so the sync of the change reflows them, and the reflow commits land
in undo entries of their own (F43). One undo should revert the change and
its sync; it reverts only the last reflow entry, so the remote rect keeps
the change. How many entries the reflow makes depends on when its 100 ms
buffer flushes, so the case checks the value one undo leaves, never the
undo stack."
[]
(let [m "main"
remote (n/remote-rect-of m)]
{:setup setup/empty-situation
;; the round trip's signature depends on when the reflow buffer flushes
:undo-check {:off "the case undoes its own step (F43)"}
:operation (tm/in-sequence
[(n/create-component m red)
(n/make-nested-component m)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/change-property remote :fills blue)
(n/undo)])
:asserter (fn [s]
(tm/known-failure "F43" red blue
(fill-color (tm/shape-by-id s (remote s)))))}))
(defn text-override-merges-with-main-text-change
"Case Y. A main text changes its characters or its font size; before that,
@ -767,11 +661,10 @@
;; ---------------------------------------------------------------------------
;; Swap outcomes
;;
;; What a swap must give, asserted on values and structure rather than on how
;; the swap is stored, so the cases hold across the swap model change of the
;; plan's Phase 2b. Each builds a component "main" whose main nests a copy of
;; it once (level 0), and a copy of that, whose nested head the case swaps.
;; Real sizes keep the frontend reflows out of the undo entries (F43).
;; What a swap must give, asserted on values and structure, not on how the
;; swap is stored. Each case builds a component "main" whose main nests a
;; copy once, and a copy of it, whose nested head the case swaps. Real sizes
;; keep the frontend reflows out of the undo entries (F43).
;; ---------------------------------------------------------------------------
(defn- head-component
@ -786,7 +679,7 @@
(->> (cfh/get-children-ids objects (head s))
(map #(get objects %))
(d/seek #(= :rect (:type %)))
:fills first :fill-color)))
(fill-color))))
(defn copy-swap-survives-main-changes
"Case AA. A copy swaps its nested copy for another component. Optionally the
@ -876,20 +769,10 @@
pushes the copy's component: the main's nested copy becomes an instance of
it, and so does the second copy's."
[]
(let [m "main"
main-nst (fn [s] (:nested-head (n/lineage-nesting s m 0)))
second (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
head ((n/nth-copy-head-of m 1) s)]
(->> (cfh/get-immediate-children objects head)
(d/seek :component-id)
:id)))
nested (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
head ((n/nth-copy-head-of m 0) s)]
(->> (cfh/get-immediate-children objects head)
(d/seek :component-id)
:id)))]
(let [m "main"
main-nested (n/nested-head-under (n/main-head-of m))
first-nested (n/nested-head-under (n/nth-copy-head-of m 0))
second-nested (n/nested-head-under (n/nth-copy-head-of m 1))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
@ -897,20 +780,13 @@
(n/make-nested-component m)
(n/instantiate-copy m)
(n/instantiate-copy m)
(n/swap-shape nested "s1")
(n/swap-shape first-nested "s1")
(n/update-main (n/nth-copy-head-of m 0))])
:asserter (fn [s]
(let [s1 (n/lineage-component-id s "s1")
main-head (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
outer (:main-head (n/lineage-nesting s m 0))]
(->> (cfh/get-immediate-children objects outer)
(d/seek :component-id)
:id)))]
(t/is (some? (main-nst s)))
(t/is (= s1 (head-component s main-head)))
(t/is (= s1 (head-component s second)))
(t/is (= red (head-rect-color s second)))))}))
(let [s1 (n/lineage-component-id s "s1")]
(t/is (= s1 (head-component s main-nested)))
(t/is (= s1 (head-component s second-nested)))
(t/is (= red (head-rect-color s second-nested)))))}))
(defn detached-or-duplicated-swapped-copy-follows-its-component
"Case AE. A copy swaps its nested copy; then the copy is detached, or
@ -921,11 +797,7 @@
(let [m "main"
nested (n/nested-head-in m)
duplication (n/duplicate (n/copy-head-of m))
dup-nested (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))]
(->> (cfh/get-immediate-children objects ((n/duplicate-head-of duplication) s))
(d/seek :component-id)
:id)))]
dup-nested (n/nested-head-under (n/duplicate-head-of duplication))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
@ -964,7 +836,7 @@
(t/is (= 3 (column s :copy-root :copy-child)))))}))
(defn main-reorder-keeps-copy-sub-heads-aligned
"Case AG (port of the plugin's MainReorderKeepsCopySlots). A main holds three
"Case AG (the plugin's MainReorderKeepsCopySlots). A main holds three
nested copies side by side; it moves the first to the end. The copy follows:
each of its children references the main's child at the same position."
[]
@ -980,7 +852,7 @@
(t/is (= [] (setup/misaligned-sub-heads s))))}))
(defn copy-sub-head-delete-keeps-others-aligned
"Case AH (port of the plugin's CopySubheadDeletePreservesSlots, without its
"Case AH (the plugin's CopySubheadDeletePreservesSlots, without its
reflow). A grid main holds three nested copies; its copy optionally deletes
its first or its last one. The copy's remaining children still reference
the main's children at the same positions."
@ -992,7 +864,7 @@
(t/is (= [] (setup/misaligned-sub-heads s))))})
(defn copy-sub-head-delete-and-reflow-keeps-others-aligned
"Case AI (frontend only; port of the plugin's CopySubheadDeletePreservesSlots
"Case AI (frontend only; the plugin's CopySubheadDeletePreservesSlots
with its reflow). As case AH, then the copy root optionally changes height,
which reflows its grid. The copy's remaining children still reference the
main's children at the same positions."
@ -1005,24 +877,17 @@
(t/is (= [] (setup/misaligned-sub-heads s))))})
(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."
"Case N (frontend only). Optionally the copy rotates, optionally the main
rotates, then the main child changes its fill or its height. The change
reaches the copy child. A copy root's rotation is inherited content that a
copy may override: the copy shows its own rotation, else the main's, else
none. Only a rotated copy root is touched (:geometry-group); its child
follows 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-property :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)
@ -1036,19 +901,16 @@
(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 main-child-move-reaches-copies
"Case Z (frontend only, like the other geometry operations). A child of the
"Case Z (frontend only). A child of the
main moves; optionally the copy moved its own child before. The copy child
keeps its offset from the copy root equal to the main child's from the main
root, so it follows the move, unless it moved itself: then it keeps its own
@ -1075,11 +937,9 @@
(t/is (empty? (:touched (setup/copy-root s))))))}))
(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."
"Frontend only. A copy rotates its root and resizes its child, then the
main rotates. The child's touched :geometry-group shields it: its height
and its position relative to the copy root do not change."
[]
(let [before (atom nil)
rel-pos (fn [situation]
@ -1098,11 +958,8 @@
(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)))))}))

953
common/src/app/common/test_helpers/composable/comp/nodes.cljc
View File

File diff suppressed because it is too large Load Diff

63
common/src/app/common/test_helpers/composable/comp/runner.cljc
View File

@ -45,7 +45,7 @@
;; A guard against a sync cascade that never settles.
(def ^:private max-sync-passes 100)
(defn- changed-components
(defn changed-components
"Ids of the components whose main `changes` modified, judged against
`old-data`, the file data before `changes` applied."
[old-data changes]
@ -68,33 +68,21 @@
(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))
(defn sync-cascade
"Sync the copies of `component-ids` in `file`, then those of the components
each sync changed, until none is left, as the frontend `sync-file` event
builds the changes for a local component; the frontend watcher runs one
pass per sync commit. `libraries` are the other files by id. Returns
`{:file :syncs :passes}`, with `syncs` the sync changes that changed
something, in order."
[file libraries component-ids]
(loop [file file
pending (vec component-ids)
syncs []
passes 0]
(cond
(empty? pending)
[(validate-settled! (tm/with-file situation file)) syncs]
{:file file :syncs syncs :passes passes}
(>= passes max-sync-passes)
(throw (ex-info "Component sync did not settle"
@ -103,16 +91,33 @@
: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)))]
(let [file-id (:id file)
sync (cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
file-id
(first pending)
file-id
(assoc libraries file-id file)
file-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- sync-file
"Sync `situation`'s file, starting from the components that `changes`
modified (judged against `old-data`), and validate the result. Returns
`[situation syncs]`, with `syncs` the applied sync changes in order."
[situation old-data changes]
(let [{:keys [file syncs]} (sync-cascade (tm/file situation)
(tm/aux-files situation)
(changed-components old-data changes))]
[(validate-settled! (tm/with-file situation file)) syncs]))
(defn- push-undo-group
"Add `group`, the changes of one user operation and its syncs in order, to
the undo stack and empty the redo stack. Changes with nothing to undo are

228
common/src/app/common/test_helpers/composable/comp/setups.cljc
View File

@ -5,22 +5,11 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(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
a copy' is an entirely component-shaped configuration, so it lives behind the
`comp` boundary. See `mem:frontend/composable-component-tests`.
Setups are kept as plain functions (not data): structure resists
declarativization and forcing it here has the worst cost/benefit. Each returns
a *situation* (file + ROLE bindings — meaningful named objects of the
configuration, e.g. :main-instance, :copy-instance), which the test retrieves
via the accessors below and asserts on directly.
For these one-child-per-instance configurations the meaningful objects are the
child shapes that participate in propagation, so :main-instance is the main's
child and :copy-instance is the copy's child (this makes a test read like
`(has-attr? change-attr (copy-instance situation))`)."
"Setups of the composable component cases: functions that build a file
and return a situation with its roles (see
`mem:frontend/composable-component-tests`). In the one-child setups,
:main-instance and :copy-instance are the children of the main and the
copy."
(:require
[app.common.data :as d]
[app.common.files.changes-builder :as pcb]
@ -30,8 +19,10 @@
[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.shape.layout :as ctl]))
[app.common.test-helpers.shapes :as ths]))
;; The fill the labeled setups give the main child.
(def labeled-fill "#abcdef")
(defn simple-component-with-copy
"A situation with a simple component (root + one child) and one clean copy.
@ -49,21 +40,19 @@
(defn empty-situation
"A situation with an empty file and NO roles — the starting point for scenarios
that build their own configuration via operations (e.g. `create-component`,
`make-nested-component`, `instantiate-copy`). Use as the `:setup` when the first
operation creates the component."
"A situation with an empty file and no roles, for cases that build their
configuration with operations (`create-component` and the like)."
[]
(tm/make-situation (thf/sample-file :file1)))
(defn simple-component-with-labeled-copy
"Like `simple-component-with-copy`, but the main child starts with a known fill
(so 'value stayed' is distinguishable from coincidence). Same labels and roles."
"Like `simple-component-with-copy`, with the main child filled
`labeled-fill`. Same labels and roles."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-simple-component-with-copy
:component1 :main-root :main-child :copy-root
:main-child-params {:fills (ths/sample-fills-color :fill-color "#abcdef")}
:main-child-params {:fills (ths/sample-fills-color :fill-color labeled-fill)}
:copy-root-params {:children-labels [:copy-child]}))]
(tm/make-situation file {:main-instance :main-child
:copy-instance :copy-child
@ -81,7 +70,7 @@
(let [file (-> (thf/sample-file :file1 :page-label :page1)
(tho/add-simple-component-with-copy
:component1 :main-root :main-child :copy-root
:main-child-params {:fills (ths/sample-fills-color :fill-color "#abcdef")}
:main-child-params {:fills (ths/sample-fills-color :fill-color labeled-fill)}
:copy-root-params {:children-labels [:copy-child]})
(thf/add-sample-page :page2)
(thc/instantiate-component :component1 :copy2-root
@ -117,21 +106,15 @@
:main-root :main-root
:copy-root :copy-root})))
(defn- place-in-columns
"The grid board `board` with a row and three columns, holding the shapes of
`labels` in its first columns, in order."
[board labels]
(let [board (-> board
(ctl/add-grid-row {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1}))
cells (reduce (fn [cells [column label]]
(let [[id _] (d/seek #(= column (:column (val %))) cells)]
(assoc-in cells [id :shapes] [(thi/id label)])))
(:layout-grid-cells board)
(map vector (iterate inc 1) labels))]
(assoc board :layout-grid-cells cells)))
(defn- label-copy-children!
"Register each label of `labels` (main child label -> copy child label) on
the child of the copy `copy-label` that references that main child."
[file copy-label labels]
(let [objects (:objects (thf/current-page file))]
(doseq [[main-label copy-child-label] labels]
(thi/set-id! copy-child-label
(d/seek #(= (thi/id main-label) (get-in objects [% :shape-ref]))
(get-in objects [(thi/id copy-label) :shapes]))))))
(defn grid-component-with-copy
"A component whose main is a grid board (one row, three columns, 300x100)
@ -141,39 +124,22 @@
:grid-copy :copy-child1 :copy-child2 (copy side), :item, :other. Roles:
:main-root, :copy-root, :main-child -> :child1, :copy-child -> :copy-child1."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-simple-component :item :item-root :item-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50})
(tho/add-simple-component :other :other-root :other-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50
:fills (ths/sample-fills-color
:fill-color "#ff0000")})
(ths/add-sample-shape :grid-root
:type :frame
:width 300
:height 100
:layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {})
(thc/instantiate-component :item :child1 :parent-label :grid-root)
(thc/instantiate-component :item :child2 :parent-label :grid-root))
board (place-in-columns (ths/get-shape file :grid-root) [:child1 :child2])
file (-> file
(ths/update-shape :grid-root :layout-grid-rows (:layout-grid-rows board))
(ths/update-shape :grid-root :layout-grid-columns (:layout-grid-columns board))
(ths/update-shape :grid-root :layout-grid-cells (:layout-grid-cells board))
(thc/make-component :grid :grid-root)
(thc/instantiate-component :grid :grid-copy))
objects (:objects (thf/current-page file))]
;; the copy's children are the copies of the main's, by :shape-ref
(doseq [[main-label copy-label] [[:child1 :copy-child1] [:child2 :copy-child2]]]
(thi/set-id! copy-label
(->> (get-in objects [(thi/id :grid-copy) :shapes])
(d/seek #(= (thi/id main-label) (get-in objects [% :shape-ref]))))))
(let [file (-> (thf/sample-file :file1)
(tho/add-simple-component :item :item-root :item-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50})
(tho/add-simple-component :other :other-root :other-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50
:fills (ths/sample-fills-color
:fill-color "#ff0000")})
(tho/add-grid-frame :grid-root :width 300 :height 100)
(thc/instantiate-component :item :child1 :parent-label :grid-root)
(thc/instantiate-component :item :child2 :parent-label :grid-root)
(tho/place-in-grid-columns :grid-root 3 {1 :child1 2 :child2})
(thc/make-component :grid :grid-root)
(thc/instantiate-component :grid :grid-copy))]
(label-copy-children! file :grid-copy {:child1 :copy-child1 :child2 :copy-child2})
(tm/make-situation file {:main-root :grid-root
:copy-root :grid-copy
:main-child :child1
@ -187,35 +153,21 @@
(copy side, matched by :shape-ref). Roles: :main-root, :copy-root."
([] (component-with-sibling-instances :none))
([layout]
(let [grid? (= :grid layout)
subs [:sub1 :sub2 :sub3]
file (-> (thf/sample-file :file1)
(tho/add-simple-component :icon :icon-root :icon-rect
:root-params {:width 24 :height 24}
:child-params {:width 24 :height 24})
(ths/add-sample-shape :row-root
(cond-> {:type :frame :width 300 :height 100}
grid? (assoc :layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {}))))
file (reduce #(thc/instantiate-component %1 :icon %2 :parent-label :row-root) file subs)
file (cond-> file
grid?
(as-> f (let [board (place-in-columns (ths/get-shape f :row-root) subs)]
(-> f
(ths/update-shape :row-root :layout-grid-rows (:layout-grid-rows board))
(ths/update-shape :row-root :layout-grid-columns (:layout-grid-columns board))
(ths/update-shape :row-root :layout-grid-cells (:layout-grid-cells board))))))
file (-> file
(thc/make-component :row :row-root)
(thc/instantiate-component :row :row-copy))
objects (:objects (thf/current-page file))]
(doseq [[main-label copy-label] (map vector subs [:copy-sub1 :copy-sub2 :copy-sub3])]
(thi/set-id! copy-label
(->> (get-in objects [(thi/id :row-copy) :shapes])
(d/seek #(= (thi/id main-label) (get-in objects [% :shape-ref]))))))
(let [grid? (= :grid layout)
subs [:sub1 :sub2 :sub3]
file (as-> (thf/sample-file :file1) $
(tho/add-simple-component $ :icon :icon-root :icon-rect
:root-params {:width 24 :height 24}
:child-params {:width 24 :height 24})
(if grid?
(tho/add-grid-frame $ :row-root :width 300 :height 100)
(tho/add-frame $ :row-root :width 300 :height 100))
(reduce #(thc/instantiate-component %1 :icon %2 :parent-label :row-root) $ subs)
(cond-> $
grid? (tho/place-in-grid-columns :row-root 3 (zipmap [1 2 3] subs)))
(thc/make-component $ :row :row-root)
(thc/instantiate-component $ :row :row-copy))]
(label-copy-children! file :row-copy (zipmap subs [:copy-sub1 :copy-sub2 :copy-sub3]))
(tm/make-situation file {:main-root :row-root
:copy-root :row-copy}))))
@ -252,10 +204,9 @@
(defn component-with-many-children
"A situation with a component whose main has three children and one clean copy.
Shape labels: :main-root, :main-child1/2/3, :copy-root, :copy-child1/2/3.
Roles: :main-root, :copy-root, and :copy-child-1/2/3 -> the copy's children
(so a test can assert their post-operation order in the copy root)."
"A component whose main has three children, and a copy. Labels: :main-root
:main-child1/2/3 :copy-root :copy-child1/2/3. Roles: :main-root,
:copy-root and :copy-child-1/2/3 -> the copy's children."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-component-with-many-children-and-copy
@ -271,30 +222,17 @@
:copy-child-3 :copy-child3})))
(defn copy-child
"The copy child shape for 1-based index `n` (role :copy-child-n), live. Lets a
test retrieve specific copy children to assert their order/identity."
"The copy child shape for 1-based index `n` (role :copy-child-n), live."
[situation n]
(tm/role-shape situation (keyword (str "copy-child-" n))))
(defn nested-component-with-copy
"A situation with a NESTED component configuration (depth axis): component2's
main contains a nested instance of component1 (`:main2-nested-head`); a clean
copy of component2 exists, so the copy contains a copy of that nested instance
whose child (`:copy2-child`) reaches the main through a :shape-ref CHAIN.
This is the depth-1 analogue of the simple-with-copy setup: editing
`:main2-nested-head` (the nested instance inside component2's main) and
propagating component2 must reach `:copy2-child` — the same attribute-
propagation property as the flat case, one level deeper. (Editing the
INNERMOST :main1-child and propagating only :component1 would instead be a
CHAINED propagation across two component levels — a different property; not
this setup.)
Shape labels from the helper: :main1-root/:main1-child, :main2-root,
:main2-nested-head, :copy2-root, and :copy2-child (the deep copy child, labeled
via the helper's children-labels). Roles: :main-instance -> :main2-nested-head,
:copy-instance -> :copy2-child, plus :main2-root / :copy-root for structure."
"Component2's main holds a copy of component1 (`:main2-nested-head`), and a
copy of component2 holds a copy of it. Labels: :main1-root :main1-child
:main2-root :main2-nested-head :copy2-root :copy2-child. Roles:
:main-instance -> :main2-nested-head, :copy-instance -> :copy2-child,
:main2-root and :copy-root."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-nested-component-with-copy
@ -309,10 +247,8 @@
(defn- change-main-child-fill
"Apply `fill-color` to the library's :main-child via the production change path
(mirrors how a real edit to the main would have changed the library), returning
the updated library file value. Used to make the library main DIVERGE from the
already-instantiated copy, so a subsequent cross-file sync has something to pull."
"`library` with its :main-child filled `fill-color`, through the production
change path."
[library fill-color]
(let [page (thf/current-page library)
main-id (thi/id :main-child)
@ -325,41 +261,21 @@
(thf/apply-changes library changes)))
(defn cross-file-component-with-copy
"LOCALITY axis (case H): a component whose main lives in a SEPARATE, shared
LIBRARY file, and a clean copy that lives in a CONSUMING file. The library main
has since DIVERGED from the copy (its :main-child now carries `new-fill`, while
the copy still carries the original `#abcdef`), modelling 'the library was
changed elsewhere'. Propagating that change to the copy is therefore a CROSS-
FILE sync (the library-update flow), not the in-file watcher.
The returned situation's PRIMARY file is the CONSUMING file (the current file,
where the copy lives and which the copy roles resolve against); the library
travels as an AUXILIARY file (see `tm/with-aux-files`) so an interpreter can
install it alongside (e.g. into the frontend store's `:files`) and run the
cross-file sync. Roles: :copy-instance -> the copy child, :copy-root -> the copy
root (both in the consuming file). `new-fill` should match the value the test
uses for its expected-value descriptor.
Labels: in the LIBRARY — :component1, :main-root, :main-child; in the CONSUMING
file — :copy-root, :copy-child."
"A component in a shared library file and a copy of it in the current
file; the library main then changes its child's fill to `new-fill`, so the
copy is behind it. The library travels as an auxiliary file. Labels: in
the library :component1 :main-root :main-child, in the file :copy-root
:copy-child. Roles: :copy-instance -> :copy-child, :copy-root."
[new-fill]
(let [library (-> (thf/sample-file :library :is-shared true)
(tho/add-simple-component
:component1 :main-root :main-child
:child-params {:fills (ths/sample-fills-color :fill-color "#abcdef")}))
;; instantiate the copy in the consuming file FIRST (copy gets the old fill)
:child-params {:fills (ths/sample-fills-color :fill-color labeled-fill)}))
file (-> (thf/sample-file :file)
(thc/instantiate-component :component1 :copy-root
:library library
:children-labels [:copy-child]))
;; THEN diverge the library main (copy is now stale)
library' (change-main-child-fill library new-fill)]
(-> (tm/make-situation file {:copy-instance :copy-child
:copy-root :copy-root})
(tm/with-aux-files {(:id library') library'}))))
(defn library-id
"The id of the library file in a cross-file situation (the single auxiliary
file). Used by the cross-file sync operation."
[situation]
(-> situation tm/aux-files keys first))

395
common/src/app/common/test_helpers/composable/core.cljc
View File

@ -5,29 +5,15 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.common.test-helpers.composable.core
"The domain-agnostic ENGINE of the composable test model (see
`mem:frontend/composable-component-tests`):
"The domain-agnostic engine of the composable test model (see
`mem:frontend/composable-component-tests`): the situation (file, roles,
vars and the log of applied operations), node identity, strict-presence
lookup, the `IOperation` and `IEnumerable` protocols, the operators
`in-sequence`, `one-of`, `optional`, `skip` and `test-that`, and the plain
runners `run-variant` / `run-all`. Component operations live behind the
`comp` boundary (`app.common.test-helpers.composable.comp.*`).
- a `situation` carrying the in-memory file value, named ROLE bindings,
a `:vars` map, and an ordered record of applied operations,
- node identity (`assign-id`) + the applied-log (`record-application`,
`applied?`, `describe-applied`),
- strict-presence lookup that throws a diagnostic error on a missing name,
- the `IOperation` protocol (single method `apply-to`) and the
`IEnumerable` protocol behind variant enumeration,
- the composition operators `in-sequence`, `one-of`, `optional`, `skip`,
and the inline-assertion operation `test-that`,
- the enumerating pure runners `run-variant` / `run-all` (the frontend
interpreter in `frontend-tests.composable-tests.interpreter` is the
event-dispatching counterpart and the test-facing entry point).
No Penpot domain terms live here; the component-specific operations sit
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
shape label, resolved through `thi/id`. The situation adds the applied-log and
the strict-presence discipline on top of that substrate."
A shape name in an operation is a test label (`app.common.test-helpers.ids-map`)."
(:refer-clojure :exclude [apply-to])
(:require
[app.common.test-helpers.files :as thf]
@ -39,38 +25,19 @@
[clojure.test :as t]))
;; ---------------------------------------------------------------------------
;; Situation
;;
;; A situation wraps the in-memory Penpot file value together with the record of
;; what has been applied to it. The environment of *shape* bindings is the
;; global label->uuid map (reset per variant by the runners), so the situation
;; does not duplicate it; it only adds:
;; :file - the current in-memory file value
;; :applied-log - vector of application records, in application order
;; Situation: the in-memory file value with its roles, vars and the log of
;; what was applied to it. Shape labels live in the global label map, which
;; the runners reset per variant.
;; ---------------------------------------------------------------------------
;; resolve-shape is defined below (strict-presence section) but referenced by
;; role-shape above it; declare it so the forward reference resolves at load.
(declare resolve-shape)
(declare resolve-shape-id)
(defn make-situation
"Create a situation from an initial in-memory file value, optionally with role
bindings. Roles are meaningful named objects of the configuration the setup
built (e.g. :main-instance, :copy-instance), passed as shape *labels*. The
labels are resolved to ids IMMEDIATELY (at construction, while the labels are
freshly valid) and the situation stores the resolved ids. This is essential:
the global label->id map is time-varying and shared, so resolving a role label
later (e.g. in another enumerated variant's run) would be unsound; capturing
the id at setup time makes each situation resolve its roles against the file it
was built with, independent of the global map's later state.
The situation also carries:
:applied - ordered vector of operation ids, in application order
(so the full sequence is always recoverable from the situation)
:node-data - map of operation-id -> the record that operation
wrote about its own application (keyed by NODE IDENTITY, not by
a node-kind tag), so each node retrieves its own record."
"A situation for `file`, with `roles` (role key -> shape label) resolved to
ids at once: the label map changes from variant to variant, so a role keeps
the id of the file it was built with. `:applied` holds the ids of the
applied operations in order, `:node-data` what each recorded about its
application."
([file] (make-situation file {}))
([file roles]
{:file file
@ -85,20 +52,15 @@
(:file situation))
(defn with-file
"Return a situation with its file value replaced (the threaded result of
applying a transformation through the production change pipeline)."
"`situation` with its file replaced by `file'`."
[situation file']
(assoc situation :file file'))
(defn with-aux-files
"Return a situation carrying AUXILIARY files (a map of file-id -> file value)
beyond the primary `:file`. Used by cross-file configurations (e.g. a copy in
the primary/current file whose main lives in a linked LIBRARY file): the
primary `:file` stays the current file the role accessors resolve against,
while the auxiliary files travel alongside so an interpreter can install them
too (e.g. into the frontend store's `:files`, so cross-file sync can run).
The primary file is NOT included here."
"`situation` with auxiliary files (file id -> file), such as a linked
library, besides its current file. Roles resolve against the current file;
an interpreter installs the auxiliary ones next to it."
[situation files-by-id]
(assoc situation :aux-files files-by-id))
@ -108,14 +70,10 @@
[situation]
(get situation :aux-files {}))
;; ----- Node identity (central, no inheritance) -----------------------------
;; ----- Node identity -------------------------------------------------------
;;
;; Records are value-equal in Clojure, so two structurally-identical nodes would
;; collide as map keys. Each node therefore carries an explicit unique id under
;; the reserved key ::id, stamped at construction by `assign-id` (the single
;; thing every node constructor must call). The id machinery — stamping, and the
;; record/retrieve-by-id pair below — is implemented ONCE here and shared by all
;; nodes as plain functions; nodes never reimplement it, they just pass `this`.
;; Records with equal fields are equal, so every node constructor stamps a
;; unique id under ::id with `assign-id`; what a node records is keyed by it.
(defn assign-id
"Stamp a fresh unique id onto a node record (reserved key ::id). Every node
@ -131,9 +89,8 @@
;; ----- Self-description, keyed by node identity ----------------------------
(defn- node-kind
"A short readable kind name for a node, derived from its record type (no
per-node boilerplate, faithful to the actual type). E.g. a ChangeAttr record
yields \"change-attr\"."
"The kebab-case name of a node's record type: a ChangeProperty record
yields \"change-property\"."
[node]
(let [cls (or #?(:clj (some-> ^Class (type node) .getSimpleName)
:cljs (some-> node type .-name (str/split #"\.") last))
@ -145,44 +102,30 @@
kebab))
(defn record-application
"Record what an operation `node` did into `situation`, keyed by the node's
identity, and append its id to the ordered :applied sequence. `record` is an
arbitrary map describing the application; the node retrieves it later via
`node-data` by passing itself. The node's kind (from its type) is merged in
under ::kind so the application can be rendered (see `describe-applied`)
without the node needing to name itself. Both consumers (inspection methods,
undo) read through node identity and ignore the extra ::kind key."
"Record in `situation` that `node` was applied, with `record`, a map of what
it did, under its identity (read back with `node-data`). The node's kind
goes in under ::kind for `describe-applied`."
[situation node record]
(-> situation
(update :applied conj (node-id node))
(assoc-in [:node-data (node-id node)] (assoc record ::kind (node-kind node)))))
(defn node-data
"The record that `node` wrote about its own application in `situation`, or nil
if it has not been applied. Keyed by node identity."
"What `node` recorded about its application in `situation`, or nil when it
was not applied."
[situation node]
(get-in situation [:node-data (node-id node)]))
(defn applied-ids
"The ordered vector of operation ids applied to the situation (the full
sequence, recoverable from the situation)."
[situation]
(:applied situation))
(defn applied?
"Whether `operation` ran in this situation. Identity-based: true iff this exact
operation node (by its `::id`) recorded an application. Works through `optional`
/ `one-of`: a chosen alternative records itself under its own identity, so
querying with the raw operation answers correctly. Bind an operation to a value
ONCE and reuse it (in the composition AND in any `Test` that queries it), so the
id you ask about is the id that ran."
"Whether this exact `operation` node ran in `situation`, also when it was
the chosen alternative of a `one-of` or `optional`. Bind an operation to a
value once and use that value both in the composition and in the query."
[situation operation]
(contains? (:node-data situation) (node-id operation)))
(defn- render-application
"Render one (non-choice) application record as a short human-readable string.
Content-agnostic: uses ::kind and the record's own fields."
"One application record (not a choice) as a short readable line."
[record]
(let [kind (::kind record)
args (dissoc record ::kind)]
@ -195,22 +138,17 @@
(some-> (node-data situation node) render-application))
(defn describe-applied
"A human-readable, ordered transcript of the operations that produced
`situation` — one line per application, in order. Built purely from the
situation's recorded :applied ids and :node-data records (each node's own
self-description), so it is faithful to what actually ran, including the branch
a one-of chose. Used to label failures with the exact sequence at hand."
"The transcript of the operations that produced `situation`, one line per
application in order, including the branch each one-of chose. Failures
are labelled with it."
[situation]
(let [node-data (:node-data situation)]
(->> (:applied situation)
(keep (fn [id]
(let [record (get node-data id)]
(if (contains? record :chosen)
;; a one-of's choice record: if the chosen node recorded its
;; own application, its own line (also in :applied) already
;; tells the story — emit nothing to avoid a duplicate line.
;; Only a non-recording choice (a skipped `optional`) is
;; rendered here, so a skip stays visible in the transcript.
;; a choice gets a line only when the chosen node has none
;; of its own, such as a skipped `optional`
(let [chosen (:chosen record)]
(when-not (contains? node-data (::id chosen))
(str "one-of -> " (render-application {::kind (node-kind chosen)}))))
@ -218,18 +156,10 @@
(str/join "\n "))))
;; ----- Role accessors ------------------------------------------------------
;;
;; A setup records role bindings (meaningful named objects of the configuration)
;; as shape labels. `role-shape` resolves a role to the live shape in the current
;; file, with strict presence: an absent role throws diagnostically (never nil).
;; Specific named accessors (e.g. copy-instance) are thin wrappers, so tests read
;; `(copy-instance situation)` rather than knowing the role key.
(defn role-shape
"Resolve role `role-key` to the live shape in the situation's current file,
using the id captured at setup time. Throws a diagnostic error if the role is
not bound, or if its captured shape is no longer present in the current page
(e.g. it was deleted) — never returns nil silently."
"The live shape of role `role-key` in the situation's current page. Throws
when the role is not bound or its shape is not in the page."
[situation role-key]
(let [id (get-in situation [:roles role-key])
page (thf/current-page (file situation))]
@ -254,9 +184,7 @@
(contains? (:roles situation) role-key))
(defn shape-by-id
"The live shape with `id` in the situation's current page (nil if absent). For
reading a shape whose id is held outside the role map — e.g. a field of a
tracked component object."
"The live shape with `id` in the situation's current page, or nil."
[situation id]
(ctst/get-shape (thf/current-page (file situation)) id))
@ -281,53 +209,26 @@
:role role-key
:id id})))))
(defn rebind-role
"Re-point `role-key` to the current id of shape `label` (resolved via the global
label map now, while it is valid). Used by state-building operations that move
the configuration (e.g. `make-nested-component`) and must update where a role points so
that role-targeted operations keep acting on the intended shape."
[situation role-key label]
(assoc-in situation [:roles role-key] (thi/id label)))
(defn rebind-role-id
"Like `rebind-role`, but re-points `role-key` to a shape `id` directly (when the
operation discovered the shape by id, e.g. by following a :shape-ref chain,
rather than by label)."
[situation role-key id]
(assoc-in situation [:roles role-key] id))
;; ---------------------------------------------------------------------------
;; Situation vars — arbitrary named values beyond roles
;;
;; Roles name SHAPES (resolved from labels to ids). Some operations need to track
;; named values that are NOT shapes — e.g. a component id to instantiate next, or
;; a counter (nesting depth). Those live in a separate `:vars` map so they do not
;; get confused with shape roles. Set/read with `set-var`/`get-var`.
;; Situation vars: named values that are not shapes, such as a component id
;; or a nesting count.
;; ---------------------------------------------------------------------------
(defn set-var
"Associate `k` with `v` in the situation's `:vars` (arbitrary named values that
are NOT shapes — e.g. a component id, a counter). Returns the situation."
"`situation` with var `k` set to `v`."
[situation k v]
(assoc-in situation [:vars k] v))
(defn get-var
"Read the value of `k` from the situation's `:vars`, or `default` (nil if
omitted) when absent. See `set-var`."
"The value of var `k` in `situation`, or `default`."
([situation k] (get-var situation k nil))
([situation k default] (get-in situation [:vars k] default)))
(defn target-shape-id
"Resolve an operation's target to a shape id:
- a FUNCTION `(situation -> id)` is called with the situation (lets the target
be computed from situation state — e.g. a field of a tracked object —
resolved at apply-time so it follows state changes);
- a currently-bound ROLE resolves via the role (so the operation follows the
role as state-building ops re-point it);
- otherwise `target` is a label (strict-presence).
This is what makes a single operation composable across depth / with
make-nested-component et al."
"The shape id an operation's `target` names, resolved when the operation
applies: a `(situation -> id)` fn is called, a bound role gives its shape,
anything else is a label (strict presence)."
[situation target]
(cond
(fn? target) (target situation)
@ -335,20 +236,13 @@
:else (resolve-shape-id situation target)))
;; ---------------------------------------------------------------------------
;; Strict-presence lookup
;;
;; Resolving a binding name (shape label) that is absent must throw a DIAGNOSTIC
;; error: it names the absent binding and lists those present. A silently-nil
;; lookup is forbidden (it would make a declarative case a lie / a green test
;; that asserts against nothing). Acting on a present-but-wrong-kind binding is
;; left to crash naturally downstream.
;; Strict-presence lookup: an absent label throws, naming the labels present,
;; so a case never asserts against nil.
;; ---------------------------------------------------------------------------
(defn resolve-shape
"Resolve a shape binding name (label) to the actual shape in the situation's
current page, throwing a diagnostic error if the name is not bound to a shape
that exists in that page. The diagnostic lists the labels of the shapes that
ARE present, derived from the file itself (not from a parallel binding map)."
"The shape labelled `name` in the situation's current page. Throws, listing
the labels present, when there is none."
[situation name]
(let [the-file (file situation)
page (thf/current-page the-file)
@ -367,72 +261,41 @@
shape))
(defn resolve-shape-id
"Resolve a shape binding name (label) to its uuid, with strict-presence
diagnostics (see `resolve-shape`)."
"The id of the shape labelled `name` (see `resolve-shape`)."
[situation name]
(:id (resolve-shape situation name)))
;; ---------------------------------------------------------------------------
;; Operation protocol
;;
;; An OPERATION is a step in a composition. Most operations TRANSFORM the
;; situation (an edit, a structural change, a nesting), but some do not (a `Test`
;; asserts and returns the situation unchanged; `Skip` is a no-op) — hence the
;; genus is "operation", not "transformation". An operation is reified as DATA (a
;; record), not a bare function, so it is printable and navigable. `apply-to`
;; takes the operation and a situation and returns a (possibly identical)
;; situation; it may also record its own application. The method cannot be named
;; `apply` (core clash).
;; Operation protocol: a step of a composition, as a record so it prints.
;; `apply-to` returns the situation after it, recording its application.
;; ---------------------------------------------------------------------------
(defprotocol IOperation
(apply-to [operation situation]
"Apply this operation to `situation`, returning a (possibly identical)
situation."))
"`situation` after this operation."))
;; ---------------------------------------------------------------------------
;; Enumeration
;;
;; A composed operation may stand for MANY concrete cases (because `one-of`
;; offers alternatives). Enumeration turns one composed operation into the
;; sequence of fully-concrete operations it represents — each of which has
;; no remaining choice and can be `apply-to`'d directly.
;;
;; Enumeration is a generic-engine concern: only the composition operators
;; (`in-sequence`, `one-of`) implement it. Leaf/subject operations (e.g. the
;; component nodes) need not know about it — the top-level `enumerate` falls back
;; to "an operation with no choice enumerates to itself", so a plain node yields a
;; single variant (itself). This keeps `apply-to` and `enumerate` orthogonal and
;; keeps the `comp` node library free of enumeration code.
;; Enumeration: a composed operation stands for one concrete operation per
;; combination of its choices. Only the operators implement `IEnumerable`; any
;; other operation enumerates to itself.
;; ---------------------------------------------------------------------------
(defprotocol IEnumerable
(-enumerate [operation]
"Return a sequence of fully-concrete operations this one represents."))
"The concrete operations, with no choice left, this one stands for."))
(defn enumerate
"The concrete operations represented by `operation`. Falls back to a single
variant (the operation itself) for anything that does not implement
IEnumerable (i.e. leaf operations with no internal choice)."
"The concrete operations `operation` stands for."
[operation]
(if (satisfies? IEnumerable operation)
(-enumerate operation)
[operation]))
;; ---------------------------------------------------------------------------
;; Composition operator: sequence
;;
;; A `Sequence` holds an ordered vector of child operations and applies them
;; left-to-right, THREADING the situation through each: the situation returned
;; by one child is the input to the next. Operations do not commute, so order
;; is explicit. Its enumeration is the CARTESIAN PRODUCT of its children's
;; variants (with single-variant children this is exactly one Sequence), which
;; is what makes a `one-of`/`optional` composed inside a sequence multiply the
;; case out into a matrix.
;;
;; The constructor is named `in-sequence` because `sequence` is a clojure.core
;; name and must not be shadowed.
;; Sequence: applies its steps in order, threading the situation. It
;; enumerates to the cartesian product of its steps' variants, which is what
;; multiplies a case out into a matrix. (`sequence` is a core name, hence
;; `in-sequence`.)
;; ---------------------------------------------------------------------------
(declare ->Sequence)
@ -446,45 +309,30 @@
IEnumerable
(-enumerate [_]
;; Cartesian product: every combination of one concrete variant per step,
;; each combination rewrapped as a concrete Sequence. With single-variant
;; steps this yields exactly one Sequence (the all-singletons case).
(->> steps
(map enumerate) ; step -> seq of concrete variants
(map enumerate)
(reduce (fn [acc step-variants]
(for [combo acc
variant step-variants]
(conj combo variant)))
[[]]) ; seed: one empty combination
[[]])
(map ->Sequence))))
(defn in-sequence
"Constructor for the sequence operator: apply `steps` (a seq of
transformations) in order, threading the situation through each."
"Constructor for the sequence operator: apply `steps` in order."
[steps]
(->Sequence (vec steps)))
;; ---------------------------------------------------------------------------
;; Composition operator: one-of
;;
;; `one-of` offers a set of alternative transformations: it represents N cases,
;; one per alternative. It is a pure *enumeration* construct — it has no single
;; apply semantics, because applying it would mean arbitrarily picking one
;; alternative. So `apply-to` on a raw OneOf is an error; it must be enumerated
;; first (the runner does this). Its `-enumerate` is the UNION of its
;; alternatives' enumerations, so `one-of` composed inside `in-sequence`
;; multiplies out correctly via the sequence's cartesian product.
;; One-of: one case per alternative. It cannot be applied, only enumerated:
;; each variant is a `RecordedChoice` that records which alternative ran.
;; ---------------------------------------------------------------------------
(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
;; that alternative. This is how `get-choice` (read by the test holding the
;; one-of) recovers the choice from the resulting situation. It is already
;; concrete, so it enumerates to itself.
;; A variant of a one-of: records the choice under the one-of's identity
;; (see `get-choice`), then applies the chosen operation.
IOperation
(apply-to [this situation]
(->> (record-choice situation this)
@ -503,22 +351,16 @@
IEnumerable
(-enumerate [this]
;; Each alternative may itself enumerate to several concrete variants; every
;; resulting concrete variant is wrapped so that, when applied, it records
;; this one-of's choice under this one-of's identity.
(for [alt alternatives
variant (enumerate alt)]
(->RecordedChoice (node-id this) variant))))
(defn one-of
"Constructor for the one-of operator: represents one case per alternative in
`alternatives`. Used to sweep a set of variants (e.g. several attribute
changes) across an otherwise-shared case. Carries an identity so the choice it
made in a given enumerated run can be recovered via `get-choice`."
"Constructor for the one-of operator: one case per alternative of
`alternatives`. Ask it which one ran with `get-choice`."
[alternatives]
(assign-id (->OneOf (vec alternatives))))
(defrecord Skip []
IOperation
(apply-to [_ situation] situation)
@ -526,18 +368,12 @@
(-enumerate [self] [self]))
(defn skip
"The identity operation: applies as a no-op, enumerates to itself. The building
block of `optional`."
"The operation that changes nothing."
[]
(->Skip))
(defrecord Test [assert-fn]
;; An operation that makes ASSERTIONS at this point in the sequence and leaves
;; the situation unchanged. `assert-fn` is a (situation -> any) that performs the
;; assertions itself (e.g. calls `t/is`), exactly like an external asserter — so
;; checks can be placed at INTERMEDIATE steps, not only at the end. It records
;; its application (so the transcript shows where checkpoints sit) but changes
;; nothing. Concrete, so it enumerates to itself.
;; Runs assertions at its point of the sequence and changes nothing.
IOperation
(apply-to [this situation]
(assert-fn situation)
@ -546,60 +382,37 @@
(-enumerate [self] [self]))
(defn test-that
"Constructor for an inline `Test` operation. `assert-fn` is a (situation -> any)
that performs assertions (it is run for side effects; its return is ignored).
Place it inside an `in-sequence` to assert at that point in the trajectory.
Typically queries `applied?`/`get-choice`/`has-property-of` to decide what to
assert for the current enumerated variant."
"Constructor for an inline assertion: `assert-fn` (situation -> any) runs
its assertions at this point of the sequence."
[assert-fn]
(assign-id (->Test assert-fn)))
(defn optional
"`(optional t)` = `(one-of [t (skip)])`: sweeps WITH and WITHOUT `t` across a
case (two enumerated variants). Kept as its own named constructor for
readability. The workhorse for adding a state-building step (e.g.
`(optional (make-nested-component))`) as an axis over an existing case."
"`(one-of [t (skip)])`: the case with and without `t`."
[t]
(one-of [t (skip)]))
(defn get-choice
"The alternative this `one-of` chose in `situation` (the concrete transformation
that actually ran for this branch), or nil if it did not run in this variant.
Recovered by node identity, so the test holds the one-of and asks it."
"The alternative `one-of` chose in `situation`, or nil when it did not run."
[situation one-of]
(:chosen (node-data situation one-of)))
;; ---------------------------------------------------------------------------
;; Executors
;;
;; Build a fresh situation from a setup thunk and apply a (possibly composed)
;; OPERATION. `run-variant` runs one already-concrete variant; `run-all`
;; enumerates a composed operation and runs every variant. Neither makes a
;; judgment or touches clojure.test — `check` (in
;; `frontend-tests.composable-tests.interpreter`) is the test-facing entry point. (Assertions can also live INSIDE the operation, via
;; `Test`; those fire as the operation is applied.)
;; Plain runners: apply operations only, with no sync, undo or judgment. The
;; component cases run through `comp.runner` or the frontend interpreter.
;; ---------------------------------------------------------------------------
(defn run-variant
"Run one concrete (already-enumerated) variant: build a fresh situation via
`setup` (a 0-arg fn returning a *situation*) and apply `operation`,
returning the resulting situation. Makes no judgment. Exceptions propagate.
This is the per-variant step `check` builds on; tests use `check`, not this."
"The situation after applying the concrete `operation` to a fresh one from
`setup`."
[{:keys [setup operation]}]
(->> (setup)
(apply-to operation)))
(defn run-all
"Enumerate `operation` into its concrete variants and run each (fresh setup
per variant, isolated label space — the id map is reset before each variant's
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.
`run-variant-fn` runs one variant from `{:setup :operation}` (default
`run-variant`); other runners pass their own."
"The resulting situations of every variant of `operation`, in order, each
run by `run-variant-fn` (default `run-variant`) on `{:setup :operation}`
with a fresh label map."
([case-map] (run-all case-map run-variant))
([{:keys [setup operation]} run-variant-fn]
(->> (enumerate operation)
@ -608,18 +421,10 @@
(run-variant-fn {:setup setup
:operation variant}))))))
(defn sequence-ops
"Flatten a CONCRETE (already-enumerated) operation into its ordered units.
Used by alternative interpreters (e.g. the frontend one) that dispatch
per-operation effects rather than calling `apply-to`.
A concrete variant is a single operation record, or a `Sequence` of them, with
`RecordedChoice` (the enumerated form of a one-of) appearing where a one-of was.
`Sequence` is flattened; a `RecordedChoice` is KEPT as a unit (it carries both
the chosen operation and the one-of identity, so a per-op interpreter can
dispatch the chosen op's effect AND record the choice for `get-choice`). Use
`recorded-choice?`, `choice-of`, and `choice-one-of-id` to handle those units."
"The steps of the concrete `variant`, in order, with sequences flattened. A
`RecordedChoice` stays one step, so an interpreter can record the choice
(`record-choice`) and run the chosen operation (`choice-of`)."
[variant]
(cond
(instance? Sequence variant)
@ -629,12 +434,12 @@
[variant]))
(defn sequence?
"True if `op` is a `Sequence`; its ordered steps are under `:steps`."
"Whether `op` is a `Sequence`; its steps are under `:steps`."
[op]
(instance? Sequence op))
(defn recorded-choice?
"True if `op` is a one-of's enumerated choice wrapper."
"Whether `op` is a `RecordedChoice`, a variant of a one-of."
[op]
(instance? RecordedChoice op))
@ -644,15 +449,13 @@
(:chosen recorded-choice))
(defn choice-one-of-id
"The identity of the one-of that produced this `RecordedChoice` (so a per-op
interpreter can record the choice under it, enabling `get-choice`)."
"The identity of the one-of a `RecordedChoice` comes from."
[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."
one-of's identity, for `get-choice`."
[situation recorded-choice]
(-> situation
(assoc-in [:node-data (choice-one-of-id recorded-choice)]
@ -660,12 +463,8 @@
(update :applied conj (choice-one-of-id recorded-choice))))
;; ---------------------------------------------------------------------------
;; Known failures
;;
;; A case assertion that a known bug breaks stays in the case as a strict
;; expected failure: it pins the wrong value the bug gives, so the case fails
;; when the failure changes or stops. Only the commit that fixes the bug
;; turns it back into a plain assertion.
;; Known failures: an assertion a known bug breaks pins the wrong value the
;; bug gives, so the case fails when the failure changes or stops.
;; ---------------------------------------------------------------------------
(defn known-failure

30
common/src/app/common/test_helpers/compositions.cljc
View File

@ -19,6 +19,7 @@
[app.common.test-helpers.shapes :as ths]
[app.common.types.container :as ctn]
[app.common.types.shape :as cts]
[app.common.types.shape.layout :as ctl]
[app.common.types.text :as txt]))
;; ----- File building
@ -83,6 +84,35 @@
(merge shape
child-params)))))
(defn add-grid-frame
[file frame-label & {:keys [] :as params}]
;; Generated shape tree:
;; :frame-label [:name Frame1 :layout :grid], with no rows, columns or cells
(add-frame file frame-label (merge {:layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {}}
params)))
(defn place-in-grid-columns
"Give the grid frame `frame-label` one row and `columns` flex columns, and
put each child of it in `labels-by-column` (1-based column -> label) in
the cell of that column."
[file frame-label columns labels-by-column]
(let [frame (reduce (fn [frame _] (ctl/add-grid-column frame {:type :flex :value 1}))
(ctl/add-grid-row (ths/get-shape file frame-label) {:type :flex :value 1})
(range columns))
cells (reduce-kv (fn [cells column label]
(let [[id _] (d/seek #(= column (:column (val %))) cells)]
(assoc-in cells [id :shapes] [(thi/id label)])))
(:layout-grid-cells frame)
labels-by-column)]
(-> file
(ths/update-shape frame-label :layout-grid-rows (:layout-grid-rows frame))
(ths/update-shape frame-label :layout-grid-columns (:layout-grid-columns frame))
(ths/update-shape frame-label :layout-grid-cells cells))))
(defn add-minimal-component
[file component-label root-label
& {:keys [component-params root-params]}]

46
common/test/common_tests/logic/composable_runner_test.cljc
View File

@ -20,7 +20,7 @@
(t/use-fixtures :each thi/test-fixture)
(def ^:private original "#abcdef")
(def ^:private original setup/labeled-fill)
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
@ -28,14 +28,6 @@
[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
@ -44,16 +36,6 @@
(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.
@ -190,13 +172,6 @@
(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
@ -320,7 +295,8 @@
(t/is (= original (level-fill situation m 0)))
(t/is (zero? (r/undo-depth situation)))))
;; A user operation whose undo changes put back a different fill.
;; A user operation that changes the opacity of the copy root and whose
;; undo changes also rename it.
(defrecord WrongUndoEdit []
n/IComponentOperation
(op-kind [_] :user)
@ -348,7 +324,7 @@
(tm/record-application this {})))))
;; A user operation that changes the file with no undo changes.
(defrecord UndoableEdit []
(defrecord EditWithoutUndo []
n/IComponentOperation
(op-kind [_] :user)
@ -387,18 +363,20 @@
:operation (->WrongUndoEdit)})]
;; the redo leaves the wrong name in place, and so does the variant undo
(t/is (= [:undo :redo :variant-undo] (phases situation)))
(t/is (= (repeat 3 #{[:object :copy-root :name]})
(map :signature (uc/failures situation))))
(t/is (= {:name "Wrong"}
(-> (uc/failures situation) first :diff second :data :pages-index
vals first :objects (get :copy-root))))))
(t/deftest round-trip-reports-a-change-with-no-undo-entry
(let [situation (r/run-variant {:setup setup/simple-component-with-copy
:operation (->UndoableEdit)})]
:operation (->EditWithoutUndo)})]
(t/is (= [:no-undo-entry] (phases situation)))))
(t/deftest round-trip-can-be-turned-off
(let [situation (r/run-variant {:setup setup/simple-component-with-copy
:operation (->UndoableEdit)
:operation (->EditWithoutUndo)
:undo-check {:off "testing the switch"}})]
(t/is (empty? (uc/failures situation)))))
@ -416,14 +394,6 @@
(t/is (empty? (uc/failures situation)))
(t/is (= red (fill-of (tm/shape-by-id situation (n/lineage-rect situation m)))))))
(t/deftest failures-carry-what-differs
(let [situation (r/run-variant {:setup setup/simple-component-with-copy
:operation (->WrongUndoEdit)})]
(t/is (= [#{[:object :copy-root :name]}
#{[:object :copy-root :name]}
#{[:object :copy-root :name]}]
(mapv :signature (uc/failures situation))))))
(t/deftest signature-names-what-differs
(let [shape {:id (thi/new-id! :shape) :name "A" :opacity 1}
other {:id (thi/new-id! :other) :name "B"}

6
common/test/common_tests/logic/composable_sync_test.cljc
View File

@ -6,9 +6,9 @@
(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, and case X a pending frontend sync, so only the frontend interpreter
runs them."
JVM and in JS. The geometry cases (N, Z, AI and the rotation case) need
the frontend placement step and case X a pending frontend sync, 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]

32
common/test/common_tests/logic/variants_switch_target_test.cljc
View File

@ -10,6 +10,7 @@
[app.common.files.changes-builder :as pcb]
[app.common.logic.variants :as clv]
[app.common.test-helpers.components :as thc]
[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]
@ -105,32 +106,11 @@
:first in the first column and a copy :copy01 of :c01 in the third, so the
second cell is free."
[file]
(let [file (-> file
(ths/add-sample-shape :board
:type :frame
:layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {})
(ths/add-sample-shape :first :parent-label :board)
(thc/instantiate-component :c01 :copy01 :parent-label :board))
objects (:objects (thf/current-page file))
board (-> (get objects (thi/id :board))
(ctl/add-grid-row {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1}))
place (fn [cells column label]
(let [[id _] (d/seek #(= column (:column (val %))) cells)]
(assoc-in cells [id :shapes] [(thi/id label)])))
cells (-> (:layout-grid-cells board)
(place 1 :first)
(place 3 :copy01))]
(-> file
(ths/update-shape :board :layout-grid-rows (:layout-grid-rows board))
(ths/update-shape :board :layout-grid-columns (:layout-grid-columns board))
(ths/update-shape :board :layout-grid-cells cells))))
(-> file
(tho/add-grid-frame :board)
(ths/add-sample-shape :first :parent-label :board)
(thc/instantiate-component :c01 :copy01 :parent-label :board)
(tho/place-in-grid-columns :board 3 {1 :first 3 :copy01})))
(t/deftest swap-in-place-keeps-the-grid-cell
(let [file (-> (thf/sample-file :file1)

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

@ -184,8 +184,8 @@
'common-tests.logic.text-touched-test
'common-tests.logic.token-apply-test
'common-tests.logic.token-test
'common-tests.logic.variants-switch-test
'common-tests.logic.variants-switch-target-test
'common-tests.logic.variants-switch-test
'common-tests.logic.variants-test
'common-tests.math-test
'common-tests.media-test

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

@ -6,26 +6,14 @@
(ns frontend-tests.composable-tests.comp.sync-test
"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."
(`app.common.test-helpers.composable.comp.cases`) through the frontend
interpreter, where the app's component watcher syncs the copies."
(:require
[app.common.test-helpers.composable.comp.cases :as cases]
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.interpreter :as ftm]))
;; 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
;; (same guarantee the wasm-mock fixtures rely on), so the no-op covers the whole
;; async lifetime and is scoped to THIS namespace. See ftm/install-thumbnail-noop!.
(t/use-fixtures :each
{:before ftm/install-thumbnail-noop!
:after ftm/restore-thumbnail!})
(t/use-fixtures :each ftm/fixture)
(t/deftest case-b-copy-override-survives-later-main-change
(t/async done (ftm/check done (cases/copy-override-survives-later-main-change))))
@ -87,6 +75,9 @@
(t/deftest case-x-undo-before-sync-leaves-copies-unchanged
(t/async done (ftm/check done (cases/undo-before-sync-leaves-copies-unchanged))))
(t/deftest case-aj-reflow-after-nested-sync-is-its-own-undo-step
(t/async done (ftm/check done (cases/reflow-after-nested-sync-is-its-own-undo-step))))
(t/deftest case-y-text-override-merges-with-main-text-change
(t/async done (ftm/check done (cases/text-override-merges-with-main-text-change))))

73
frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs
View File

@ -11,16 +11,12 @@
down on purpose, so a step that resolved early would see a half-synced
file."
(: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.setups :as setup]
[app.common.test-helpers.composable.comp.undo-check :as uc]
[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.test-helpers.shapes :as ths]
[app.main.data.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.reflow :as wrf]
[app.main.data.workspace.shapes :as dwsh]
@ -32,13 +28,7 @@
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
;; The watcher schedules thumbnail renders that reach `window`, absent
;; headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(t/use-fixtures :each ftm/fixture)
(def ^:private original "#abcdef")
(def ^:private red "#ff0000")
@ -68,33 +58,11 @@
[_]
(rx/create (fn [_] nil)))
(defn- pause
[ms]
(js/Promise. (fn [resolve] (js/setTimeout resolve ms))))
(defn- fill-main-child
[color]
(dwsh/update-shapes #{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color color))))
(defn- fill-of
[label]
(-> (ths/get-shape (ftm/current-file) label) :fills first :fill-color))
(defn- raw-fill-commit
"A main child fill commit with `opts` merged into its params."
[opts]
(let [page (thf/current-page (ftm/current-file))
changes (cls/generate-update-shapes
(pcb/empty-changes nil (:id page))
#{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color red))
(:objects page)
{})]
(dch/commit-changes (merge {:redo-changes (:redo-changes changes)
:undo-changes (:undo-changes changes)}
opts))))
(t/deftest ^:async edit-step-waits-for-slow-sync
(let [sync-file dwl/sync-file]
(await
@ -102,36 +70,35 @@
{dwl/sync-file (deferred-sync-file sync-file slow-sync)}
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (= :settled (await (ftm/await-step [(fill-main-child red)]))))
(t/is (= red (fill-of :copy-child)))))))
(t/is (= red (ftm/fill-of :copy-child)))))))
(t/deftest ^:async undo-and-redo-steps-follow-a-slow-sync
;; Undo must find the slow sync already committed: it reverts the edit and
;; its sync together only when both are on the undo stack. The pause after
;; the undo step lets any work that outlived the edit step land.
;; its sync together only when both are on the undo stack.
(let [sync-file dwl/sync-file]
(await
(mock/with-mocks*
{dwl/sync-file (deferred-sync-file sync-file slow-sync)}
(ftm/install! (setup/simple-component-with-labeled-copy))
(await (ftm/await-step [(fill-main-child red)]))
(t/is (= red (ftm/fill-of :copy-child)) "the edit step ends synced")
(t/is (= :settled (await (ftm/await-step [dwu/undo]))))
(await (pause (* 2 sync-delay-ms)))
(t/is (= original (fill-of :main-child)))
(t/is (= original (fill-of :copy-child)))
(t/is (= original (ftm/fill-of :main-child)))
(t/is (= original (ftm/fill-of :copy-child)))
(t/is (= :settled (await (ftm/await-step [dwu/redo]))))
(t/is (= red (fill-of :main-child)))
(t/is (= red (fill-of :copy-child)))))))
(t/is (= red (ftm/fill-of :main-child)))
(t/is (= red (ftm/fill-of :copy-child)))))))
(defn- watch-touches
"Count the `touch-component` events emitted from now on. Returns
`[count-atom subscription]`."
"Collect the ids of the components that `touch-component` events touch from
now on. Returns `[ids-atom subscription]`."
[]
(let [touches (atom 0)
(let [touched (atom #{})
sub (rx/sub! (rx/filter (ptk/type? ::dwl/touch-component) st/stream)
(fn [_] (swap! touches inc)))]
[touches sub]))
(fn [event] (swap! touched into @event)))]
[touched sub]))
(t/deftest ^:async undo-and-redo-steps-wait-for-the-watcher
;; Undo and redo start no sync: the watcher only touches the component, a
@ -139,19 +106,21 @@
;; would finish before that touch.
(ftm/install! (setup/simple-component-with-labeled-copy))
(await (ftm/await-step [(fill-main-child red)]))
(let [[touches sub] (watch-touches)]
(let [component #{(thi/id :component1)}
[touched sub] (watch-touches)]
(t/is (= :settled (await (ftm/await-step [dwu/undo]))))
(t/is (= 1 @touches) "the undo step waited for the watcher")
(t/is (= component @touched) "the undo step waited for the watcher")
(reset! touched #{})
(t/is (= :settled (await (ftm/await-step [dwu/redo]))))
(t/is (= 2 @touches) "the redo step waited for the watcher")
(t/is (= component @touched) "the redo step waited for the watcher")
(rx/dispose! sub)))
(t/deftest ^:async dropped-commit-steps-settle
;; Translation and derived commits start no sync; their steps must still
;; resolve.
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (= :settled (await (ftm/await-step [(raw-fill-commit {:translation? true})]))))
(t/is (= :settled (await (ftm/await-step [(raw-fill-commit {:skip-component-sync? true})])))))
(t/is (= :settled (await (ftm/await-step [(ftm/fill-commit :main-child red {:translation? true})]))))
(t/is (= :settled (await (ftm/await-step [(ftm/fill-commit :main-child red {:skip-component-sync? true})])))))
(defn- run-endless-step
"Install a component whose sync never finishes and run a main edit step with
@ -174,7 +143,7 @@
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (empty? (wrf/pending)))
(t/is (= :settled (await (ftm/await-step [(fill-main-child red)]))))
(t/is (= red (fill-of :copy-child))))
(t/is (= red (ftm/fill-of :copy-child))))
(t/deftest skipped-optional-keeps-the-undo-baseline
;; The end-of-variant round trip undoes back to the last file install. A

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

@ -5,46 +5,24 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.interpreter
"FRONTEND interpreter + test-facing `check` for the composable test model.
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
workspace event(s) it dispatches (it depends on
`app.main.data.workspace.*`).
2. an ASYNC interpreter that drives a sequence of operations through the REAL
app: it installs the situation's file into the global store, starts the
real component-change watcher, then for each operation dispatches its
event(s) and AWAITS all pending work it caused (`await-step`: the
watcher's sync wait and layout/text reflow, so the app's AUTOMATIC
propagation — not a manual sync — is what runs), re-reading the file
from the store after each. A step that does not settle in time fails.
3. `check` — the test-facing entry: takes {:setup :operation} + an OPTIONAL
asserter; enumerates the operation and runs each variant; assertions may
be inline (`Test` ops) and/or in the asserter.
IN-FILE PROPAGATION IS AUTOMATIC: there is no propagate operation. The watcher
(`dwl/watch-component-changes`), running on the global store, detects
main-instance changes in the CURRENT file and syncs that file's copies on its
own. That automatic behaviour is precisely what the cases exercise. The one
deliberate exception is CROSS-FILE propagation (case H): when the main lives
in a linked LIBRARY and the copy in the consuming file, the watcher does NOT
cross the file boundary — the real app propagates via the library-UPDATE
action, so the `SyncFromLibrary` op explicitly dispatches `sync-file` (this is
faithful: it is exactly the user action, not a test shortcut). See
`mem:frontend/composable-component-tests`.
NOTE on the store: this uses the GLOBAL `st/state` store (not the isolated
`setup-store`), because the watcher reads `refs/workspace-data` which derives
from `st/state`. State is re-installed per variant for isolation."
"Runs composable component cases through the frontend (see
`mem:frontend/composable-component-tests`). It installs the situation's
files in the global store (the component watcher reads it through
`app.main.refs`), starts the workspace watchers, maps each user operation
to the workspace events a user action dispatches (`op->events`) and waits
for the work they cause (`await-step`). The app's own watcher syncs the
copies; only the library update of case H is an explicit `sync-file`, as
in the app. `check` is the test entry point."
(: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.undo-check :as uc]
[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]
[app.main.data.changes :as dch]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.reflow :as wrf]
@ -65,18 +43,8 @@
[potok.v2.core :as ptk]))
;; --------------------------------------------------------------------------
;; (0) Thumbnail rendering — disabled in this headless suite
;;
;; The propagation watcher we start (`dwl/watch-component-changes`) ALSO schedules
;; THUMBNAIL renders on every component change (its `component-changed` event has a
;; thumbnail branch). Thumbnail rendering reaches `app.util.dom/get-css-variable`,
;; which calls `window.getComputedStyle` — and there is no `window` in the headless
;; runner, so a (queued, async) render fires LATER and crashes the run. Thumbnails
;; are pure UI side-effect, irrelevant to what we test, so we stub the public seam
;; `dwth/update-thumbnail` to a no-op event for the duration of OUR tests (installed
;; / restored by a `:each` fixture in the case namespace — the same `set!`-and-
;; restore pattern as `frontend_tests.helpers.wasm`, whose `:after` correctly runs
;; only after each async test's `done`). Scope is thus our suite only.
;; Thumbnails: the component watcher renders them, which reaches `window`,
;; absent headless, so tests stub `dwth/update-thumbnail` (see `fixture`).
;; --------------------------------------------------------------------------
(defonce ^:private original-update-thumbnail (atom nil))
@ -102,70 +70,31 @@
(set! dwth/update-thumbnail orig)
(reset! original-update-thumbnail nil)))
;; --------------------------------------------------------------------------
;; (1) Frontend realisation of operations: op record -> workspace event(s)
;;
;; The operation's "what" (its update-fn / target) is shared in common; this maps
;; it to the "how" on the frontend — the real event a user interaction dispatches.
;; Returns a vector of events to emit for that operation.
;; --------------------------------------------------------------------------
(def fixture
"An `:each` fixture for tests that run the component watcher: a fresh label
map and no thumbnail rendering. Its `:after` runs after an async test's
`done`, so it covers the whole test."
{:before (fn []
(cthi/reset-idmap!)
(install-thumbnail-noop!))
:after restore-thumbnail!})
;; The edit a ChangeProperty performs is the SHARED `n/set-property`, so the
;; frontend applies the identical change the common node does (only the wrapping
;; differs: a real workspace event here vs. apply-changes there).
(defn- add-child->shape
"Build the shape value AddChild introduces, parented under the target parent in
the current store page (mirrors the common add-child's sample shape). Returns
the shape with parent/frame set to the target parent."
[parent-label new-label shape-params]
(let [parent-id (cthi/id parent-label)
shape (cths/sample-shape new-label (or shape-params {}))]
(assoc shape
:parent-id parent-id
:frame-id parent-id)))
;; --------------------------------------------------------------------------
;; Operations as workspace events
;; --------------------------------------------------------------------------
(defn op->events
"Map a comp operation record to the real workspace event(s) it dispatches.
`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.
Each operation is realised with the SAME production change builder the common
node uses, but wrapped in the real workspace event (so it commits to the store
and the watcher auto-propagates):
ChangeProperty -> update-shapes (generate-update-shapes; n/set-property)
EditText -> v2-update-text-shape-content (n/edit-text-content)
MoveShape -> update-position (sidebar, page coordinates)
MoveChild -> relocate-shapes (generate-relocate, existing shape)
AddChild -> add-shape (create a shape under the parent)
RemoveChild -> delete-shapes (generate-delete-shapes)
Detach -> detach-component (generate-detach-component)
UpdateMain -> update-component-sync (generate-sync-shape-inverse)
DeleteComponent -> delete-component (generate-delete-shapes on the main)
RestoreComponent -> restore-component (generate-restore-component)
Duplicate -> duplicate-shapes (generate-duplicate-changes)
NestCopy -> relocate-shapes (generate-relocate into a main)
SwapShape -> component-swap (any copy head)
MoveToCell -> update-shapes on the grid board (n/move-to-cell-fn)
SyncFromLibrary -> sync-file (the cross-file library-update action, H)
Undo -> dwu/undo (reverse the previous operation(s), I)
Redo -> dwu/redo (apply the undone operation(s) again)
UndoBeforeSync -> update-shapes + dwu/undo, emitted together
(In-file propagation is automatic — the watcher — so no propagate op exists.)"
"The workspace events a user action dispatches for the comp operation `op`,
built from `situation` and from the same helpers the common node uses."
[op situation]
(cond
(instance? n/ChangeProperty op)
(let [{:keys [target property value]} op]
;; `target` may be a ROLE (resolved via the situation, so the edit follows
;; the role as make-nested-component re-points it) or a label — same dual resolution
;; as the common ChangeProperty. The edit uses the SHARED `n/set-property`.
[(dwsh/update-shapes #{(tm/target-shape-id situation target)}
(fn [shape] (n/set-property shape property value)))])
(instance? n/EditText op)
;; The commit the text editor makes when the edit ends (on blur), SVG
;; renderer path.
;; the text editor's commit on blur, SVG renderer path
(let [{:keys [target edit value]} op
id (tm/target-shape-id situation target)
shape (tm/shape-by-id situation id)
@ -178,37 +107,22 @@
:original-content (:content shape))])
(instance? n/Rotate op)
;; The real sidebar rotation event, absolute mode: rotates the shape (and its
;; whole subtree) around its center. Its apply-modifiers step runs the
;; placement-vs-override classification for component copies (check-delta),
;; which is part of what a case using `rotate` exercises.
;; the sidebar rotation, which decides what it touches in copies (check-delta)
(let [{:keys [target angle]} op]
[(dwt/increase-rotation [(tm/target-shape-id situation target)] angle)])
(instance? n/MoveShape op)
;; The real sidebar position event, in page coordinates.
;; the sidebar position, in page coordinates
(let [{:keys [target dx dy]} op
id (tm/target-shape-id situation target)
{:keys [x y]} (:selrect (tm/shape-by-id situation id))]
[(dwt/update-position id {:x (+ x dx) :y (+ y dy)} {:absolute? true})])
(instance? n/ChangeHeight op)
;; The real sidebar dimension event.
;; the sidebar height
(let [{:keys [target value]} op]
[(dwt/update-dimensions [(tm/target-shape-id situation target)] :height value)])
(instance? n/SwapComponent op)
;; Swap lineage `name`'s nesting level `level` for lineage `target`'s component
;; via the REAL swap event (dwl/component-swap), so it commits through the
;; normal path and the watcher AUTOMATICALLY propagates the swap to copies
;; (incl. the deeper nesting levels). This is the behaviour under test.
(let [{:keys [name level target keep-touched?]} op
file-id (:id (tm/file situation))
nested (n/lineage-nesting situation name level)
shape (tm/shape-by-id situation (:nested-head nested))
target-id (n/lineage-component-id situation target)]
[(dwl/component-swap shape file-id target-id (boolean keep-touched?))])
(instance? n/SwapShape op)
(let [{:keys [target to keep-touched?]} op]
[(dwl/component-swap (tm/shape-by-id situation (tm/target-shape-id situation target))
@ -217,20 +131,13 @@
(boolean keep-touched?))])
(instance? n/MoveToCell op)
;; The board's new cells, as the commit of a canvas drop into the cell.
;; the board's new cells, as a canvas drop commits them
(let [{:keys [board child row column]} op]
[(dwsh/update-shapes #{(tm/target-shape-id situation board)}
(n/move-to-cell-fn (tm/target-shape-id situation child) row column)
{:with-objects? true})])
(instance? n/SwitchVariant op)
;; The variant-switch action: switch the resolved variant copy head to the
;; sibling member whose selector property (pos 0) has `value`, via the REAL
;; `variants-switch` event (which discovers the sibling in the variant container
;; and routes through component-swap keep-touched? true, so the watcher
;; auto-propagates the switch across nesting levels exactly like a swap). `target`
;; uses the standard resolution (role | label | (situation -> id) fn), so the op
;; is structure-blind.
(let [{:keys [target value]} op
head-id (tm/target-shape-id situation target)
shape (tm/shape-by-id situation head-id)]
@ -263,40 +170,34 @@
(instance? n/MoveChild op)
(let [{:keys [target parent to-index]} op]
[(dwsh/relocate-shapes #{(cthi/id target)} (cthi/id parent) to-index)])
[(dwsh/relocate-shapes #{(tm/resolve-shape-id situation target)}
(tm/resolve-shape-id situation parent)
to-index)])
(instance? n/RemoveChild op)
(let [{:keys [target]} op]
[(dwsh/delete-shapes #{(cthi/id target)})])
[(dwsh/delete-shapes #{(tm/resolve-shape-id situation (:target op))})]
(instance? n/AddChild op)
(let [{:keys [parent new-label shape-params]} op]
[(dwsh/add-shape (add-child->shape parent new-label shape-params)
(let [{:keys [parent new-label shape-params]} op
parent (tm/resolve-shape situation parent)]
[(dwsh/add-shape (n/child-shape parent new-label shape-params)
{:no-select? true})])
(instance? n/SyncFromLibrary op)
;; The cross-file library-update action: sync the current (consuming) file
;; from its linked library — exactly what the "library updated" dialog does.
(let [file-id (:current-file-id @st/state)
library-id (first (keys (tm/aux-files situation)))]
[(dwl/sync-file file-id library-id)])
;; the library update the "library updated" dialog runs
[(dwl/sync-file (:current-file-id @st/state) (n/library-id situation))]
(instance? n/Undo op)
;; Reverse the previous operation(s) via the real undo event, once per
;; operation to undo. The workspace undo stack was maintained automatically
;; by the prior ops' commits.
(vec (repeat (:times op) dwu/undo))
(instance? n/UndoBeforeSync op)
;; The edit and the undo go out together, so the undo commits before the
;; watcher inspects the edit's commit.
;; emitted together, so the undo commits before the watcher inspects the edit
(let [{:keys [target property value]} op]
[(dwsh/update-shapes #{(tm/target-shape-id situation target)}
(fn [shape] (n/set-property shape property value)))
dwu/undo])
(instance? n/Redo op)
;; Apply again the latest undone operation(s) via the real redo event.
[dwu/redo]
:else
@ -304,19 +205,16 @@
{:op op}))))
;; --------------------------------------------------------------------------
;; (2) Async interpreter
;; Interpreter
;; --------------------------------------------------------------------------
;; Longest a step may take to settle; a step that takes longer fails.
(def ^:private step-timeout-ms 2000)
(defn- install-situation-event
"An UpdateEvent installing the situation's files into the (global) store: the
primary file as the current/workspace file, plus any AUXILIARY files (e.g. a
linked library, for the cross-file case H) alongside in `:files`, each tagged
`:library-of` the current file so the library-sync machinery treats them as
linked libraries. The undo stack starts empty, so an undo never reaches the
previous variant's entries."
"An event that installs the situation's file as the current one, its
auxiliary files as linked libraries, and an empty undo stack, so an undo
never reaches the previous variant's entries."
[situation]
(let [file (tm/file situation)
aux (tm/aux-files situation)]
@ -333,20 +231,37 @@
aux))))))
(defn current-file
"Read the live workspace file out of the global store."
"The current file in the global store."
[]
(let [st @st/state]
(get-in st [:files (:current-file-id st)])))
(defn fill-of
"The fill color of the shape `label` in the live file."
[label]
(-> (cths/get-shape (current-file) label) :fills first :fill-color))
(defn fill-commit
"A commit that fills the shape `label` of the live file with `color`, with
`opts` merged into the commit params."
[label color opts]
(let [page (cthf/current-page (current-file))
changes (cls/generate-update-shapes
(pcb/empty-changes nil (:id page))
#{(cthi/id label)}
#(assoc % :fills (cths/sample-fills-color :fill-color color))
(:objects page)
{})]
(dch/commit-changes (merge {:redo-changes (:redo-changes changes)
:undo-changes (:undo-changes changes)}
opts))))
(defn await-step
"Emit `events` into the global store and return a promise that resolves with
`:settled` once every pending work has drained: component sync (the
watcher's wait for each commit and the sync it starts) and layout and text
reflow, as tracked by `app.main.data.workspace.reflow`. It waits the way the
plugin `waitForLayoutUpdate` does. When `timeout-ms` (default
`step-timeout-ms`) passes first, it resolves with `{:timeout pending}`, the
work still pending then. Relies on every producer opening its pending work
synchronously while the events are processed."
"Emit `events` and return a promise of `:settled` once the pending work of
`app.main.data.workspace.reflow` drains (component sync, layout and text
reflow), as the plugin `waitForLayoutUpdate` waits; or of
`{:timeout pending}` after `timeout-ms` (default `step-timeout-ms`). Work
must be opened while the events are processed."
([events] (await-step events step-timeout-ms))
([events timeout-ms]
(doseq [e events] (st/emit! e))
@ -375,12 +290,9 @@
situation))
(defn- record-op
"Record an operation's application onto the situation (after its effect settled),
re-reading the file from the store. The record is the op's own fields, plus
its `n/applied-result` when it has one. For a RecordedChoice (one-of), record
the choices first, under their one-of identities (so the asserter's
`get-choice` works), and then the chosen op's application, in the order
`RecordedChoice`'s own `apply-to` uses."
"`situation` with the live file and the application of the settled op unit
`op`: its choices first, then the op's own fields and its
`n/applied-result`, if any."
[situation op]
(let [before (tm/file situation)
situation (-> situation
@ -393,16 +305,13 @@
(tm/record-application situation op record)))
(defn- op-events
"The workspace events to dispatch for an op unit (a plain op or a one-of's
RecordedChoice — for the latter, the chosen op's events). `situation` provides
cross-file context to ops that need it."
"The workspace events of the op unit `op` (for a choice, of the chosen op)."
[op situation]
(op->events (unwrap op) situation))
(defn- install-file-event
"An UpdateEvent that replaces the current file in the (global) store with `file`
(keeping aux files and everything else). Used to write back the result of a
FILE-TRANSFORMING op (see `file-op?`)."
"An event that makes `file` the current file in the store, the result of a
`sync-op?` operation."
[file]
(ptk/reify ::install-file
ptk/UpdateEvent
@ -415,12 +324,10 @@
;; --------------------------------------------------------------------------
;; Undo/redo round trip (see `app.common.test-helpers.composable.comp.undo-check`)
;;
;; Run on every user step that goes through a real event: undo must give back
;; the file before the step and redo the file after it, each moving the
;; workspace undo index back to where it was, so a step adds exactly one undo
;; entry (or group). File installs (assembly steps and the reset, see
;; `sync-op?`) add no entry, so they are the baseline the end-of-variant round
;; trip undoes back to.
;; Run on every user step that dispatches events: undo gives back the file
;; and the undo index before the step, redo those after it, so a step adds
;; exactly one undo entry or group. File installs (`sync-op?`) add none and
;; are the baseline the end-of-variant round trip undoes back to.
;; --------------------------------------------------------------------------
(defn- undo-index
@ -515,35 +422,19 @@
(js/Promise.resolve situation))))
(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: 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)."
"Whether the op unit `op` runs its `apply-to` on the live file instead of
dispatching events: assembly nodes, the reset, `skip` and inline tests."
[op]
(let [op (unwrap 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)
;; a user operation, but the real reset event reads browser globals
(instance? n/ResetOverrides op))))
(defn- run-sync-op
"Apply a synchronous (`sync-op?`) operation: run its shared `apply-to` against a
situation whose `:file` is the live store file, write the resulting file back
into the store, and return the updated situation (with any re-pointed roles).
For `Test` this runs the inline assertion (against the live store state) and the
file is unchanged; for `make-nested-component`/`skip` it writes back the transformed file.
Synchronous."
"Run the `apply-to` of the `sync-op?` op unit `op` on the live file and
install the result. Returns the situation."
[situation op]
(let [situation (tm/with-file situation (current-file))
situation (tm/apply-to op situation)]
@ -557,14 +448,10 @@
(mark-baseline))))
(defn- run-ops
"Async fold over `ops` (concrete operation units, in order — plain ops and/or
one-of RecordedChoice wrappers). Threads the situation. A SYNCHRONOUS op
(`sync-op?` — file-transforming or an inline `Test`) is applied synchronously
via `apply-to`; every other op dispatches its real workspace event(s) and
awaits all pending work (`await-step`). The file is re-read from the store
after each. Calls `k` with the final situation, or with nil when a step did
not settle in time; that step fails the test, naming the work still
pending."
"Run the op units `ops` in order, each `sync-op?` one on the live file and
the others as events awaited with `await-step`. Calls `k` with the final
situation, or with nil after failing the test when a step did not
settle."
[situation ops k]
(if (empty? ops)
(k situation)
@ -602,14 +489,9 @@
(k nil)))))))))
(defonce ^:private original-store
;; Captured at namespace-LOAD time — i.e. before any test in the run executes.
;; Several test namespaces (the plugins suite) `set!` st/state / st/stream to
;; isolated stores and never restore them. That silently kills this harness:
;; the refs in `app.main.refs` (through which `watch-component-changes`
;; observes commits) are okulary lenses bound to THIS atom instance at load
;; time, so once the var points elsewhere, our events commit to a store the
;; watcher does not see and propagation dies with no error. Re-installing the
;; original per variant makes the harness immune to run order.
;; The store at load time. Some test namespaces `set!` st/state and
;; st/stream and never restore them, while the `app.main.refs` lenses the
;; component watcher reads stay bound to these atoms.
{:state st/state :stream st/stream})
(defn- restore-global-store!
@ -662,7 +544,7 @@
trip of each user step and of the variant. Calls `k` with the final
situation, or nil when a step did not settle."
[setup ops undo-check? k]
;; fresh label space per variant (mirrors the pure `tm/run-all`)
;; a fresh label map per variant, as `tm/run-all` does
(cthi/reset-idmap!)
(let [situation (-> (setup)
(assoc ::undo-check? undo-check?)
@ -676,31 +558,15 @@
(k situation))))))
;; --------------------------------------------------------------------------
;; (3) Test-facing check
;; Test entry point
;; --------------------------------------------------------------------------
(defn check
"Frontend `check`: run `case-map` ({:setup :operation}) through the REAL app and,
if `asserter` is given, apply it (a situation -> any fn performing assertions)
to the resulting situation of EACH enumerated variant. Async — `done` is the
cljs.test async callback and MUST be called when finished.
Each variant also runs the undo/redo round trip, asserted after the
asserter (see `app.common.test-helpers.composable.comp.undo-check`; the
case map's `:undo-check` turns it off or marks known failures).
Assertions may be INLINE (via `Test` operations in the `:operation` sequence,
firing as the op runs) and/or via the trailing `asserter`; `asserter` is
optional (omit when all assertions are inline). The asserter closes over node
references the test holds (e.g. `has-property-of` on a change node). In-file
propagation is AUTOMATIC (the watcher) — no propagate op is added.
Mocks are installed for the duration of the check: `rp/cmd!` returns
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)`, which takes the asserter from the case
map's `:asserter`, or `(check done case-map asserter)`."
"Run every variant of `case-map` through the frontend, apply `asserter`
(default the case map's `:asserter`) to each result and check its undo/redo
round trip (`app.common.test-helpers.composable.comp.undo-check`). Calls the
async test's `done` at the end. RPC calls are mocked and `rx/timer` fires
at once, for the delayed RPC of the library update."
([done case-map] (check done case-map (:asserter case-map)))
([done {:keys [setup operation] :as case-map} asserter]
(mock/with-mocks
@ -713,9 +579,6 @@
(inner-done)
(run-variant
setup
;; a variant is a composed operation; flatten to its ordered leaf
;; ops. `enumerate` already removed all one-of choices, so the
;; variant is a Sequence (or a single op).
(tm/sequence-ops (first vs))
(uc/enabled? case-map)
(fn [situation]

8
frontend/test/frontend_tests/data/changes_test.cljs
View File

@ -15,13 +15,7 @@
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.interpreter :as ftm]))
;; The component watcher schedules thumbnail renders that reach `window`,
;; absent headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(t/use-fixtures :each ftm/fixture)
(t/deftest change-without-page-leaves-the-pages-alone
(t/async done

8
frontend/test/frontend_tests/data/workspace_edit_watchers_test.cljs
View File

@ -18,13 +18,7 @@
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.interpreter :as ftm]))
;; The watcher schedules thumbnail renders that reach `window`, absent
;; headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(t/use-fixtures :each ftm/fixture)
(defn- undo-entries-for-an-edit
"Install a component with a copy, start the edit watchers `starts` times,

38
frontend/test/frontend_tests/data/workspace_sync_barrier_test.cljs
View File

@ -10,53 +10,21 @@
component, or drop the commit. Plugin `waitForLayoutUpdate` and the
composable interpreter rely on it."
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.main.data.changes :as dch]
[app.main.data.workspace.reflow :as wrf]
[app.main.store :as st]
[app.plugins.reflow :as pwrf]
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.interpreter :as ftm]))
;; The watcher schedules thumbnail renders that reach `window`, absent
;; headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(t/use-fixtures :each ftm/fixture)
(def ^:private red "#ff0000")
(defn- main-child-fill-commit
"A commit that sets the main child's fill to red, with `opts` merged into the
commit params."
[opts]
(let [file (ftm/current-file)
page (thf/current-page file)
changes (cls/generate-update-shapes
(pcb/empty-changes nil (:id page))
#{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color red))
(:objects page)
{})]
(dch/commit-changes (merge {:redo-changes (:redo-changes changes)
:undo-changes (:undo-changes changes)}
opts))))
(defn- sync-pending?
[file-id]
(contains? (get (wrf/pending) file-id) :sync-file))
(defn- fill-of
[label]
(-> (ths/get-shape (ftm/current-file) label) :fills first :fill-color))
(defn- run-commit
"Install a component with a copy and emit the main child fill commit with
`commit-opts`. Once the wait settles, call `check` with whether the sync
@ -65,7 +33,7 @@
[done commit-opts check]
(ftm/install! (setup/simple-component-with-labeled-copy))
(let [file-id (:id (ftm/current-file))]
(st/emit! (main-child-fill-commit commit-opts))
(st/emit! (ftm/fill-commit :main-child red commit-opts))
(let [open? (sync-pending? file-id)]
(-> (pwrf/wait-for-layout-update nil 2000)
(.then #(check open?)
@ -78,7 +46,7 @@
(run-commit done {}
(fn [open?]
(t/is open?)
(t/is (= red (fill-of :copy-child)))))))
(t/is (= red (ftm/fill-of :copy-child)))))))
(t/deftest undo-commit-holds-the-wait-until-the-watcher-handles-it
;; Undo and redo commit with `save-undo? false`. The watcher only touches

2
frontend/test/frontend_tests/runner.cljs
View File

@ -200,8 +200,8 @@
'frontend-tests.data.workspace-pages-test
'frontend-tests.data.workspace-path-edition-test
'frontend-tests.data.workspace-reflow-test
'frontend-tests.data.workspace-sync-barrier-test
'frontend-tests.data.workspace-shortcuts-test
'frontend-tests.data.workspace-sync-barrier-test
'frontend-tests.data.workspace-texts-test
'frontend-tests.data.workspace-thumbnails-test
'frontend-tests.data.workspace-versions-test

26
plugins/apps/composable-test-suite/src/composable-tests/cases/caseCopySwapSurvivesMainChanges.ts
View File

@ -1,4 +1,3 @@
import { LibraryComponent } from "@penpot/plugin-types";
import { TestCase } from "../test-suite/TestCase.ts";
import { Situation } from "../core/Situation";
import { Color } from "../model/Color";
@ -18,17 +17,6 @@ const RED = new Color("#ff0000"); // the component the copy swaps to
const GREEN = new Color("#00ff00"); // the component the main swaps to
const BLUE = new Color("#0000ff"); // remote edit
/** The main component of a nestable component's configuration. */
function componentOf(op: OpCreateNestableComponent<ContentCreationStrategyRectangle>) {
return (s: Situation): LibraryComponent => {
const component = s.get(op.roles.mainInstance).component();
if (component === null) {
throw new Error("the main instance has no component");
}
return component;
};
}
/**
* Case AA — a copy's swap survives changes to the main.
*
@ -63,9 +51,17 @@ export function createTestCaseCopySwapSurvivesMainChanges(): TestCase {
opCreateGreen,
opCreateComponent.createOpInstantiate(),
opCreateComponent.createOpMakeNested(),
new OpSwap(copyNested, componentOf(opCreateRed), "the copy's nested copy for the red component"),
new OpSwap(
copyNested,
(s) => opCreateRed.getMainComponent(s),
"the copy's nested copy for the red component"
),
new OpOptional(
new OpSwap(mainNested, componentOf(opCreateGreen), "the main's nested copy for the green component")
new OpSwap(
mainNested,
(s) => opCreateGreen.getMainComponent(s),
"the main's nested copy for the green component"
)
),
new OpOptional(
new OpChangeProperty(
@ -78,7 +74,7 @@ export function createTestCaseCopySwapSurvivesMainChanges(): TestCase {
new OpAssert("the copy's nested copy keeps its swap", (s) => {
const head = copyNested(s);
Assert.that(
head.component()?.id === componentOf(opCreateRed)(s).id,
head.component()?.id === opCreateRed.getMainComponent(s).id,
"the nested copy is a red instance"
);
fillColor.assertEqual(fillColor.read(opCreateComponent.contentCreator.getRectangle(head)), RED);

21
plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts
View File

@ -1,4 +1,3 @@
import { LibraryComponent } from "@penpot/plugin-types";
import { TestCase } from "../test-suite/TestCase.ts";
import { Situation } from "../core/Situation";
import { Color } from "../model/Color";
@ -21,9 +20,9 @@ const RED = new Color("#ff0000"); // the component the copy swaps to
*
* A copy of a component that nests another overrides its own root's opacity,
* swaps its nested copy for a third component, then resets the nested copy. The
* reset undoes the swap and must change nothing outside the nested copy; today it
* also clears the root's opacity override (F12 in the stabilization plan), which
* the case pins as a known failure.
* reset undoes the swap and must change nothing outside the nested copy. It also
* clears the root's opacity override (F12 in the stabilization plan), pinned as a
* known failure.
*/
export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
@ -33,13 +32,7 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase
const { copyInstance } = opCreateComponent.roles;
const copyNested = (s: Situation) => opCreateComponent.getNestedInstance(s, 1);
const redComponent = (s: Situation): LibraryComponent => {
const component = s.get(opCreateRed.roles.mainInstance).component();
if (component === null) {
throw new Error("the red main instance has no component");
}
return component;
};
const redComponent = (s: Situation) => opCreateRed.getMainComponent(s);
return new TestCase(
"ResetOfNestedSwapKeepsTopCopyOverrides",
@ -47,8 +40,8 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase
"another component with a red rectangle is created. A copy of the outer component " +
"lowers its own opacity, swaps its nested copy for the red component, and then resets " +
"the nested copy. The reset must undo the swap (the nested copy shows the original " +
"rectangle again) and leave the copy's own opacity override alone. Today the reset " +
"also clears that override (known failure F12).",
"rectangle again) and leave the copy's own opacity override alone. The reset also " +
"clears that override (known failure F12).",
new OpSequence(
opCreateComponent,
opCreateRed,
@ -64,9 +57,9 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase
// the reset clears the opacity, which the API then reads as null
Assert.knownFailure<number | null>(
"F12",
opacity.read(s.get(copyInstance)) ?? null,
0.5,
null,
opacity.read(s.get(copyInstance)) ?? null,
(a, b) => a === b
);
})

14
plugins/apps/composable-test-suite/src/composable-tests/operations/OpCreateNestableComponent.ts
View File

@ -1,4 +1,4 @@
import { Board, Shape } from "@penpot/plugin-types";
import { Board, LibraryComponent, Shape } from "@penpot/plugin-types";
import { Situation } from "../core/Situation";
import { Operation } from "../core/Operation";
import { Role } from "../core/Role";
@ -244,4 +244,16 @@ export class OpCreateNestableComponent<TContentCreator extends ContentCreationSt
}
return copy;
}
/**
* @param situation - the situation
* @return the component of the current main instance (the outermost one once nested)
*/
getMainComponent(situation: Situation): LibraryComponent {
const component = situation.get(this.roles.mainInstance).component();
if (component === null) {
throw new Error("the main instance has no component");
}
return component;
}
}

2
plugins/apps/composable-test-suite/src/composable-tests/util/Assert.ts
View File

@ -40,9 +40,9 @@ export class Assert {
*/
static knownFailure<T>(
bug: string,
actual: T,
expected: T,
pinned: T,
actual: T,
equals: (a: T, b: T) => boolean,
render: (v: T) => string = String
): void {