diff --git a/.serena/memories/frontend/composable-component-tests.md b/.serena/memories/frontend/composable-component-tests.md index 6618203d88..9d0002b67c 100644 --- a/.serena/memories/frontend/composable-component-tests.md +++ b/.serena/memories/frontend/composable-component-tests.md @@ -4,8 +4,10 @@ A framework concept for systematically testing Penpot's component subsystem (synchronisation/propagation, swaps, variant switches, nesting, overrides), implemented in TWO test suites that share the principles below: -1. **ClojureScript suite** — in the frontend test tree (`frontend/test/frontend_tests/ - composable_tests/`), driving a minimally-assembled real app headlessly. The original. +1. **ClojureScript suite** — engine, nodes and setups in common + (`common/src/app/common/test_helpers/composable/`, CLJC), interpreter and cases in the + frontend test tree (`frontend/test/frontend_tests/composable_tests/`), driving a + minimally-assembled real app headlessly. The original. 2. **TypeScript suite** — a Penpot plugin (`plugins/apps/composable-test-suite/`), driving the FULL production app end-to-end through the Plugin API, with a slightly more elaborate set of abstractions. Runs interactively (panel), remotely (Playwright), and headlessly in CI. Its @@ -55,20 +57,58 @@ tests. --- -# ClojureScript suite (frontend test tree) +# ClojureScript suite -Test-only `.cljs` code in the frontend test tree (nothing "common" about it). A **situation** = +The engine, nodes and setups are CLJC test helpers in common and load on the JVM and in +CLJS; only the interpreter and the cases are frontend code. A **situation** = the in-memory file value + named roles + `:vars` + an ordered applied-log. Operations are records implementing `IOperation`/`apply-to` (`apply` collides with core). Assertions = inline `Test` ops and/or a trailing asserter; the runner makes no judgment. Failures carry `describe-applied` (the transcript), which is what makes a failing variant in a sweep identifiable. -Layout: `core.cljs` (the domain-agnostic engine: situation, identity/transcript, roles/targets, -operators, runners), `comp/setups.cljs` (setups + role accessors), `comp/nodes.cljs` (the component -operations and their check duals), `interpreter.cljs` (runs cases against the real frontend), -`comp/sync_test.cljs` (the cases; registered in `frontend_tests/runner.cljs`). Case letters B..N; +Layout: +- common, `app.common.test-helpers.composable.*`: `core.cljc` (the domain-agnostic engine: + situation, identity/transcript, roles/targets, operators, runners), `comp/setups.cljc` + (setups + role accessors), `comp/nodes.cljc` (the component operations and their check + duals), `comp/runner.cljc` (pure runner), `comp/cases.cljc` (THE cases, shared by both + runners). No frontend requires allowed here. +- frontend, `frontend-tests.composable-tests.*`: `interpreter.cljs` (runs cases against the + real frontend), `comp/sync_test.cljs` (one `t/async` deftest per shared case; registered in + `frontend_tests/runner.cljs`). +- JVM/JS: `common-tests.logic.composable-sync-test` runs the shared cases through the pure + runner; all except N and the rotation case (placement step). Same assertion counts as the + frontend for the shared subset (174). + +A case is a zero-arg fn in `cases.cljc` returning `{:setup :operation :asserter}`; assertions +use `clojure.test` (aliased to `cljs.test` in CLJS), inline (`test-that`) or in `:asserter`. +`ftm/check done case-map` reads `:asserter` from the map. Write a new case there, then add a +wrapper deftest in BOTH test namespaces (or only the frontend one if it needs frontend code). + +Two pure runners (no store, JVM + CLJS): +- `core/run-variant`/`run-all`: apply nodes only (no sync, `n/undo` throws). For engine tests. +- `comp.runner/run-variant`/`run-all`: the case runner. Every comp node declares its kind via + `n/IComponentOperation` (`op-kind`: `:assembly`, `:user`, `:undo`, `:frontend-only`); the + runner and the interpreter's `sync-op?` dispatch on it. A NEW node MUST implement it. User ops + record their production changes (`n/record-changes`, nil when nothing changed); the runner + throws if a `:user` op records nothing or another kind records changes. After a user op the + runner syncs to a fixpoint (`ch/components-changed` + `generate-sync-file-changes`, one pass + per cascade level, like the frontend watcher) and pushes op + syncs as one undo group. + `n/undo` reverts the latest group, no re-sync. The runner validates the file (against the + situation's files) once settled: after the sync fixpoint and after an undo group; never + between cascade passes, where an outer copy still points at the component its main dropped + (`:component-id-mismatch`), nor with `{:sync? false}`. Assembly ops (create/instantiate/nest/variant + container): no sync, no undo group. `ResetCopyInstance` is a user op here (sync + undo), + unlike the interpreter (file install). `{:sync? false}` disables sync. `Rotate`/`ChangeHeight` + are `:frontend-only` and throw `::runner/frontend-only` (the placement step is frontend code). Swap and switch nodes use the production + `clv/generate-component-swap-in-place` (+ `clv/find-switch-target` for switch), the same code the + frontend events call. Not modelled: the `:modified-at` bump, and the swap/switch event follow-ups + (token propagation, WASM text resize, layout update). Tests: + `common-tests.logic.composable-runner-test`. +- Label map gotcha: running a second variant re-registers labels, so assert on a situation + before running the next one (`thi/id` then points at the new run's shapes). Case letters B..O; the sweeps (K: depth × edit-precedence; L: swaps; M: variant switches; N: rotated-instance -geometry, on the #10109 fix branch until merged) are the flagship pattern — read them before +geometry, on the #10109 fix branch until merged; O: switch of an overridden copy, mains +agreeing or not) are the flagship pattern — read them before writing a new sweep. **Scenario lineage model** (behind the sweeps): scenario ops track named component lineages as @@ -92,7 +132,8 @@ STORE-SWAP IMMUNITY: other test namespaces `set!` `st/state`/`st/stream` and nev the `app.main.refs` lenses stay bound to the ORIGINAL atoms — propagation then dies silently. The interpreter captures the atoms at namespace-load time and re-`set!`s them per variant. -Running: `cd frontend && pnpm run build:test`, then +Running (JVM): `cd common && clojure -M:dev:test --focus common-tests.logic.composable-sync-test`. +Running (frontend): `cd frontend && pnpm run build:test`, then `node target/tests/test.js --focus frontend-tests.composable-tests.comp.sync-test` (var-level focus for one case). @@ -103,7 +144,7 @@ unwired subscription and verify by PROBING store state, not by trusting a green **Caveats:** inline `Test` exceptions are UNCAUGHT on the frontend (crash the runner — assert in the trailing asserter). `(optional (in-sequence …))` is not flattened for the interpreter — use -independent optionals. The Serena/clj-kondo cache for `nodes.cljs` goes stale (phantom symbols) — +independent optionals. The Serena/clj-kondo cache for `nodes.cljc` goes stale (phantom symbols) — trust the build. Cross-namespace global-state leaks land in this suite first; suspect them before the framework on inexplicable full-run-only failures. Case H's `sync-file` schedules a delayed RPC that fails headless (benign; absorbed by per-op grace). diff --git a/common/src/app/common/test_helpers/composable/comp/cases.cljc b/common/src/app/common/test_helpers/composable/comp/cases.cljc new file mode 100644 index 0000000000..e0f6c50804 --- /dev/null +++ b/common/src/app/common/test_helpers/composable/comp/cases.cljc @@ -0,0 +1,430 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns app.common.test-helpers.composable.comp.cases + "Component-behaviour cases authored on the composable test model, shared by + both runners: the frontend interpreter (the real app, in + `frontend-tests.composable-tests.comp.sync-test`) and the pure runner + (`app.common.test-helpers.composable.comp.runner`, in + `common-tests.logic.composable-sync-test`). + + Each case is a zero-arg function returning `{:setup :operation :asserter}`. + Assertions use `clojure.test` (`cljs.test` in CLJS), inline through `Test` + operations and/or in the optional trailing `:asserter`, which receives the + resulting situation of each enumerated variant. A case contains only the user + edits: the runner syncs copies on its own, and that is what the cases + assert. + + The cases (see `mem:frontend/composable-component-tests` for details): + B — an override on a copy child survives a later main change (touched gate). + C — a sweep (one-of) over several attribute changes, each propagating. + D — a shape added to the main is structurally propagated (ref-integrity). + E — a middle shape removed from the main; survivors keep order. + F — reordering a shape in the main; order propagates, identity preserved. + H — locality: a library main's change reaches the consuming file's copy on + the explicit library sync (cross-file propagation). + I — undo reverses an edit AND its propagation. + K — the synchronisation sweep: depth x edit-targets, with override-precedence + and reset checkpoints. + L — the swap sweep: swaps at any subset of nesting levels. + M — the variant-switch sweep: case L with variant switches. + O — a variant switch keeps a copy override only where the mains agree. + N — geometry sync with rotated instances (needs the frontend placement step). + Rotation — a touched copy child survives a main rotation (frontend only too)." + (:require + [app.common.data :as d] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.math :as mth] + [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.comp.setups :as setup] + [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.files :as thf] + [app.common.types.component :as ctk] + [app.common.types.shape-tree :as ctst] + [clojure.test :as t])) + +(def ^:private red "#ff0000") +(def ^:private green "#00ff00") +(def ^:private blue "#0000ff") + +;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.) + +(defn copy-override-survives-later-main-change + "Case B." + [] + (let [override (n/change-attr :copy-child :fills green)] ; touch the copy first + {:setup setup/simple-component-with-labeled-copy + ;; override the copy, then change the main; sync runs after each edit. The + ;; override must survive (touched-flag gate). + :operation (tm/in-sequence + [override + (n/change-attr :main-child :fills red)]) + :asserter (fn [situation] + (let [copy-child (setup/copy-instance situation)] + (t/is (n/has-attr? override copy-child)) + (t/is (contains? (:touched copy-child) :fill-group)) + (t/is (some? (:shape-ref copy-child)))))})) + +(defn attribute-sweep-propagates-to-clean-copy + "Case C." + [] + (let [sweep (tm/one-of + [(n/change-attr :main-child :fills red) + (n/change-attr :main-child :opacity 0.5)])] + {:setup setup/simple-component-with-copy + :operation (tm/in-sequence [sweep]) + :asserter (fn [situation] + (let [chosen (tm/get-choice situation sweep)] + (t/is (some? chosen)) + (t/is (n/has-attr? chosen (setup/copy-instance situation)))))})) + +(defn add-shape-to-main-propagates-to-clean-copy + "Case D." + [] + (let [add (n/add-child :main-root :main-child-2)] + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [add]) + :asserter (fn [situation] + (let [copy-root (setup/copy-root situation) + main-new (n/added-shape add situation) + copy-new (n/materialized-instance-child add situation copy-root)] + (t/is (some? copy-new)) + (t/is (ctk/is-main-of? main-new copy-new)) + (t/is (ctst/parent-of? copy-root copy-new)) + (t/is (nil? (:touched copy-new)))))})) + +(defn remove-shape-from-main-propagates-to-clean-copy + "Case E." + [] + (let [removal (n/remove-child :main-child2)] + {:setup setup/component-with-many-children + :operation (tm/in-sequence [removal]) + :asserter (fn [situation] + (let [copy-root (setup/copy-root situation) + order (vec (:shapes copy-root)) + c1 (setup/copy-child situation 1) + c3 (setup/copy-child situation 3)] + (t/is (= 2 (count order))) + (t/is (= (nth order 0) (:id c1))) + (t/is (= (nth order 1) (:id c3))) + (t/is (some? (:shape-ref c1))) + (t/is (some? (:shape-ref c3))) + (t/is (nil? (:touched c1))) + (t/is (nil? (:touched c3))) + (t/is (nil? (:touched copy-root)))))})) + +(defn move-shape-in-main-propagates-order-to-clean-copy + "Case F." + [] + (let [move (n/move-child :main-child1 :main-root 2)] + {:setup setup/component-with-many-children + :operation (tm/in-sequence [move]) + :asserter (fn [situation] + (let [copy-root (setup/copy-root situation) + order (vec (:shapes copy-root)) + c1 (setup/copy-child situation 1) + c2 (setup/copy-child situation 2) + c3 (setup/copy-child situation 3)] + (t/is (= (nth order 0) (:id c2))) + (t/is (= (nth order 1) (:id c1))) + (t/is (= (nth order 2) (:id c3))) + (t/is (some? (:shape-ref c1))) + (t/is (some? (:shape-ref c2))) + (t/is (some? (:shape-ref c3))) + (t/is (nil? (:touched c1))) + (t/is (nil? (:touched c2))) + (t/is (nil? (:touched c3)))))})) + +(defn undo-reverts-edit-and-its-propagation + "Case I. Change the main (which propagates to the clean copy), then undo. A + single undo reverses the whole logical action — the edit AND its + propagation — so the copy returns to baseline and is left untouched." + [] + (let [original "#abcdef" ; the labeled setup's starting fill + baseline (n/change-attr :main-child :fills original) ; expected-VALUE descriptor + change (n/change-attr :main-child :fills red)] + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [change (n/undo)]) + :asserter (fn [situation] + (let [copy (setup/copy-instance situation) + main (setup/main-instance situation)] + ;; the edit was reversed on the main … + (t/is (n/has-attr? baseline main)) + ;; … and on the copy (the propagation was reversed too) … + (t/is (n/has-attr? baseline copy)) + ;; … leaving the copy clean. + (t/is (nil? (:touched copy)))))})) + +(defn library-change-propagates-across-file-boundary-on-sync + "Case H. The main lives in a linked LIBRARY, the copy in the consuming + (current) file. The library main has diverged (setup applied `red` to it, + leaving the copy stale). In-file sync does NOT cross the file boundary; the + app propagates via the library-UPDATE action, so the operation is + `sync-from-library`. `expected` is only an expected-VALUE descriptor (its + target is irrelevant; `has-attr?` uses just attr+value)." + [] + (let [expected (n/change-attr :main-child :fills red)] + {:setup #(setup/cross-file-component-with-copy red) + :operation (tm/in-sequence [(n/sync-from-library)]) + :asserter (fn [situation] + (t/is (n/has-attr? expected (setup/copy-instance situation))))})) + +(defn synchronisation-scenarios + "Case K. CONSOLIDATED SCENARIO SWEEP — one composition standing in for many + cases. Built from the sync-scenario operations on an empty situation. It + sweeps: + - DEPTH 0/1/2 via two independent `(optional (make-nested-component ...))` + - which EDITS were made via three independent `(optional change-*)` + and asserts, at INLINE checkpoints, the override-precedence and reset rules. + The change targets are the tracked lineage rects, so the same composition + holds at any depth. Subsumes the flat/nested propagation cases (A/G/J)." + [] + (let [m "main" + change-remote (n/change-property (n/remote-rect-of m) :fills red) + change-main (n/change-property (n/main-rect-of m) :fills green) + change-copy (n/change-property (n/copy-rect-of m) :fills blue) + copy-rect (fn [s] (n/lineage-copy-rect s m)) + ;; precedence at the copy: copy override wins; else main; else remote. + expected-after-edits + (fn [s] + (cond + (tm/applied? s change-copy) (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s))) + (tm/applied? s change-main) (n/has-property-of change-main (tm/shape-by-id s (copy-rect s))) + (tm/applied? s change-remote) (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s))) + :else true))] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m red) + ;; depth sweep: two independent optionals give depths 0/1/2 + ;; (depth 1 appears twice — harmless) without nesting a + ;; Sequence inside an optional. + (tm/optional (n/make-nested-component m)) + (tm/optional (n/make-nested-component m)) + (n/instantiate-copy m) + (tm/optional change-remote) + (tm/optional change-main) + (tm/optional change-copy) + (tm/test-that (fn [s] (t/is (expected-after-edits s)))) + ;; force a copy override, observe it wins, then reset it away + change-copy + (tm/test-that + (fn [s] (t/is (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s)))))) + (n/reset-copy-instance m) + (tm/test-that + (fn [s] + ;; after reset: main's value if main changed, else remote's + ;; if remote changed (else the original — not asserted). + (cond + (tm/applied? s change-main) (t/is (n/has-property-of change-main (tm/shape-by-id s (copy-rect s)))) + (tm/applied? s change-remote) (t/is (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s)))) + :else true)))])})) + +(defn- level-color + "The fill colour of the rect currently at lineage `name`'s nesting level `i`." + [s name i] + (-> (tm/shape-by-id s (n/level-rect s name i)) :fills first :fill-color)) + +(def ^:private base-color "#aaaaaa") +(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets + +(defn swap-scenarios + "Case L. SWAP SWEEP — build a 3-level nesting, then OPTIONALLY swap the + nested component at each level for a differently-coloured one, and assert + the colour that surfaces at every level. A swap at level i propagates to + level i and every OUTER (higher-index) level, until a swap at a higher level + overrides it. So the colour at level i is the swap at the HIGHEST index + j <= i that was applied, else the base colour." + [] + (let [m "main" + targets ["s0" "s1" "s2"] + ;; swap[i] swaps level i's nested component for target lineage i (color i) + swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3)) + expected-at + (fn [s i] + ;; the colour of the applied swap at the highest j <= i, else base + (or (some (fn [j] (when (tm/applied? s (nth swaps j)) (nth swap-colors j))) + (range i -1 -1)) + base-color))] + {:setup setup/empty-situation + :operation (tm/in-sequence + (concat + [(n/create-component m base-color)] + ;; a target lineage per level + (map-indexed (fn [i c] (n/create-component (nth targets i) c)) swap-colors) + [(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)] + ;; optionally swap at each level + (map (fn [sw] (tm/optional sw)) swaps) + [(tm/test-that + (fn [s] + (doseq [i (range 3)] + (t/is (= (expected-at s i) (level-color s m i)) + (str "level " i)))))]))})) + +(defn variant-switch-scenarios + "Case M. VARIANT-SWITCH SWEEP — the variant-switch flavour of case L. Build + a variant SET of peer members and nest the base member at EVERY level (so + each level has a variant head, just as case L's swap target exists at every + level). Then OPTIONALLY switch the variant head at each level to a + differently-coloured sibling and assert the colour that surfaces at every + level. A variant switch is a keep-touched swap, so it propagates like case + L: the colour at level i is the switch at the HIGHEST index j <= i that was + applied, else the base member's colour." + [] + (let [m "main" ; the nesting lineage (holds the nesting-data) + vset "vset" ; the variant set + vals ["v0" "v1" "v2" "v3"] + colors (into [base-color] swap-colors) ; base + sibling colours + ;; switch[i] switches level i's variant head to member i+1 (colour i). The + ;; single variant instance has a corresponding (switchable) head at every + ;; level — `nested-head` IS the deepest instance there — so we can switch at + ;; ANY level, exactly like case L's per-level swap. + switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth vals (inc i)))) + (range 3)) + expected-at + (fn [s i] + ;; same precedence as case L + (or (some (fn [j] (when (tm/applied? s (nth switches j)) (nth swap-colors j))) + (range i -1 -1)) + base-color))] + {:setup setup/empty-situation + :operation (tm/in-sequence + (concat + ;; the nesting lineage, and the variant set (members = [value color]) + [(n/create-component m base-color) + (n/make-variant-container vset (mapv vector vals colors))] + ;; introduce the variant instance ONCE (innermost), then wrap it + ;; with plain nesting so each outer level CONTAINS the one below + ;; (progressive nesting, like case L). nested-head at every level + ;; is then the variant (the deepest instance), so a switch at + ;; level i targets it and propagates OUTWARD — exactly like case + ;; L's swap. + [(n/make-nested-component-with-variant m vset "v0") + (n/make-nested-component m) + (n/make-nested-component m)] + ;; optionally switch each level's variant head to its target sibling + (map (fn [sw] (tm/optional sw)) switches) + [(tm/test-that + (fn [s] + (doseq [i (range 3)] + (t/is (= (expected-at s i) (level-color s m i)) + (str "level " i)))))]))})) + +(defn variant-switch-keeps-override-only-where-mains-agree + "Case O. A copy overrides the fill of its nested variant's rect, then the + variant head inside the copy is switched to the other member. Sweeps a + variant set whose members agree on the rect fill and one where they + differ. Per decision (a) of `mem:common/component-sync-contract`, the + override is carried only when the old and new mains agree: then the rect + keeps it and stays touched; otherwise it takes the new member's fill and + is not touched." + [] + (let [m "main" + agree (n/make-variant-container "vset" [["a" base-color] ["b" base-color]]) + differ (n/make-variant-container "vset" [["a" base-color] ["b" red]]) + override (n/change-property (n/copy-rect-of m) :fills green) + ;; the variant head inside the copy holds the copy rect + copy-head (fn [s] (:parent-id (tm/shape-by-id s (n/lineage-copy-rect s m)))) + ;; after the switch, the copy rect is the one copying member b's rect + switched (fn [s] + (let [b-rect (:rect-id (n/variant-member s "vset" "b")) + objects (:objects (thf/current-page (tm/file s)))] + (d/seek #(= b-rect (:shape-ref %)) (vals objects))))] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color) + (tm/one-of [agree differ]) + (n/make-nested-component-with-variant m "vset" "a") + (n/instantiate-copy m) + override + (n/switch-variant copy-head "b")]) + :asserter (fn [situation] + (let [rect (switched situation)] + (t/is (some? rect)) + (if (tm/applied? situation agree) + (do + (t/is (n/has-property-of override rect)) + (t/is (contains? (:touched rect) :fill-group))) + (do + (t/is (= red (-> rect :fills first :fill-color))) + (t/is (not (contains? (:touched rect) :fill-group)))))))})) + +(defn geometry-sync-with-rotated-instances + "Case N. Regression sweep for #10109, with #13267's semantics as its + complement: an instance root's transformation is inherited, overridable + content — asymmetric to position, which is free per-instance placement. + + On the simple component-with-copy, sweep three axes: optionally rotate the + COPY as a whole (an override of its root's placement — must not block + propagation), optionally rotate the MAIN as a whole (inherited content — an + untouched copy must follow it), and apply ONE of a property edit (fills) or + a geometry edit (height) to the main child. In EVERY variant the chosen edit + must arrive at the copy child; the copy's rotation is its own 45° if the + copy was rotated (override wins), else the main's 45° if the main was + rotated (clean copy follows), else 0; and only a rotated copy's ROOT is + touched (:geometry-group) — its child merely follows and stays untouched." + [] + (let [rotate-copy (n/rotate :copy-root 45) + rotate-main (n/rotate :main-root 45) + edits (tm/one-of + [(n/change-attr :main-instance :fills red) + (n/change-height :main-instance 80)])] + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [(tm/optional rotate-copy) + (tm/optional rotate-main) + edits]) + :asserter (fn [situation] + (let [chosen (tm/get-choice situation edits) + copy-root (setup/copy-root situation) + copy-child (setup/copy-instance situation) + expected-rotation (cond + (tm/applied? situation rotate-copy) 45 + (tm/applied? situation rotate-main) 45 + :else 0)] + ;; the chosen main edit arrived at the copy child, in every variant + (t/is (some? chosen)) + (t/is (n/has-property-of chosen copy-child)) + ;; the copy shows the expected rotation (own override > followed main > none) + (t/is (mth/close? (or (:rotation copy-root) 0) expected-rotation)) + (t/is (mth/close? (or (:rotation copy-child) 0) expected-rotation)) + ;; only a rotated copy's ROOT is an override; the child merely follows + (t/is (= (if (tm/applied? situation rotate-copy) #{:geometry-group} nil) + (:touched copy-root))) + (t/is (nil? (:touched copy-child)))))})) + +(defn touched-copy-child-survives-main-rotation + "A copy whose ROOT is rotated (a geometry override) AND whose CHILD has its + own geometry override (resized) must keep the child exactly in place when + the MAIN is later rotated: the child's placement is its own, shielded by its + touched :geometry-group. We capture the child's position relative to the + copy root before the main rotation and assert it is unchanged after." + [] + (let [before (atom nil) + rel-pos (fn [situation] + (let [child (setup/copy-instance situation) + root (setup/copy-root situation)] + (-> (gpt/subtract (grc/rect->center (:selrect child)) + (grc/rect->center (:selrect root))) + (gpt/transform (:transform-inverse root (gmt/matrix)))))) + capture (tm/test-that (fn [s] (reset! before (rel-pos s)) (t/is (some? @before))))] + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [(n/rotate :copy-root 30) + (n/change-height :copy-instance 60) + capture + (n/rotate :main-root 40)]) + :asserter (fn [situation] + (let [copy-child (setup/copy-instance situation) + copy-root (setup/copy-root situation) + after (rel-pos situation)] + ;; both overrides are recorded as geometry touches + (t/is (contains? (:touched copy-root) :geometry-group)) + (t/is (contains? (:touched copy-child) :geometry-group)) + ;; the child keeps its own overridden height + (t/is (mth/close? (:height copy-child) 60)) + ;; and its position relative to the copy root is unchanged by the main rotation + (t/is (mth/close? (:x @before) (:x after) 0.5) (str "rel-x " (:x @before) " -> " (:x after))) + (t/is (mth/close? (:y @before) (:y after) 0.5) (str "rel-y " (:y @before) " -> " (:y after)))))})) diff --git a/frontend/test/frontend_tests/composable_tests/comp/nodes.cljs b/common/src/app/common/test_helpers/composable/comp/nodes.cljc similarity index 86% rename from frontend/test/frontend_tests/composable_tests/comp/nodes.cljs rename to common/src/app/common/test_helpers/composable/comp/nodes.cljc index 7c13afc4fd..1a32d0ebc7 100644 --- a/frontend/test/frontend_tests/composable_tests/comp/nodes.cljs +++ b/common/src/app/common/test_helpers/composable/comp/nodes.cljc @@ -4,14 +4,14 @@ ;; ;; Copyright (c) KALEIDOS SUBSIDIARY SL -(ns frontend-tests.composable-tests.comp.nodes +(ns app.common.test-helpers.composable.comp.nodes "Component-specific operation nodes for the test model. These are the `IOperation` implementations whose subject is Penpot component behaviour: they wrap component/shape operations and drive the real production change pipeline. This namespace sits behind the `comp` boundary precisely because it is about components; the generic engine in - `frontend-tests.composable-tests.core` has no domain terms. See + `app.common.test-helpers.composable.core` has no domain terms. See `mem:frontend/composable-component-tests`. Nodes deliberately call the production change pipeline directly @@ -26,6 +26,7 @@ [app.common.data :as d] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] + [app.common.files.shapes-helpers :as cfsh] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.logic.libraries :as cll] @@ -33,13 +34,52 @@ [app.common.logic.variants :as clv] [app.common.math :as mth] [app.common.test-helpers.components :as thc] + [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.compositions :as tho] [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] [app.common.types.container :as ctn] - [app.common.types.modifiers :as ctm] - [frontend-tests.composable-tests.core :as tm])) + [app.common.types.modifiers :as ctm])) + +;; --------------------------------------------------------------------------- +;; Operation kinds and the production changes of user operations +;; +;; Every component node declares its kind, which tells a runner how to treat +;; it: +;; :assembly builds the configuration with test helpers; no sync, no +;; undo group, and it records no changes. +;; :user a user action the app commits. It stores the production +;; changes it applied with `record-changes` (nil when it +;; changed nothing). The pure runner +;; (`app.common.test-helpers.composable.comp.runner`) takes +;; them to sync the file and to build its undo stack. +;; :undo reverts the latest user action; needs a runner's undo +;; stack. +;; :frontend-only its production result needs frontend code; the pure +;; runner rejects it. +;; The pure runner checks that a :user node recorded its changes and that +;; no other kind did. +;; --------------------------------------------------------------------------- + +(defprotocol IComponentOperation + (op-kind [op] + "How a runner treats `op`: :assembly, :user, :undo or :frontend-only.")) + +(defn record-changes + "Store `changes`, the production changes a user operation applied (nil when + it changed nothing), in `situation` for the runner to take." + [situation changes] + (assoc situation ::changes changes)) + +(defn take-changes + "The changes recorded by the last operation and the situation without them, + as `[recorded? changes situation]`. `recorded?` is false when the operation + did not call `record-changes`." + [situation] + [(contains? situation ::changes) + (::changes situation) + (dissoc situation ::changes)]) ;; --------------------------------------------------------------------------- ;; Properties — an OPEN, extensible vocabulary of "what about a shape can change" @@ -77,6 +117,9 @@ {:property property})))) (defrecord ChangeProperty [target property value] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] ;; Goes through the production change path, exactly like tho/update-color, @@ -96,6 +139,7 @@ file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:target target :property property :value value}))))) (defn change-property @@ -142,9 +186,13 @@ ;; what these operations exist to exercise. The synchronous `apply-to` fallback ;; below performs the geometrically equivalent transform through the production ;; math, but cannot classify placement (that code is frontend-only), so cases -;; using these operations are meant to run through the interpreter. +;; using these operations are meant to run through the interpreter. The pure +;; runner rejects them. (defrecord Rotate [target angle] + IComponentOperation + (op-kind [_] :frontend-only) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -164,6 +212,7 @@ file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:target target :angle angle}))))) (defn rotate @@ -175,6 +224,9 @@ (tm/assign-id (->Rotate target angle))) (defrecord ChangeHeight [target value] + IComponentOperation + (op-kind [_] :frontend-only) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -194,6 +246,7 @@ file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:target target :value value}))))) (defn change-height @@ -388,6 +441,9 @@ ;; --------------------------------------------------------------------------- (defrecord CreateComponent [name color] + IComponentOperation + (op-kind [_] :assembly) + tm/IOperation (apply-to [this situation] ;; fresh, name-scoped labels so several lineages don't clash @@ -496,6 +552,9 @@ (tm/record-application op {:component name :level level :outer outer-id})))) (defrecord MakeNestedComponent [name] + IComponentOperation + (op-kind [_] :assembly) + tm/IOperation (apply-to [this situation] ;; nest a COPY of the lineage's own current component. Seek the FIXED deepest @@ -526,6 +585,9 @@ ;; --------------------------------------------------------------------------- (defrecord InstantiateCopy [name] + IComponentOperation + (op-kind [_] :assembly) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -564,6 +626,9 @@ ;; --------------------------------------------------------------------------- (defrecord ResetCopyInstance [name] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] ;; Production reset path (generate-reset-component), validation OFF — mirrors @@ -584,6 +649,7 @@ file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:component name :reset copy-id}))))) (defn reset-copy-instance @@ -592,14 +658,22 @@ [name] (tm/assign-id (->ResetCopyInstance name))) +(defn- libraries + "The situation's files by id, as the production code expects them: the + current file and any auxiliary (library) files." + [situation] + (let [the-file (tm/file situation)] + (assoc (tm/aux-files situation) (:id the-file) the-file))) + ;; --------------------------------------------------------------------------- ;; swap-component — replace a nested subinstance head with an instance of a ;; different component (the general "Swap component" action), in place. ;; ;; Targets lineage `name`'s nesting level `level` (its `nesting-data[level] ;; .nested-head`) and swaps it for lineage `target`'s component -;; (`:main-component-id`). Drives the production `generate-component-swap` -;; (validation off). The `apply-to` below is the pure realisation; the frontend +;; (`:main-component-id`). Drives the production `generate-component-swap-in-place` +;; (validation off), the changes the `component-swap` event commits. The +;; `apply-to` below is the pure realisation; the frontend ;; interpreter instead dispatches the real `dwl/component-swap` event, so the ;; watcher auto-propagates the swap. keep-touched? defaults ;; false (the general swap discards overrides; variant-switch would pass true). @@ -611,29 +685,29 @@ ;; --------------------------------------------------------------------------- (defrecord SwapComponent [name level target keep-touched?] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) page (thf/current-page the-file) - objects (:objects page) nested-head (:nested-head (lineage-nesting situation name level)) - shape (get objects nested-head) + shape (get (:objects page) nested-head) target-id (lineage-component-id situation target) - libraries {(:id the-file) the-file} - orig-shapes (when keep-touched? - (cfh/get-children-with-self objects nested-head)) - [new-shape _parents changes] - (cll/generate-component-swap (pcb/empty-changes) - objects shape (:data the-file) page libraries - target-id 0 nil {} (boolean keep-touched?)) - [changes _] (if keep-touched? - (clv/generate-keep-touched changes new-shape shape orig-shapes - page libraries (:data the-file)) - [changes nil]) + [new-shape changes _] + (clv/generate-component-swap-in-place (pcb/empty-changes nil (:id page)) + page + (libraries situation) + (:data the-file) + shape + target-id + (boolean keep-touched?)) file' (thf/apply-changes the-file changes :validate? false)] (-> situation ;; record the swapped-in head id on the level (its parent is unchanged) (tm/with-file file') + (record-changes changes) (update-component-obj name (fn [o] (assoc-in o [:nesting-data level :swapped-head] (:id new-shape)))) @@ -658,14 +732,14 @@ ;; it routes through the SAME `generate-component-swap` as `swap-component` and ;; the watcher auto-propagates it across nesting levels exactly like a swap. ;; -;; OP SPLIT: only the SWITCH is a real workspace event (`variant-switch` has no -;; pure generator to call directly), so `SwitchVariant` is an EVENT-op: its -;; `apply-to` throws, and the frontend interpreter realises it by dispatching the -;; event. The container build and the variant nesting are SYNC-ops (test-helper -;; assembly + the shared nesting helper), applied via `apply-to` against the live -;; store file; they record the variant-set in vars. Event-ops do NOT run -;; `apply-to` (only sync-ops do), but the switch needs no bookkeeping: the -;; asserter re-resolves heads via the swap-stable :nested-head-parent +;; OP SPLIT: the SWITCH is a user action. The frontend interpreter dispatches +;; the real `variants-switch` event; its pure `apply-to` builds the same changes +;; with the production `find-switch-target` and +;; `generate-component-swap-in-place`. The container build and the variant +;; nesting are SYNC-ops (test-helper assembly + the shared nesting helper), +;; applied via `apply-to` against the live store file; they record the +;; variant-set in vars. The switch needs no bookkeeping: the asserter +;; re-resolves heads via the swap-stable :nested-head-parent ;; (`nested-head-of`/`level-rect`), exactly as case L does for swaps. ;; ;; Member SELECTOR: `make-variant-container` assigns each member an EXPLICIT property @@ -732,6 +806,9 @@ ;; --------------------------------------------------------------------------- (defrecord MakeVariantContainer [name members] + IComponentOperation + (op-kind [_] :assembly) + tm/IOperation (apply-to [this situation] ;; Build the set exactly as the variant test-helpers' `add-variant` do (the @@ -809,6 +886,9 @@ ;; --------------------------------------------------------------------------- (defrecord MakeNestedComponentWithVariant [name set-name value] + IComponentOperation + (op-kind [_] :assembly) + tm/IOperation (apply-to [this situation] (let [member (variant-member situation set-name value) @@ -839,11 +919,12 @@ ;; switch-variant — switch a variant copy head to a sibling member ;; ;; The variant-switch action: switch the variant copy head bound to `target` to the -;; sibling member whose selector property (pos 0) has `value`. FRONTEND-only: -;; dispatches the production `variants-switch`, which DISCOVERS the sibling by value -;; within the variant container and routes through `component-swap` with -;; keep-touched? true — so the watcher auto-propagates it across nesting levels -;; exactly like case L's swap. A switch REPLACES the head in place; the head's +;; sibling member whose selector property (pos 0) has `value`. The production +;; switch DISCOVERS the sibling by value within the variant container and swaps +;; with keep-touched? true, so sync propagates it across nesting levels exactly +;; like case L's swap. On the frontend it is the `variants-switch` event. The +;; event's follow-ups (token propagation, WASM text resize, layout update) are +;; frontend code and the pure `apply-to` does not run them. A switch REPLACES the head in place; the head's ;; :parent is unchanged, so assertions re-resolve parent -> current head -> rect. ;; ;; `target` is the head to switch, resolved by the standard `target-shape-id` (role @@ -853,13 +934,43 @@ ;; --------------------------------------------------------------------------- (defrecord SwitchVariant [target value] + IComponentOperation + (op-kind [_] :user) + tm/IOperation - (apply-to [_ _] - (throw (ex-info (str "switch-variant is an EVENT-op with no pure `apply-to` realisation: " - "it is the real `variants-switch` workspace event (which discovers the " - "sibling via the variant container), dispatched by the frontend " - "interpreter. See the VARIANT operations note above.") - {:type ::switch-variant-is-event-op})))) + (apply-to [this situation] + (let [the-file (tm/file situation) + page (thf/current-page the-file) + objects (:objects page) + libraries (libraries situation) + shape (get objects (tm/target-shape-id situation target)) + component (clv/find-switch-target libraries shape 0 value)] + (cond + ;; the value is already `value`, or no sibling has it: nothing happens + (nil? component) + (-> situation + (record-changes nil) + (tm/record-application this {:target-component nil})) + + (clv/swap-nesting-loop? objects + shape + (get-in libraries [(:component-file shape) :data]) + (:id component)) + (throw (ex-info "switch-variant: the switch would nest a component inside itself" + {:type ::switch-nesting-loop + :shape (:id shape) + :component (:id component)})) + + :else + (let [ldata (get-in libraries [(:component-file shape) :data]) + [_ changes _] (clv/generate-component-swap-in-place + (pcb/empty-changes nil (:id page)) + page libraries ldata shape (:id component) true) + file' (thf/apply-changes the-file changes :validate? false)] + (-> situation + (tm/with-file file') + (record-changes changes) + (tm/record-application this {:target-component (:id component)}))))))) (defn switch-variant "Switch the variant copy head bound to `target` to the sibling member whose @@ -867,7 +978,7 @@ machinery (which discovers the sibling within the container). Propagates across nesting exactly like case L's swap. `target` is resolved like any operation target (role | label | (situation -> id) fn, e.g. `nested-head-of`), so the op is - structure-agnostic. FRONTEND-only." + structure-agnostic." [target value] (tm/assign-id (->SwitchVariant target value))) @@ -900,6 +1011,9 @@ ;; --------------------------------------------------------------------------- (defrecord SyncFromLibrary [] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -919,6 +1033,7 @@ file' (thf/apply-changes the-file changes :validate? false)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:library-id library-id}))))) (defn sync-from-library @@ -938,18 +1053,21 @@ ;; inverse changes. "Test undo everywhere" = append this node after any case; the ;; post-undo assertion is an ordinary condition about the resulting state. ;; -;; A pure `apply-to` realisation is NOT built: it would require every node to -;; stash its produced change value (the engine `:undo-changes`) into its record -;; so this node could apply the inverse — a retrofit across all nodes that no -;; case needs. It therefore throws loudly rather than pretending. +;; The pure runner (`app.common.test-helpers.composable.comp.runner`) realises +;; it from the changes that user operations record (`record-changes`). A bare +;; `apply-to` has no undo stack to read, so it throws loudly rather than +;; pretending. ;; --------------------------------------------------------------------------- (defrecord Undo [] + IComponentOperation + (op-kind [_] :undo) + tm/IOperation (apply-to [_ _] - (throw (ex-info (str "Undo is an EVENT-op with no pure `apply-to` realisation (change " - "values are not stashed per-node). It is realised by the frontend " - "interpreter via the real undo event.") + (throw (ex-info (str "Undo has no `apply-to` realisation: it needs an undo stack. " + "Run it through the pure runner (comp.runner) or the frontend " + "interpreter.") {:type ::undo-is-event-op})))) (defn undo @@ -963,10 +1081,10 @@ ;; add-child — add a new shape into a (main) component, structurally ;; ;; This is STRUCTURAL modification (changes the tree shape), as opposed to -;; change-attr (attribute modification). It mirrors the established -;; comp-sync-test "add shape" pattern: create a free shape on the page, then -;; relocate it INTO the target parent via the production `generate-relocate` -;; path. Propagation then materializes a corresponding child in copies. +;; change-attr (attribute modification). It builds the new shape under the +;; target parent with `prepare-add-shape`, the same changes the frontend +;; `add-shape` event commits, so one undo removes it whole. Propagation then +;; materializes a corresponding child in copies. ;; ;; `parent` is the binding name of the shape to add the new child under (e.g. ;; :main-root). `new-label` is the label assigned to the created shape, so a @@ -974,26 +1092,30 @@ ;; --------------------------------------------------------------------------- (defrecord AddChild [parent new-label shape-params] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] - (let [the-file (tm/file situation) + (let [the-file (tm/file situation) ;; strict-presence on the parent (it must exist before we add under it) - parent-id (tm/resolve-shape-id situation parent) - ;; 1) create the free shape on the page (registers `new-label`) - file-1 (ths/add-sample-shape the-file new-label (or shape-params {})) - page (thf/current-page file-1) - new-id (thi/id new-label) - ;; 2) relocate it into the parent through the production change path - changes (cls/generate-relocate - (-> (pcb/empty-changes nil) - (pcb/with-page-id (:id page)) - (pcb/with-objects (:objects page))) - parent-id ; parent-id - 0 ; to-index - #{new-id}) ; ids to move - file' (thf/apply-changes file-1 changes)] + parent-id (tm/resolve-shape-id situation parent) + page (thf/current-page the-file) + objects (:objects page) + parent-obj (get objects parent-id) + ;; registers `new-label` + shape (-> (ths/sample-shape new-label (or shape-params {})) + (assoc :parent-id parent-id + :frame-id (if (cfh/frame-shape? parent-obj) + parent-id + (:frame-id parent-obj)))) + [_ changes] (cfsh/prepare-add-shape (pcb/empty-changes nil (:id page)) + shape + objects) + file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:parent parent :new-label new-label}))))) (defn add-child @@ -1017,6 +1139,9 @@ ;; --------------------------------------------------------------------------- (defrecord RemoveChild [target] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -1033,6 +1158,7 @@ file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:target target}))))) (defn remove-child @@ -1056,6 +1182,9 @@ ;; --------------------------------------------------------------------------- (defrecord MoveChild [target parent to-index] + IComponentOperation + (op-kind [_] :user) + tm/IOperation (apply-to [this situation] (let [the-file (tm/file situation) @@ -1072,6 +1201,7 @@ file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') + (record-changes changes) (tm/record-application this {:target target :parent parent :to-index to-index}))))) (defn move-child diff --git a/common/src/app/common/test_helpers/composable/comp/runner.cljc b/common/src/app/common/test_helpers/composable/comp/runner.cljc new file mode 100644 index 0000000000..14f8c63cc9 --- /dev/null +++ b/common/src/app/common/test_helpers/composable/comp/runner.cljc @@ -0,0 +1,221 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns app.common.test-helpers.composable.comp.runner + "Pure runner for composable component cases. It runs a case on the in-memory + file, without the frontend store, on the JVM and in CLJS, and adds what the + frontend workspace does around each operation: + + - Sync. After a user operation (kind `:user`, see + `n/IComponentOperation`), it syncs each component that + `ch/components-changed` reports, then the components each sync changed, + until none is left. The frontend component watcher does the same, one + pass per sync commit. + - Undo. A user operation and the syncs it caused form one undo group. + `n/undo` reverts the latest group and syncs nothing, as in the frontend, + where an undo commit only bumps the component's `:modified-at`. + + Assembly operations (create, instantiate, nest) change the file with no sync + and no undo group, like the frontend interpreter's file installs. + + Operations whose result needs frontend code (kind `:frontend-only`) are + rejected. Not modelled: the `:modified-at` bump of a changed component, + and the frontend follow-ups of a swap or switch (token propagation, WASM + text resize, layout update)." + (:require + [app.common.files.changes :as ch] + [app.common.files.changes-builder :as pcb] + [app.common.logic.libraries :as cll] + [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.files :as thf])) + +(def ^:private default-opts + {:sync? true}) + +;; A guard against a sync cascade that never settles. +(def ^:private max-sync-passes 100) + +(defn- changed-components + "Ids of the components whose main `changes` modified, judged against + `old-data`, the file data before `changes` applied." + [old-data changes] + (into #{} + (mapcat (partial ch/components-changed old-data)) + (:redo-changes changes))) + +(defn- libraries + "The situation's files by id, with `file` as its current file." + [situation file] + (assoc (tm/aux-files situation) (:id file) file)) + +(defn- validate-settled! + "Validate the situation's file, resolving components against its other + files. Only a settled file is valid: between two passes of a sync cascade, + an outer copy can still point at the component its main no longer uses. + Throws when the file is invalid." + [situation] + (let [file (tm/file situation)] + (thf/validate-file! file (libraries situation file)) + situation)) + +(defn- component-sync-changes + "The changes that sync the copies of `component-id` in `file`, as the + frontend `sync-file` event builds them for a local component." + [situation file component-id] + (let [file-id (:id file)] + (cll/generate-sync-file-changes (pcb/empty-changes) + nil + :components + file-id + component-id + file-id + (libraries situation file) + file-id))) + +(defn- sync-file + "Sync `situation`'s file, starting from the components that `changes` + modified (judged against `old-data`), until no component is left to sync, + and validate the result. Returns `[situation syncs]`, with `syncs` the + applied sync changes in order." + [situation old-data changes] + (loop [file (tm/file situation) + pending (vec (changed-components old-data changes)) + syncs [] + passes 0] + (cond + (empty? pending) + [(validate-settled! (tm/with-file situation file)) syncs] + + (>= passes max-sync-passes) + (throw (ex-info "Component sync did not settle" + {:type ::sync-not-settled + :pending pending + :passes passes})) + + :else + (let [component-id (first pending) + sync (component-sync-changes situation file component-id) + file' (thf/apply-changes file sync :validate? false) + more (->> (changed-components (:data file) sync) + (remove (set pending)))] + (recur file' + (into (subvec pending 1) more) + (cond-> syncs (seq (:redo-changes sync)) (conj sync)) + (inc passes)))))) + +(defn- push-undo-group + "Add `group`, the changes of one user operation and its syncs in order, to + the undo stack. Changes with nothing to undo are left out, as the frontend + undo stack leaves out commits with no undo changes." + [situation group] + (let [group (filterv (comp seq :undo-changes) group)] + (cond-> situation + (seq group) (update ::undo-stack (fnil conj []) group)))) + +(defn- run-undo + "Revert the latest undo group, newest changes first, and validate the + result. With an empty stack it changes nothing, like the frontend undo." + [situation op] + (let [stack (get situation ::undo-stack []) + group (peek stack) + file (reduce (fn [file changes] + (thf/apply-changes file + {:redo-changes (:undo-changes changes)} + :validate? false)) + (tm/file situation) + (rseq (or group [])))] + (-> situation + (tm/with-file file) + (validate-settled!) + (assoc ::undo-stack (if (seq stack) (pop stack) stack)) + (tm/record-application op {:undone (count group)})))) + +(defn- op-kind + "The kind of a leaf operation (see `n/IComponentOperation`), or nil for an + engine operation such as `Test` or `Skip`." + [op] + (when (satisfies? n/IComponentOperation op) + (n/op-kind op))) + +(defn- check-recorded-changes! + "Throw unless `op` recorded its changes exactly when it is a user operation." + [op kind recorded?] + (cond + (and (= kind :user) (not recorded?)) + (throw (ex-info (str "User operation " (pr-str (type op)) " recorded no " + "changes. Call `n/record-changes`, with nil when it " + "changed nothing.") + {:type ::changes-not-recorded + :op op})) + + (and (not= kind :user) recorded?) + (throw (ex-info (str (pr-str (type op)) " recorded changes but its kind is " + (pr-str kind) ". Only user operations record them.") + {:type ::unexpected-changes + :op op + :kind kind})))) + +(defn- run-node + "Apply one leaf operation of `kind`. A user operation is followed by its sync + (when `:sync?`) and pushes its undo group." + [situation op kind {:keys [sync?]}] + (let [old-data (:data (tm/file situation)) + [recorded? changes situation] (n/take-changes (tm/apply-to op situation))] + (check-recorded-changes! op kind recorded?) + (if (nil? changes) + situation + (let [[situation syncs] (if sync? + (sync-file situation old-data changes) + [situation []])] + (push-undo-group situation (into [changes] syncs)))))) + +(defn- run-op + [situation op opts] + (cond + (tm/sequence? op) + (reduce #(run-op %1 %2 opts) situation (:steps op)) + + (tm/recorded-choice? op) + (-> (tm/record-choice situation op) + (run-op (tm/choice-of op) opts)) + + :else + (let [kind (op-kind op)] + (case kind + :undo + (run-undo situation op) + + :frontend-only + (throw (ex-info (str "The pure runner cannot run " (pr-str (type op)) + ": its production result needs frontend code. " + "Run the case through the frontend interpreter.") + {:type ::frontend-only + :op op})) + + (run-node situation op kind opts))))) + +(defn undo-depth + "How many undo groups the runner holds in `situation`." + [situation] + (count (get situation ::undo-stack))) + +(defn run-variant + "Run one concrete (already enumerated) variant: build a fresh situation with + `setup` and run `operation` with sync and undo, returning the resulting + situation. Options: `:sync?` (default true) syncs after each user + operation." + ([case-map] (run-variant case-map {})) + ([{:keys [setup operation]} opts] + (run-op (setup) operation (merge default-opts opts)))) + +(defn run-all + "Enumerate `operation` into its concrete variants and run each with + `run-variant`, resetting the label map before each setup. Returns the + resulting situations in enumeration order." + ([case-map] (run-all case-map {})) + ([case-map opts] + (tm/run-all case-map #(run-variant % opts)))) diff --git a/frontend/test/frontend_tests/composable_tests/comp/setups.cljs b/common/src/app/common/test_helpers/composable/comp/setups.cljc similarity index 98% rename from frontend/test/frontend_tests/composable_tests/comp/setups.cljs rename to common/src/app/common/test_helpers/composable/comp/setups.cljc index 9c40acb214..bbe81552e9 100644 --- a/frontend/test/frontend_tests/composable_tests/comp/setups.cljs +++ b/common/src/app/common/test_helpers/composable/comp/setups.cljc @@ -4,7 +4,7 @@ ;; ;; Copyright (c) KALEIDOS SUBSIDIARY SL -(ns frontend-tests.composable-tests.comp.setups +(ns app.common.test-helpers.composable.comp.setups "Component-specific setups for the test model: named functions that build an in-memory file value for a particular component configuration. They are the subject-specific counterpart to the generic engine; a 'simple component with @@ -25,11 +25,11 @@ [app.common.files.changes-builder :as pcb] [app.common.logic.shapes :as cls] [app.common.test-helpers.components :as thc] + [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.compositions :as tho] [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] - [app.common.test-helpers.shapes :as ths] - [frontend-tests.composable-tests.core :as tm])) + [app.common.test-helpers.shapes :as ths])) (defn simple-component-with-copy "A situation with a simple component (root + one child) and one clean copy. diff --git a/frontend/test/frontend_tests/composable_tests/core.cljs b/common/src/app/common/test_helpers/composable/core.cljc similarity index 95% rename from frontend/test/frontend_tests/composable_tests/core.cljs rename to common/src/app/common/test_helpers/composable/core.cljc index ba0054ee2f..47c6cef992 100644 --- a/frontend/test/frontend_tests/composable_tests/core.cljs +++ b/common/src/app/common/test_helpers/composable/core.cljc @@ -4,7 +4,7 @@ ;; ;; Copyright (c) KALEIDOS SUBSIDIARY SL -(ns frontend-tests.composable-tests.core +(ns app.common.test-helpers.composable.core "The domain-agnostic ENGINE of the composable test model (see `mem:frontend/composable-component-tests`): @@ -22,7 +22,7 @@ event-dispatching counterpart and the test-facing entry point). No Penpot domain terms live here; the component-specific operations sit - behind the `comp` boundary (`frontend-tests.composable-tests.comp.*`). + behind the `comp` boundary (`app.common.test-helpers.composable.comp.*`). Shape references use the existing label->uuid system (`app.common.test-helpers.ids-map`) rather than a parallel binding map: a binding name in an operation IS a @@ -133,7 +133,8 @@ per-node boilerplate, faithful to the actual type). E.g. a ChangeAttr record yields \"change-attr\"." [node] - (let [cls (or (some-> node type .-name (str/split #"\.") last) + (let [cls (or #?(:clj (some-> ^Class (type node) .getSimpleName) + :cljs (some-> node type .-name (str/split #"\.") last)) "node") ;; CamelCase -> kebab-case kebab (-> cls @@ -447,6 +448,8 @@ ;; multiplies out correctly via the sequence's cartesian product. ;; --------------------------------------------------------------------------- +(declare record-choice) + (defrecord RecordedChoice [one-of-id chosen] ;; Internal node produced by OneOf enumeration. Applying it records, under the ;; originating one-of's identity, which alternative was chosen, then applies @@ -454,11 +457,9 @@ ;; one-of) recovers the choice from the resulting situation. It is already ;; concrete, so it enumerates to itself. IOperation - (apply-to [_ situation] - (-> situation - (assoc-in [:node-data one-of-id] {:chosen chosen}) - (update :applied conj one-of-id) - (->> (apply-to chosen)))) + (apply-to [this situation] + (->> (record-choice situation this) + (apply-to chosen))) IEnumerable (-enumerate [this] [this])) @@ -566,13 +567,17 @@ setup so per-variant setups don't clobber labels). Returns a vector of the resulting situations, one per enumerated variant, in enumeration order. Makes no judgment and does not touch clojure.test — see `check` (in - `frontend-tests.composable-tests.interpreter`) for the test-facing entry point that asserts." - [{:keys [setup operation]}] - (->> (enumerate operation) - (mapv (fn [variant] - (thi/reset-idmap!) - (run-variant {:setup setup - :operation variant}))))) + `frontend-tests.composable-tests.interpreter`) for the test-facing entry point that asserts. + + `run-variant-fn` runs one variant from `{:setup :operation}` (default + `run-variant`); other runners pass their own." + ([case-map] (run-all case-map run-variant)) + ([{:keys [setup operation]} run-variant-fn] + (->> (enumerate operation) + (mapv (fn [variant] + (thi/reset-idmap!) + (run-variant-fn {:setup setup + :operation variant})))))) (defn sequence-ops @@ -594,6 +599,11 @@ :else [variant])) +(defn sequence? + "True if `op` is a `Sequence`; its ordered steps are under `:steps`." + [op] + (instance? Sequence op)) + (defn recorded-choice? "True if `op` is a one-of's enumerated choice wrapper." [op] @@ -609,3 +619,13 @@ interpreter can record the choice under it, enabling `get-choice`)." [recorded-choice] (:one-of-id recorded-choice)) + +(defn record-choice + "Record in `situation` the alternative `recorded-choice` selected, under its + one-of's identity, so `get-choice` finds it. Runners call it before applying + the chosen operation." + [situation recorded-choice] + (-> situation + (assoc-in [:node-data (choice-one-of-id recorded-choice)] + {:chosen (choice-of recorded-choice)}) + (update :applied conj (choice-one-of-id recorded-choice)))) diff --git a/common/test/common_tests/logic/composable_runner_test.cljc b/common/test/common_tests/logic/composable_runner_test.cljc new file mode 100644 index 0000000000..b75710be72 --- /dev/null +++ b/common/test/common_tests/logic/composable_runner_test.cljc @@ -0,0 +1,262 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns common-tests.logic.composable-runner-test + (:require + [app.common.files.changes-builder :as pcb] + [app.common.logic.shapes :as cls] + [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.comp.runner :as r] + [app.common.test-helpers.composable.comp.setups :as setup] + [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(t/use-fixtures :each thi/test-fixture) + +(def ^:private original "#abcdef") +(def ^:private red "#ff0000") +(def ^:private green "#00ff00") + +(defn- fill-of + [shape] + (-> shape :fills first :fill-color)) + +(t/deftest main-edit-syncs-to-clean-copy + (let [situation (r/run-variant + {:setup setup/simple-component-with-labeled-copy + :operation (n/change-property :main-child :fills red)}) + copy (setup/copy-instance situation)] + (t/is (= red (fill-of copy))) + (t/is (nil? (:touched copy))))) + +(t/deftest main-edit-without-sync-leaves-copy-stale + (let [situation (r/run-variant + {:setup setup/simple-component-with-labeled-copy + :operation (n/change-property :main-child :fills red)} + {:sync? false})] + (t/is (= red (fill-of (setup/main-instance situation)))) + (t/is (= original (fill-of (setup/copy-instance situation)))))) + +(t/deftest copy-override-survives-main-edit + (let [situation (r/run-variant + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence + [(n/change-property :copy-child :fills green) + (n/change-property :main-child :fills red)])}) + copy (setup/copy-instance situation)] + (t/is (= green (fill-of copy))) + (t/is (contains? (:touched copy) :fill-group)))) + +(t/deftest sync-cascades-through-nested-components + ;; The edit is on the deepest main. Its copy inside the outer main changes, + ;; so the outer component syncs in a second pass and reaches the outer copy. + (let [m "main" + situation (r/run-variant + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m original) + (n/make-nested-component m) + (n/make-nested-component m) + (n/instantiate-copy m) + (n/change-property (n/remote-rect-of m) :fills red)])}) + copy-rect (tm/shape-by-id situation (n/lineage-copy-rect situation m))] + (t/is (= red (fill-of copy-rect))) + (t/is (nil? (:touched copy-rect))))) + +(t/deftest undo-reverts-edit-and-its-sync + (let [situation (r/run-variant + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence + [(n/change-property :main-child :fills red) + (n/undo)])}) + copy (setup/copy-instance situation)] + (t/is (= original (fill-of (setup/main-instance situation)))) + (t/is (= original (fill-of copy))) + (t/is (nil? (:touched copy))) + (t/is (zero? (r/undo-depth situation))))) + +(t/deftest undo-reverts-the-whole-sync-cascade + (let [m "main" + situation (r/run-variant + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m original) + (n/make-nested-component m) + (n/instantiate-copy m) + (n/change-property (n/remote-rect-of m) :fills red) + (n/undo)])})] + (t/is (= original (fill-of (tm/shape-by-id situation (n/lineage-rect situation m))))) + (t/is (= original (fill-of (tm/shape-by-id situation (n/lineage-copy-rect situation m))))))) + +(t/deftest undo-reverts-only-the-latest-user-operation + (let [situation (r/run-variant + {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence + [(n/change-property :main-child :fills red) + (n/change-property :main-child :fills green) + (n/undo)])})] + (t/is (= red (fill-of (setup/main-instance situation)))) + (t/is (= red (fill-of (setup/copy-instance situation)))) + (t/is (= 1 (r/undo-depth situation))))) + +(t/deftest undo-of-a-reset-restores-the-override + (let [m "main" + situation (r/run-variant + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m original) + (n/instantiate-copy m) + (n/change-property (n/copy-rect-of m) :fills green) + (n/reset-copy-instance m) + (n/undo)])}) + copy-rect (tm/shape-by-id situation (n/lineage-copy-rect situation m))] + (t/is (= green (fill-of copy-rect))) + (t/is (contains? (:touched copy-rect) :fill-group)) + (t/is (= 1 (r/undo-depth situation))))) + +(t/deftest assembly-operations-push-no-undo-group + (let [m "main" + situation (r/run-variant + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m original) + (n/instantiate-copy m) + (n/undo)])})] + (t/is (zero? (r/undo-depth situation))) + (t/is (some? (tm/shape-by-id situation (n/lineage-copy-rect situation m)))))) + +(t/deftest added-child-reaches-copy + (let [add (n/add-child :main-root :new-child) + situation (r/run-variant + {:setup setup/simple-component-with-copy + :operation add})] + (t/is (some? (n/materialized-instance-child add situation (setup/copy-root situation)))))) + +(t/deftest undo-removes-added-child-from-main-and-copy + (let [situation (r/run-variant + {:setup setup/simple-component-with-copy + :operation (tm/in-sequence + [(n/add-child :main-root :new-child) + (n/undo)])})] + (t/is (nil? (tm/shape-by-id situation (thi/id :new-child)))) + (t/is (= 1 (count (:shapes (setup/main-root situation))))) + (t/is (= 1 (count (:shapes (setup/copy-root situation))))))) + +(defn- error-type + "The `:type` of the error that running `op` on a simple component throws, or + nil when it throws none." + [op] + (try + (r/run-variant {:setup setup/simple-component-with-copy + :operation op}) + nil + (catch #?(:clj Exception :cljs :default) e + (:type (ex-data e))))) + +(t/deftest frontend-only-operations-are-rejected + (t/is (= ::r/frontend-only (error-type (n/rotate :main-root 45)))) + (t/is (= ::r/frontend-only (error-type (n/change-height :main-root 50))))) + +;; A user operation that forgets to record its changes. +(defrecord UnrecordedEdit [] + n/IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [_ situation] situation)) + +;; An assembly operation that records changes as if it were a user operation. +(defrecord RecordingAssembly [] + n/IComponentOperation + (op-kind [_] :assembly) + + tm/IOperation + (apply-to [_ situation] (n/record-changes situation (pcb/empty-changes)))) + +(t/deftest user-operation-must-record-its-changes + (t/is (= ::r/changes-not-recorded (error-type (->UnrecordedEdit))))) + +(t/deftest only-user-operations-record-changes + (t/is (= ::r/unexpected-changes (error-type (->RecordingAssembly))))) + +;; A user operation that points the copy root at a main shape that does not +;; exist, leaving the file invalid. +(defrecord BreakCopyRef [] + n/IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [_ situation] + (let [file (tm/file situation) + page (thf/current-page file) + changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page)) + #{(:id (setup/copy-root situation))} + #(assoc % :shape-ref (uuid/next)) + (:objects page) + {})] + (-> situation + (tm/with-file (thf/apply-changes file changes :validate? false)) + (n/record-changes changes))))) + +(t/deftest settled-file-is-validated + (t/is (= :validation (error-type (->BreakCopyRef))))) + +(t/deftest run-all-records-each-choice + (let [to-red (n/change-property :main-child :fills red) + to-green (n/change-property :main-child :fills green) + choice (tm/one-of [to-red to-green]) + results (r/run-all {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [choice])})] + (t/is (= [to-red to-green] (mapv #(tm/get-choice % choice) results))) + (t/is (= [red green] (mapv (comp fill-of setup/copy-instance) results))))) + +(defn- level-fill + [situation name level] + (fill-of (tm/shape-by-id situation (n/level-rect situation name level)))) + +(def ^:private switch-scenario + ;; The variant head is nested at level 0; level 1 wraps level 0, so it holds + ;; a copy of it that only sync updates. + (let [m "main"] + [(n/create-component m original) + (n/make-variant-container "vset" [["a" original] ["b" red]]) + (n/make-nested-component-with-variant m "vset" "a") + (n/make-nested-component m) + (n/switch-variant (n/nested-head-of m 0) "b")])) + +(t/deftest variant-switch-syncs-to-outer-level + (let [situation (r/run-variant {:setup setup/empty-situation + :operation (tm/in-sequence switch-scenario)})] + (t/is (= red (level-fill situation "main" 0))) + (t/is (= red (level-fill situation "main" 1))))) + +(t/deftest variant-switch-without-sync-leaves-outer-level + (let [situation (r/run-variant {:setup setup/empty-situation + :operation (tm/in-sequence switch-scenario)} + {:sync? false})] + (t/is (= red (level-fill situation "main" 0))) + (t/is (= original (level-fill situation "main" 1))))) + +(t/deftest undo-reverts-variant-switch-and-its-sync + (let [situation (r/run-variant {:setup setup/empty-situation + :operation (tm/in-sequence (conj switch-scenario (n/undo)))})] + (t/is (= original (level-fill situation "main" 0))) + (t/is (= original (level-fill situation "main" 1))))) + +(t/deftest variant-switch-to-current-value-changes-nothing + (let [m "main" + situation (r/run-variant + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m original) + (n/make-variant-container "vset" [["a" original] ["b" red]]) + (n/make-nested-component-with-variant m "vset" "a") + (n/switch-variant (n/nested-head-of m 0) "a")])})] + (t/is (= original (level-fill situation m 0))) + (t/is (zero? (r/undo-depth situation))))) diff --git a/common/test/common_tests/logic/composable_sync_test.cljc b/common/test/common_tests/logic/composable_sync_test.cljc new file mode 100644 index 0000000000..52ee1e1844 --- /dev/null +++ b/common/test/common_tests/logic/composable_sync_test.cljc @@ -0,0 +1,59 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns common-tests.logic.composable-sync-test + "Runs the shared composable component cases through the pure runner, on the + JVM and in JS. Case N and the rotation case need the frontend placement + step, so only the frontend interpreter runs them." + (:require + [app.common.test-helpers.composable.comp.cases :as cases] + [app.common.test-helpers.composable.comp.runner :as r] + [app.common.test-helpers.composable.core :as tm] + [app.common.test-helpers.ids-map :as thi] + [clojure.test :as t])) + +(t/use-fixtures :each thi/test-fixture) + +(defn- check + "Run every variant of `case-map` and apply its asserter to each result." + [{:keys [asserter] :as case-map}] + (doseq [situation (r/run-all case-map)] + (when asserter + (t/testing (str "operations:\n " (tm/describe-applied situation)) + (asserter situation))))) + +(t/deftest case-b-copy-override-survives-later-main-change + (check (cases/copy-override-survives-later-main-change))) + +(t/deftest case-c-attribute-sweep-propagates-to-clean-copy + (check (cases/attribute-sweep-propagates-to-clean-copy))) + +(t/deftest case-d-add-shape-to-main-propagates-to-clean-copy + (check (cases/add-shape-to-main-propagates-to-clean-copy))) + +(t/deftest case-e-remove-shape-from-main-propagates-to-clean-copy + (check (cases/remove-shape-from-main-propagates-to-clean-copy))) + +(t/deftest case-f-move-shape-in-main-propagates-order-to-clean-copy + (check (cases/move-shape-in-main-propagates-order-to-clean-copy))) + +(t/deftest case-h-library-change-propagates-across-file-boundary-on-sync + (check (cases/library-change-propagates-across-file-boundary-on-sync))) + +(t/deftest case-i-undo-reverts-edit-and-its-propagation + (check (cases/undo-reverts-edit-and-its-propagation))) + +(t/deftest case-k-synchronisation-scenarios + (check (cases/synchronisation-scenarios))) + +(t/deftest case-l-swap-scenarios + (check (cases/swap-scenarios))) + +(t/deftest case-m-variant-switch-scenarios + (check (cases/variant-switch-scenarios))) + +(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree + (check (cases/variant-switch-keeps-override-only-where-mains-agree))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index 7b62b71d7c..79a74e14b2 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -62,6 +62,8 @@ [common-tests.logic.comp-reset-test] [common-tests.logic.comp-sync-test] [common-tests.logic.comp-touched-test] + [common-tests.logic.composable-runner-test] + [common-tests.logic.composable-sync-test] [common-tests.logic.copying-and-duplicating-test] [common-tests.logic.duplicated-pages-test] [common-tests.logic.move-shapes-test] @@ -165,6 +167,8 @@ 'common-tests.logic.comp-reset-test 'common-tests.logic.comp-sync-test 'common-tests.logic.comp-touched-test + 'common-tests.logic.composable-runner-test + 'common-tests.logic.composable-sync-test 'common-tests.logic.copying-and-duplicating-test 'common-tests.logic.duplicated-pages-test 'common-tests.logic.move-shapes-test diff --git a/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs b/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs index 373fb9408e..9021d81c19 100644 --- a/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs @@ -5,43 +5,19 @@ ;; Copyright (c) KALEIDOS SUBSIDIARY SL (ns frontend-tests.composable-tests.comp.sync-test - "Component-behaviour cases authored on the composable test model, run against - the REAL app (frontend interpreter). In-file propagation is AUTOMATIC: a case - contains ONLY the user edit(s) (no propagate op); the app's component-change - watcher syncs copies on its own, and that is what we assert. - - The cases (see `mem:frontend/composable-component-tests` for details): - B — an override on a copy child survives a later main change (touched gate). - C — a sweep (one-of) over several attribute changes, each auto-propagating. - D — a shape added to the main is structurally auto-propagated (ref-integrity). - E — a middle shape removed from the main; survivors keep order. - F — reordering a shape in the main; order auto-propagates, identity preserved. - H — locality: a library main's change reaches the consuming file's copy on - the explicit library sync (cross-file propagation). - I — undo reverses an edit AND its auto-propagation. - K — the synchronisation sweep: depth x edit-targets, with override-precedence - and reset checkpoints. - L — the swap sweep: swaps at any subset of nesting levels. - M — the variant-switch sweep: case L with variant switches. + "Runs the shared composable component cases + (`app.common.test-helpers.composable.comp.cases`) against the REAL app + (frontend interpreter). In-file propagation is AUTOMATIC: a case contains + ONLY the user edit(s) (no propagate op); the app's component-change watcher + syncs copies on its own, and that is what the cases assert. Async: each deftest uses `t/async`; `ftm/check` drives the store and calls `done` when finished." (:require - [app.common.geom.matrix :as gmt] - [app.common.geom.point :as gpt] - [app.common.geom.rect :as grc] - [app.common.math :as mth] - [app.common.types.component :as ctk] - [app.common.types.shape-tree :as ctst] + [app.common.test-helpers.composable.comp.cases :as cases] [cljs.test :as t :include-macros true] - [frontend-tests.composable-tests.comp.nodes :as n] - [frontend-tests.composable-tests.comp.setups :as setup] - [frontend-tests.composable-tests.core :as tm] [frontend-tests.composable-tests.interpreter :as ftm])) -(def ^:private red "#ff0000") -(def ^:private green "#00ff00") - ;; Disable thumbnail rendering for the duration of each (async) test: the ;; propagation watcher schedules thumbnail renders that reach `window`, absent in ;; the headless runner. `:each` `:after` runs only after the test's `done` fires @@ -51,383 +27,41 @@ {:before ftm/install-thumbnail-noop! :after ftm/restore-thumbnail!}) -;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.) - (t/deftest case-b-copy-override-survives-later-main-change - (t/async - done - (let [override (n/change-attr :copy-child :fills green)] ; touch the copy first - (ftm/check - done - {:setup setup/simple-component-with-labeled-copy - ;; override the copy, then change the main; the watcher auto-syncs after - ;; each edit. The override must survive (touched-flag gate). - :operation (tm/in-sequence - [override - (n/change-attr :main-child :fills red)])} - (fn [situation] - (let [copy-child (setup/copy-instance situation)] - (t/is (n/has-attr? override copy-child)) - (t/is (contains? (:touched copy-child) :fill-group)) - (t/is (some? (:shape-ref copy-child))))))))) + (t/async done (ftm/check done (cases/copy-override-survives-later-main-change)))) (t/deftest case-c-attribute-sweep-auto-propagates-to-clean-copy - (t/async - done - (let [sweep (tm/one-of - [(n/change-attr :main-child :fills red) - (n/change-attr :main-child :opacity 0.5)])] - (ftm/check - done - {:setup setup/simple-component-with-copy - :operation (tm/in-sequence [sweep])} - (fn [situation] - (let [chosen (tm/get-choice situation sweep)] - (t/is (some? chosen)) - (t/is (n/has-attr? chosen (setup/copy-instance situation))))))))) + (t/async done (ftm/check done (cases/attribute-sweep-propagates-to-clean-copy)))) (t/deftest case-d-add-shape-to-main-auto-propagates-to-clean-copy - (t/async - done - (let [add (n/add-child :main-root :main-child-2)] - (ftm/check - done - {:setup setup/simple-component-with-labeled-copy - :operation (tm/in-sequence [add])} - (fn [situation] - (let [copy-root (setup/copy-root situation) - main-new (n/added-shape add situation) - copy-new (n/materialized-instance-child add situation copy-root)] - (t/is (some? copy-new)) - (t/is (ctk/is-main-of? main-new copy-new)) - (t/is (ctst/parent-of? copy-root copy-new)) - (t/is (nil? (:touched copy-new))))))))) + (t/async done (ftm/check done (cases/add-shape-to-main-propagates-to-clean-copy)))) (t/deftest case-e-remove-shape-from-main-auto-propagates-to-clean-copy - (t/async - done - (let [removal (n/remove-child :main-child2)] - (ftm/check - done - {:setup setup/component-with-many-children - :operation (tm/in-sequence [removal])} - (fn [situation] - (let [copy-root (setup/copy-root situation) - order (vec (:shapes copy-root)) - c1 (setup/copy-child situation 1) - c3 (setup/copy-child situation 3)] - (t/is (= 2 (count order))) - (t/is (= (nth order 0) (:id c1))) - (t/is (= (nth order 1) (:id c3))) - (t/is (some? (:shape-ref c1))) - (t/is (some? (:shape-ref c3))) - (t/is (nil? (:touched c1))) - (t/is (nil? (:touched c3))) - (t/is (nil? (:touched copy-root))))))))) + (t/async done (ftm/check done (cases/remove-shape-from-main-propagates-to-clean-copy)))) (t/deftest case-f-move-shape-in-main-auto-propagates-order-to-clean-copy - (t/async - done - (let [move (n/move-child :main-child1 :main-root 2)] - (ftm/check - done - {:setup setup/component-with-many-children - :operation (tm/in-sequence [move])} - (fn [situation] - (let [copy-root (setup/copy-root situation) - order (vec (:shapes copy-root)) - c1 (setup/copy-child situation 1) - c2 (setup/copy-child situation 2) - c3 (setup/copy-child situation 3)] - (t/is (= (nth order 0) (:id c2))) - (t/is (= (nth order 1) (:id c1))) - (t/is (= (nth order 2) (:id c3))) - (t/is (some? (:shape-ref c1))) - (t/is (some? (:shape-ref c2))) - (t/is (some? (:shape-ref c3))) - (t/is (nil? (:touched c1))) - (t/is (nil? (:touched c2))) - (t/is (nil? (:touched c3))))))))) + (t/async done (ftm/check done (cases/move-shape-in-main-propagates-order-to-clean-copy)))) (t/deftest case-i-undo-reverts-edit-and-its-auto-propagation - (t/async - done - ;; UNDO axis (case I), built on case A: change the main (which auto-propagates - ;; to the clean copy), then UNDO. A single undo reverses the whole logical - ;; action — the edit AND its propagation — so the copy returns to baseline and - ;; is left untouched. Undo is just another op (`n/undo`); the engine owns - ;; reversal (frontend realisation dispatches the real `dwu/undo`). - (let [original "#abcdef" ; the labeled setup's starting fill - baseline (n/change-attr :main-child :fills original) ; expected-VALUE descriptor - change (n/change-attr :main-child :fills red)] - (ftm/check - done - {:setup setup/simple-component-with-labeled-copy - :operation (tm/in-sequence [change (n/undo)])} - (fn [situation] - (let [copy (setup/copy-instance situation) - main (setup/main-instance situation)] - ;; the edit was reversed on the main … - (t/is (n/has-attr? baseline main)) - ;; … and on the copy (the propagation was reversed too) … - (t/is (n/has-attr? baseline copy)) - ;; … leaving the copy clean. - (t/is (nil? (:touched copy))))))))) + (t/async done (ftm/check done (cases/undo-reverts-edit-and-its-propagation)))) (t/deftest case-h-library-change-propagates-across-file-boundary-on-sync - (t/async - done - ;; LOCALITY axis: the main lives in a linked LIBRARY, the copy in the consuming - ;; (current) file. The library main has diverged (setup applied `red` to it, - ;; leaving the copy stale). Unlike the in-file cases, the watcher does NOT cross the - ;; file boundary; the real app propagates via the library-UPDATE action, so the - ;; transformation is `sync-from-library` (dispatches the real `sync-file`). - ;; `expected` is only an expected-VALUE descriptor (its target is irrelevant; - ;; `has-attr?` uses just attr+value), so the asserter reads exactly like case A. - (let [expected (n/change-attr :main-child :fills red)] - (ftm/check - done - {:setup #(setup/cross-file-component-with-copy red) - :operation (tm/in-sequence [(n/sync-from-library)])} - (fn [situation] - (t/is (n/has-attr? expected (setup/copy-instance situation)))))))) - -(def ^:private blue "#0000ff") + (t/async done (ftm/check done (cases/library-change-propagates-across-file-boundary-on-sync)))) (t/deftest case-k-synchronisation-scenarios - (t/async - done - ;; CONSOLIDATED SCENARIO SWEEP — one composition standing in for many cases. - ;; Built from the sync-scenario operations on an empty situation. It sweeps: - ;; - DEPTH 0/1/2 via two independent `(optional (make-nested-component ...))` - ;; - which EDITS were made via three independent `(optional change-*)` - ;; and asserts, at INLINE checkpoints, the override-precedence and reset rules. - ;; The change targets are the tracked ROLES (:remote/:main/:copy-child-rect), so - ;; the same composition holds at any depth. Propagation is AUTOMATIC (no - ;; propagate op). Subsumes the flat/nested propagation cases (A/G/J). - (let [m "main" - change-remote (n/change-property (n/remote-rect-of m) :fills red) - change-main (n/change-property (n/main-rect-of m) :fills green) - change-copy (n/change-property (n/copy-rect-of m) :fills blue) - copy-rect (fn [s] (n/lineage-copy-rect s m)) - ;; precedence at the copy: copy override wins; else main; else remote. - expected-after-edits - (fn [s] - (cond - (tm/applied? s change-copy) (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s))) - (tm/applied? s change-main) (n/has-property-of change-main (tm/shape-by-id s (copy-rect s))) - (tm/applied? s change-remote) (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s))) - :else true))] - (ftm/check - done - {:setup setup/empty-situation - :operation (tm/in-sequence - [(n/create-component m red) - ;; depth sweep: two independent optionals give depths 0/1/2 - ;; (depth 1 appears twice — harmless) without nesting a - ;; Sequence inside an optional. - (tm/optional (n/make-nested-component m)) - (tm/optional (n/make-nested-component m)) - (n/instantiate-copy m) - (tm/optional change-remote) - (tm/optional change-main) - (tm/optional change-copy) - (tm/test-that (fn [s] (t/is (expected-after-edits s)))) - ;; force a copy override, observe it wins, then reset it away - change-copy - (tm/test-that - (fn [s] (t/is (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s)))))) - (n/reset-copy-instance m) - (tm/test-that - (fn [s] - ;; after reset: main's value if main changed, else remote's - ;; if remote changed (else the original — not asserted). - (cond - (tm/applied? s change-main) (t/is (n/has-property-of change-main (tm/shape-by-id s (copy-rect s)))) - (tm/applied? s change-remote) (t/is (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s)))) - :else true)))])})))) - -(defn- level-color - "The fill colour of the rect currently at lineage `name`'s nesting level `i`." - [s name i] - (-> (tm/shape-by-id s (n/level-rect s name i)) :fills first :fill-color)) - -(def ^:private base-color "#aaaaaa") -(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets + (t/async done (ftm/check done (cases/synchronisation-scenarios)))) (t/deftest case-l-swap-scenarios - (t/async - done - ;; SWAP SWEEP — build a 3-level nesting, then OPTIONALLY swap the nested - ;; component at each level for a differently-coloured one, and assert the colour - ;; that surfaces at every level. A swap at level i propagates (automatically, via - ;; the watcher) to level i and every OUTER (higher-index) level, until a swap at - ;; a higher level overrides it. So the colour at level i is the swap at the - ;; HIGHEST index j <= i that was applied, else the base colour. (Generalises the - ;; "single swap in copy" diagram across which levels are swapped.) - (let [m "main" - targets ["s0" "s1" "s2"] - ;; swap[i] swaps level i's nested component for target lineage i (color i) - swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3)) - expected-at - (fn [s i] - ;; the colour of the applied swap at the highest j <= i, else base - (or (some (fn [j] (when (tm/applied? s (nth swaps j)) (nth swap-colors j))) - (range i -1 -1)) - base-color))] - (ftm/check - done - {:setup setup/empty-situation - :operation (tm/in-sequence - (concat - [(n/create-component m base-color)] - ;; a target lineage per level - (map-indexed (fn [i c] (n/create-component (nth targets i) c)) swap-colors) - [(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)] - ;; optionally swap at each level - (map (fn [sw] (tm/optional sw)) swaps) - [(tm/test-that - (fn [s] - (doseq [i (range 3)] - (t/is (= (expected-at s i) (level-color s m i)) - (str "level " i)))))]))})))) + (t/async done (ftm/check done (cases/swap-scenarios)))) (t/deftest case-m-variant-switch-scenarios - (t/async - done - ;; VARIANT-SWITCH SWEEP — the variant-switch flavour of case L. Build a variant - ;; SET of peer members and nest the base member at EVERY level (so each level has - ;; a variant head, just as case L's swap target exists at every level). Then - ;; OPTIONALLY switch the variant head at each level to a differently-coloured - ;; sibling and assert the colour that surfaces at every level. A variant switch - ;; routes through the SAME component-swap as case L (keep-touched? true), so the - ;; watcher auto-propagates it identically: the colour at level i is the switch at - ;; the HIGHEST index j <= i that was applied, else the base member's colour. Same - ;; asserter as L — the test of "a variant switch propagates like a swap". - (let [m "main" ; the nesting lineage (holds the nesting-data) - vset "vset" ; the variant set - vals ["v0" "v1" "v2" "v3"] - colors (into [base-color] swap-colors) ; base + sibling colours - ;; switch[i] switches level i's variant head to member i+1 (colour i). The - ;; single variant instance has a corresponding (switchable) head at every - ;; level — `nested-head` IS the deepest instance there — so we can switch at - ;; ANY level, exactly like case L's per-level swap. - switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth vals (inc i)))) - (range 3)) - expected-at - (fn [s i] - ;; same precedence as case L: the colour at level i is the switch at the - ;; HIGHEST index j <= i that was applied (a switch propagates outward), - ;; else base. - (or (some (fn [j] (when (tm/applied? s (nth switches j)) (nth swap-colors j))) - (range i -1 -1)) - base-color))] - (ftm/check - done - {:setup setup/empty-situation - :operation (tm/in-sequence - (concat - ;; the nesting lineage, and the variant set (members = [value color]) - [(n/create-component m base-color) - (n/make-variant-container vset (mapv vector vals colors))] - ;; introduce the variant instance ONCE (innermost), then wrap it - ;; with plain nesting so each outer level CONTAINS the one below - ;; (progressive nesting, like case L's make-nested-component x3). nested-head - ;; at every level is then the variant (the deepest instance), so a - ;; switch at level i targets it and propagates OUTWARD via the - ;; watcher — exactly like case L's swap. - [(n/make-nested-component-with-variant m vset "v0") - (n/make-nested-component m) - (n/make-nested-component m)] - ;; optionally switch each level's variant head to its target sibling - (map (fn [sw] (tm/optional sw)) switches) - [(tm/test-that - (fn [s] - (doseq [i (range 3)] - (t/is (= (expected-at s i) (level-color s m i)) - (str "level " i)))))]))})))) + (t/async done (ftm/check done (cases/variant-switch-scenarios)))) + +(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree + (t/async done (ftm/check done (cases/variant-switch-keeps-override-only-where-mains-agree)))) (t/deftest case-n-geometry-sync-with-rotated-instances - ;; Regression sweep for #10109, with #13267's semantics as its complement: an - ;; instance root's transformation is inherited, overridable content — - ;; asymmetric to position, which is free per-instance placement. - ;; - ;; On the simple component-with-copy, sweep three axes: optionally rotate the - ;; COPY as a whole (an override of its root's placement — must not block - ;; propagation), optionally rotate the MAIN as a whole (inherited content — - ;; an untouched copy must follow it), and apply ONE of a property edit - ;; (fills) or a geometry edit (height) to the main child. In EVERY variant - ;; the chosen edit must arrive at the copy child; the copy's rotation is its - ;; own 45° if the copy was rotated (override wins), else the main's 45° if - ;; the main was rotated (clean copy follows), else 0; and only a rotated - ;; copy's ROOT is touched (:geometry-group) — its child merely follows and - ;; stays untouched. - (t/async - done - (let [rotate-copy (n/rotate :copy-root 45) - rotate-main (n/rotate :main-root 45) - edits (tm/one-of - [(n/change-attr :main-instance :fills red) - (n/change-height :main-instance 80)])] - (ftm/check - done - {:setup setup/simple-component-with-labeled-copy - :operation (tm/in-sequence [(tm/optional rotate-copy) - (tm/optional rotate-main) - edits])} - (fn [situation] - (let [chosen (tm/get-choice situation edits) - copy-root (setup/copy-root situation) - copy-child (setup/copy-instance situation) - expected-rotation (cond - (tm/applied? situation rotate-copy) 45 - (tm/applied? situation rotate-main) 45 - :else 0)] - ;; the chosen main edit arrived at the copy child, in every variant - (t/is (some? chosen)) - (t/is (n/has-property-of chosen copy-child)) - ;; the copy shows the expected rotation (own override > followed main > none) - (t/is (mth/close? (or (:rotation copy-root) 0) expected-rotation)) - (t/is (mth/close? (or (:rotation copy-child) 0) expected-rotation)) - ;; only a rotated copy's ROOT is an override; the child merely follows - (t/is (= (if (tm/applied? situation rotate-copy) #{:geometry-group} nil) - (:touched copy-root))) - (t/is (nil? (:touched copy-child))))))))) + (t/async done (ftm/check done (cases/geometry-sync-with-rotated-instances)))) (t/deftest case-touched-copy-child-survives-main-rotation - ;; A copy whose ROOT is rotated (a geometry override) AND whose CHILD has its - ;; own geometry override (resized) must keep the child exactly in place when the - ;; MAIN is later rotated: the child's placement is its own, shielded by its - ;; touched :geometry-group. We capture the child's position relative to the copy - ;; root before the main rotation and assert it is unchanged after. - (t/async - done - (let [before (atom nil) - rel-pos (fn [situation] - (let [child (setup/copy-instance situation) - root (setup/copy-root situation)] - (-> (gpt/subtract (grc/rect->center (:selrect child)) - (grc/rect->center (:selrect root))) - (gpt/transform (:transform-inverse root (gmt/matrix)))))) - capture (tm/test-that (fn [s] (reset! before (rel-pos s)) (t/is (some? @before))))] - (ftm/check - done - {:setup setup/simple-component-with-labeled-copy - :operation (tm/in-sequence [(n/rotate :copy-root 30) - (n/change-height :copy-instance 60) - capture - (n/rotate :main-root 40)])} - (fn [situation] - (let [copy-child (setup/copy-instance situation) - copy-root (setup/copy-root situation) - after (rel-pos situation)] - ;; both overrides are recorded as geometry touches - (t/is (contains? (:touched copy-root) :geometry-group)) - (t/is (contains? (:touched copy-child) :geometry-group)) - ;; the child keeps its own overridden height - (t/is (mth/close? (:height copy-child) 60)) - ;; and its position relative to the copy root is unchanged by the main rotation - (t/is (mth/close? (:x @before) (:x after) 0.5) (str "rel-x " (:x @before) " -> " (:x after))) - (t/is (mth/close? (:y @before) (:y after) 0.5) (str "rel-y " (:y @before) " -> " (:y after))))))))) - - + (t/async done (ftm/check done (cases/touched-copy-child-survives-main-rotation)))) diff --git a/frontend/test/frontend_tests/composable_tests/interpreter.cljs b/frontend/test/frontend_tests/composable_tests/interpreter.cljs index 905604466c..d7dcb238f0 100644 --- a/frontend/test/frontend_tests/composable_tests/interpreter.cljs +++ b/frontend/test/frontend_tests/composable_tests/interpreter.cljs @@ -7,7 +7,7 @@ (ns frontend-tests.composable-tests.interpreter "FRONTEND interpreter + test-facing `check` for the composable test model. - The generic engine lives in `frontend-tests.composable-tests.core` and the + The generic engine lives in `app.common.test-helpers.composable.core` and the component instruments (operation records, setups, role accessors, inspection methods) behind the `comp` boundary. What lives HERE is: 1. `op->events` — the event realisation of each EVENT-op: the real @@ -37,6 +37,8 @@ `setup-store`), because the watcher reads `refs/workspace-data` which derives from `st/state`. State is re-installed per variant for isolation." (:require + [app.common.test-helpers.composable.comp.nodes :as n] + [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.files :as cthf] [app.common.test-helpers.ids-map :as cthi] [app.common.test-helpers.shapes :as cths] @@ -51,8 +53,6 @@ [app.main.store :as st] [beicon.v2.core :as rx] [cljs.test :as t] - [frontend-tests.composable-tests.comp.nodes :as n] - [frontend-tests.composable-tests.core :as tm] [frontend-tests.helpers.mock :as mock] [potok.v2.core :as ptk])) @@ -119,7 +119,7 @@ (defn op->events "Map a comp operation record to the real workspace event(s) it dispatches. - `op` is one of the comp node records (frontend-tests.composable-tests.comp.nodes); + `op` is one of the comp node records (app.common.test-helpers.composable.comp.nodes); `situation` provides cross-file context (e.g. the library id) for ops that need it. @@ -267,21 +267,15 @@ (defn- record-op "Record an operation's application onto the situation (after its effect settled), re-reading the file from the store. For a RecordedChoice (one-of), record the - chosen op's application AND the choice under the one-of identity (so the - asserter's `get-choice` works), mirroring `RecordedChoice`'s own `apply-to`." + choice under the one-of identity (so the asserter's `get-choice` works) and + then the chosen op's application, in the order `RecordedChoice`'s own + `apply-to` uses." [situation op] - (let [situation (tm/with-file situation (current-file))] - (if (tm/recorded-choice? op) - (let [chosen (tm/choice-of op) - descriptor (dissoc (into {} chosen) :frontend-tests.composable-tests.core/id)] - (-> situation - ;; record the chosen op under its own identity … - (tm/record-application chosen descriptor) - ;; … and the choice under the one-of's identity, keyed for get-choice - (update :node-data assoc (tm/choice-one-of-id op) {:chosen chosen}) - (update :applied conj (tm/choice-one-of-id op)))) - (let [descriptor (dissoc (into {} op) :frontend-tests.composable-tests.core/id)] - (tm/record-application situation op descriptor))))) + (let [situation (tm/with-file situation (current-file)) + [situation op] (if (tm/recorded-choice? op) + [(tm/record-choice situation op) (tm/choice-of op)] + [situation op])] + (tm/record-application situation op (dissoc (into {} op) ::tm/id)))) (defn- op-events "The workspace events to dispatch for an op unit (a plain op or a one-of's @@ -306,32 +300,24 @@ (defn- sync-op? "Whether `op` is a SYNCHRONOUS, `apply-to`-based operation rather than one that dispatches a workspace event and needs settling. Two kinds: - - FILE-TRANSFORMING (`make-nested-component`, `skip`): a pure file-value transformation - that arranges the CONFIGURATION (deepens it, re-points roles) — applied by - running `apply-to` against the live store file and writing the result back. - The property under test is still exercised by the SUBSEQUENT real-event ops. + - FILE-TRANSFORMING: the `:assembly` nodes (see `n/IComponentOperation`) and + `skip`, which arrange the CONFIGURATION (create, nest, instantiate, + re-point roles) — applied by running `apply-to` against the live store + file and writing the result back. The property under test is still + exercised by the SUBSEQUENT real-event ops. - `Test`: an inline assertion checkpoint — its `apply-to` runs the assertion against the current situation and returns it unchanged. Both are handled by `run-sync-op` (no async settle — any store write is a synchronous UpdateEvent)." [op] (let [op (if (tm/recorded-choice? op) (tm/choice-of op) op)] - (or (instance? n/MakeNestedComponent op) - ;; the structural building blocks are also file-transforming: they arrange - ;; the configuration via the shared `apply-to`. ResetCopyInstance is also a - ;; file-op: the real reset event transitively reads browser globals (CSS - ;; vars), so it cannot run headless; the shared apply-to runs the production - ;; reset generator with validation off. - (instance? n/CreateComponent op) - (instance? n/InstantiateCopy op) - (instance? n/ResetCopyInstance op) - ;; the variant container (test-helper assembly) and variant nesting (the - ;; shared nesting helper) are file-transforming sync-ops; the SWITCH is the - ;; real `variants-switch` workspace event (handled by op->events), not here. - (instance? n/MakeVariantContainer op) - (instance? n/MakeNestedComponentWithVariant op) - (instance? tm/Skip op) - (instance? tm/Test op)))) + (or (instance? tm/Skip op) + (instance? tm/Test op) + (= :assembly (n/op-kind op)) + ;; A user operation, but the real reset event transitively reads browser + ;; globals (CSS vars), so it cannot run headless; the shared apply-to runs + ;; the production reset generator with validation off. + (instance? n/ResetCopyInstance op)))) (defn- run-sync-op "Apply a synchronous (`sync-op?`) operation: run its shared `apply-to` against a @@ -341,16 +327,10 @@ file is unchanged; for `make-nested-component`/`skip` it writes back the transformed file. Synchronous." [situation op] - (let [op' (if (tm/recorded-choice? op) (tm/choice-of op) op) - situation (tm/with-file situation (current-file)) - situation (tm/apply-to op' situation)] + (let [situation (tm/with-file situation (current-file)) + situation (tm/apply-to op situation)] (st/emit! (install-file-event (tm/file situation))) - ;; record the choice too, if this came wrapped in a one-of - (if (tm/recorded-choice? op) - (-> situation - (update :node-data assoc (tm/choice-one-of-id op) {:chosen op'}) - (update :applied conj (tm/choice-one-of-id op))) - situation))) + situation)) (defn- op-grace-ms "Extra wait AFTER an event-op has settled, before proceeding. Always zero: @@ -464,8 +444,9 @@ success (recording calls) and `rx/timer` fires instantly, so the `SyncFromLibrary` op's delayed RPC does not produce network errors. - Arities: `(check done case-map)` or `(check done case-map asserter)`." - ([done case-map] (check done case-map nil)) + Arities: `(check done case-map)`, which takes the asserter from the case + map's `:asserter`, or `(check done case-map asserter)`." + ([done case-map] (check done case-map (:asserter case-map))) ([done {:keys [setup operation]} asserter] (mock/with-mocks {rp/cmd! mock/rpc-cmd-mock