From 270d0ac35d81f014860815cb506458ce94bc9bb4 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Sat, 10 Oct 2026 19:26:04 +0200 Subject: [PATCH] :sparkles: Make the component test suites fail when their claims break A review found tests that would pass with what they test broken. - Runners: both judge one variant at a time, fail a variant with no assertion and a known-failure mark that applies nowhere, and give the asserter the state the operations produced. The pure runner validates the final file and rejects operations of unknown kind. The frontend interpreter fails a step when the store reports an event error (Potok only logs it), reports asserter errors against their case, and stops the watchers that install! starts. - Nodes drive the real code: a main root rename goes through end-rename-shape, and the clipboard's advance of nested copies is one common function, cll/advance-copied-objects, that copy-selected and both test paths call. - Cases N, AH, AI, AK, AD, AE, K, C, H, S, AY, I, Y, AX and F check what they claim; O, R and T get real sizes. - Stricter common unit tests found F60 (a repair detaches healthy copies), F61 (a switch drops a fixed-sizing size), F62 (the ref chain never stops at its target) and F63 (latent); all pinned. - Frontend library tests: the RPC double records on subscribe, the dropped commits check that nothing syncs, and the link and share tests check the events sent. - Plugin suite: OpSwap and OpDetach throw when the API call did nothing, and case AB checks that the reset head is an instance of the original component. - The composable suite memory records the new rules. --- .serena/memories/common/testing.md | 5 +- .../frontend/composable-component-tests.md | 30 ++- common/src/app/common/logic/libraries.cljc | 33 ++++ .../test_helpers/composable/comp/cases.cljc | 135 +++++++++---- .../test_helpers/composable/comp/nodes.cljc | 92 +++++---- .../test_helpers/composable/comp/runner.cljc | 120 +++++++---- .../test_helpers/composable/comp/setups.cljc | 10 +- .../composable/comp/undo_check.cljc | 68 +++++-- .../common/test_helpers/composable/core.cljc | 48 ++++- .../files/repair_components_test.cljc | 64 +++++- .../logic/composable_runner_test.cljc | 129 ++++++++++++ .../logic/composable_sync_test.cljc | 32 ++- .../logic/variants_switch_test.cljc | 16 +- .../common_tests/types/container_test.cljc | 31 ++- common/test/common_tests/types/file_test.cljc | 72 +++++-- .../app/main/data/workspace/clipboard.cljs | 34 +--- .../completion_contract_test.cljs | 13 +- .../composable_tests/interpreter.cljs | 187 ++++++++++++------ .../data/workspace_edit_watchers_test.cljs | 4 +- .../data/workspace_libraries_test.cljs | 18 +- .../data/workspace_library_links_test.cljs | 66 +++++-- .../data/workspace_library_updates_test.cljs | 28 ++- .../data/workspace_sync_barrier_test.cljs | 52 +++-- ...eResetOfNestedSwapKeepsTopCopyOverrides.ts | 9 +- .../composable-tests/operations/OpDetach.ts | 7 +- .../src/composable-tests/operations/OpSwap.ts | 7 +- 26 files changed, 977 insertions(+), 333 deletions(-) diff --git a/.serena/memories/common/testing.md b/.serena/memories/common/testing.md index 0cd0ad5eea..06f729176b 100644 --- a/.serena/memories/common/testing.md +++ b/.serena/memories/common/testing.md @@ -51,7 +51,10 @@ the helpers (`ths/update-shape`, `thc/update-component`), assert the exact set o as the backend does (validate + `cfr/repair-file` until valid, at most 10 passes, like `app.srepl.procs.file-repair`) and assert the result. Repairs that never converge are pinned with `tm/known-failure`. A deleted component's objects are reached with `ctkl/get-component data id true` -(`thc/get-component` skips deleted ones). +(`thc/get-component` skips deleted ones). Validation often reports a second code on the same +shapes, whose repair runs in the same pass: check what the repair keeps (the copies' links, not +only the component) and run the code's own repair alone (`repair-once`) so another one cannot do +its work. ## Component sync benchmark diff --git a/.serena/memories/frontend/composable-component-tests.md b/.serena/memories/frontend/composable-component-tests.md index 5b891d4448..9789d3bc63 100644 --- a/.serena/memories/frontend/composable-component-tests.md +++ b/.serena/memories/frontend/composable-component-tests.md @@ -76,8 +76,17 @@ Layout: 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). + runner; all except those that need frontend code: N, Z, AI and the rotation case (placement + step), X (pending sync), AJ (reflow), AT..AX (variant action events). + +Judging (both runners): each variant is judged before the next one runs (`r/run-each`, and the +interpreter's `check`), while the label map still names its shapes; a variant whose inline +tests and asserter make no assertion fails; a known undo failure that applies to no variant of +a runner fails (`uc/applying-marks`, `uc/check-marks-applied!`); `tm/one-of` refuses an empty +list and `tm/known-failure` a pin equal to the expected value. The asserter sees the state the +operations produced, not the one the end-of-variant round trip left. The pure runner throws on +an operation with no known kind and validates the final file; a round-trip error is recorded +with its phase and `[:error ]`. Signatures tell a nil value from an absent key. 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`. @@ -182,13 +191,16 @@ Two pure runners (no store, JVM + CLJS): (`op-ready`: the token shows on the shape) that must hold before it awaits the pending work. - `n/paste-to-root target`: the clipboard's copy (shape-refs of nested heads advanced, the skipped ref chain's touched merged) and paste at the root; the interpreter pastes `thp/simulate-copy-shape`'s data. - That helper mirrors `copy-selected`'s advance; keep them in step. A duplicate inside a copy is + The node, that helper and `copy-selected` all advance through `cll/advance-copied-objects`. A duplicate inside a copy is refused by `ctk/allow-duplicate?`, and an alt-duplication with no move makes the next edit join its undo group (it expects the drag's move), so neither models a move out of a main. - `n/undo-before-sync` (frontend-only) emits an edit and `dwu/undo` in one step, so the undo commits while the watcher still holds the edit's sync. - 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..Z, then AA..; + before running the next one (`thi/id` then points at the new run's shapes); `run-each` does, + `run-all` does not. +- `change-property` with `:name` renames as the layers panel does (`dw/end-rename-shape` in the + interpreter): the path is cleaned and a main root's component is renamed too. Case letters B..Z, then AA..; the sweeps (K: depth × edit-precedence; L: swaps; M: variant switches; N: rotated-instance geometry, on the #10109 fix branch until merged; O: switch of an overridden copy, mains agreeing or not; Q: detach at depth 0..2, nested copies stay linked; R: update-main at depth 0..2 with two copies; S: delete/restore with a copy on another page; T: duplicate a copy at depth 0..2; U: move a copy into a main with a copy; V: new edit after undo empties redo; W: `(n/undo 3)` over nested cascades; X: undo before the edit's sync, frontend only; AJ: F43, one undo after a nested sync reverts only the reflow, frontend only; Y: text override × main text change, per subgroup; Z: main child move, frontend only; AA..AE: swap outcomes asserted on values, not slot storage, so they survive the Phase 2b swap model; AF: grid cell move vs a swapped copy child, setup `grid-component-with-copy`; AG/AH/AI: ports of the plugin's slot-alignment cases, setup `component-with-sibling-instances`, check `setup/misaligned-sub-heads`; AK: update main into a grid main, F49 pinned; AL: update main renames the component (`change-property` takes `:name`); AM: update main of a swap inside a group, setup `grouped-component-with-copy`, F16 pinned; AN: flex child margin override through main edit, reset and update main, setup `flex-component-with-copy`; `change-property` takes `:margin`, which the interpreter sends as `dwsl/update-layout-child`; AO: a copy dropped into a grid cell of a main (`nest-copy` with `:cell`, sent as `dwt/move-shapes-to-frame`), F41 pinned; AP: a library main's middle child removal reaches a copy in another file (in one file, deleting a main child deletes the copies' children itself, so sync never meets the copy child), setup `cross-file-component-with-many-children`; AQ: main change reaches a copy nested in a sub-board, setup `component-nested-in-a-sub-board`; AR: variant property edits keep a member's copies as they are, then a switch finds its member by the edited properties; AS: an added variant joins the set and is a switch target; AT..AX, frontend only: transform into a variant, combine, rename a variant (F6 pinned: the transaction keeps the container commit's undo group, the copies' sync takes the main renames'), rename in layers + remove empty properties + member error, the shortcuts that add members; AY: a border radius token on a main reaches untouched copies and its removal too, F55 pinned; AZ: a nested copy pasted out of its main keeps the main's overrides) are the flagship pattern — read them before @@ -214,8 +226,10 @@ event-ops to REAL workspace events (`dwsh/update-shapes`, `dwl/component-swap` ( classification — `dwt/update-dimensions`, `dwl/detach-component`, `dwl/update-component-sync`, `dwl/delete-component`, `dwl/restore-component`, `dws/duplicate-shapes`, `dwsh/relocate-shapes` (nest-copy), `dwtx/v2-update-text-shape-content` (edit-text, the editor's on-blur commit with its automatic rename), `dwu/undo`, `dwl/sync-file`, …) and runs sync-ops' `apply-to` against the live store file; each event step goes through `ftm/await-step`, which resolves once `wrf/settled nil` (the watcher's `:sync-file` wait, opened for EVERY local commit, -plus the sync and layout/text reflow it starts) or reports `{:timeout pending}` after 2s; a -timed-out step fails the test and skips the asserter. Contract: producers must open their +plus the sync and layout/text reflow it starts) or reports `{:timeout pending}` after 10s; a +timed-out step fails the test and skips the asserter. Potok catches an error thrown by an event +and only logs it, so a step during which the store reports an error (`st/on-error`) fails too. +`ftm/fixture` stops the watchers `install!` started (`ftm/uninstall!`). Contract: producers must open their pending work synchronously while the events are processed (Potok processes sub-events synchronously); an async hop without a pending task makes steps resolve early. Tests: `frontend-tests.composable-tests.completion-contract-test` (slowed-down sync via a mocked @@ -239,8 +253,8 @@ misses it. Headless there is no DOM text measurement: `install!` starts `:text/reflow` (geometry and `:position-data` unchanged), so text steps settle. It does not reproduce what the real measurement commits (F37: `commit-position-data`). -**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 +**Caveats:** an exception in a frontend variant (inline `Test`, asserter, accessor) is reported +as an error of its case and the next variant runs. `(optional (in-sequence …))` is not flattened for the interpreter — use independent optionals (nested choices are fine). 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 diff --git a/common/src/app/common/logic/libraries.cljc b/common/src/app/common/logic/libraries.cljc index ac5a516156..a8eb5a573b 100644 --- a/common/src/app/common/logic/libraries.cljc +++ b/common/src/app/common/logic/libraries.cljc @@ -3127,6 +3127,39 @@ changes (map (d/getf objects) (:shapes obj))))))) +(defn advance-copied-objects + "The clipboard's `objects` (`selected` and their children, copied from + `page` of `file`) with the copies nested in other copies advanced: each + copy head that the copy takes out of `n` copy levels, and its children, + get the shape ref `n` levels up the ref chain and the touched groups of + the chain they skip, so they keep the values the skipped mains gave them." + [file page libraries objects selected] + (let [container (ctn/make-container page :page) + advance-shape (fn [level-delta head-id objects shape] + (let [new-shape-ref (ctf/advance-shape-ref file page libraries shape level-delta + {:include-deleted? true})] + (cond-> objects + (and (some? new-shape-ref) (not= new-shape-ref (:shape-ref shape))) + (-> (assoc-in [(:id shape) :shape-ref] new-shape-ref) + (assoc-in [(:id shape) :touched] + (ctf/get-touched-from-ref-chain-until-target-ref + container libraries shape new-shape-ref + :remove-slots? (= head-id (:id shape))))))) + advance-copy (fn [objects shape] + (if (and (ctk/instance-head? shape) (not (ctk/main-instance? shape))) + (let [level-delta (if (nil? (ctk/get-swap-slot shape)) + (ctn/get-nesting-level-delta (:objects page) shape uuid/zero) + 0)] + (if (pos? level-delta) + (reduce (partial advance-shape level-delta (:id shape)) + objects + (cfh/get-children-with-self objects (:id shape))) + objects)) + objects))] + (reduce advance-copy + objects + (mapcat #(ctn/get-child-heads objects %) selected)))) + (defn generate-duplicate-changes "Prepare objects to duplicate: generate new id, give them unique names, move to the desired position, and recalculate parents and frames as needed." diff --git a/common/src/app/common/test_helpers/composable/comp/cases.cljc b/common/src/app/common/test_helpers/composable/comp/cases.cljc index 0996ffa311..bc39ce5e68 100644 --- a/common/src/app/common/test_helpers/composable/comp/cases.cljc +++ b/common/src/app/common/test_helpers/composable/comp/cases.cljc @@ -127,9 +127,11 @@ {:setup setup/simple-component-with-copy :operation (tm/in-sequence [sweep]) :asserter (fn [situation] - (let [chosen (tm/get-choice situation sweep)] + (let [chosen (tm/get-choice situation sweep) + copy (setup/copy-instance situation)] (t/is (some? chosen)) - (t/is (n/has-property-of chosen (setup/copy-instance situation)))))})) + (t/is (n/has-property-of chosen copy)) + (t/is (nil? (:touched copy)))))})) (defn add-shape-to-main-propagates-to-clean-copy "Case D. A shape added to the main appears in the copy, linked to it and @@ -169,8 +171,8 @@ (t/is (nil? (:touched copy-root)))))})) (defn move-shape-in-main-propagates-order-to-clean-copy - "Case F. The main moves its first child to the end; the copy follows, its - children linked and untouched." + "Case F. The main moves its first child one place down; the copy follows, + its children in the main's order, linked and untouched." [] (let [move (n/move-child :main-child1 :main-root 2)] {:setup setup/component-with-many-children @@ -186,6 +188,8 @@ c1 (setup/copy-child situation 1) c2 (setup/copy-child situation 2) c3 (setup/copy-child situation 3)] + (t/is (= (:shapes (setup/main-root situation)) + (mapv #(:shape-ref (tm/shape-by-id situation %)) order))) (t/is (= (nth order 0) (:id c2))) (t/is (= (nth order 1) (:id c1))) (t/is (= (nth order 2) (:id c3))) @@ -202,7 +206,11 @@ back to the first fill and the copy is untouched." [] {:setup setup/simple-component-with-labeled-copy - :operation (tm/in-sequence [(n/change-property :main-child :fills red) (n/undo)]) + :operation (tm/in-sequence + [(n/change-property :main-child :fills red) + (tm/test-that + (fn [s] (t/is (= red (fill-color (setup/copy-instance s))) "synced before the undo"))) + (n/undo)]) :asserter (fn [situation] (let [copy (setup/copy-instance situation)] (t/is (= setup/labeled-fill (fill-color (setup/main-instance situation)))) @@ -234,7 +242,9 @@ {:setup #(setup/cross-file-component-with-copy red) :operation (tm/in-sequence [(n/sync-from-library)]) :asserter (fn [situation] - (t/is (= red (fill-color (setup/copy-instance situation)))))}) + (let [copy (setup/copy-instance situation)] + (t/is (= red (fill-color copy))) + (t/is (nil? (:touched copy)))))}) (defn synchronisation-scenarios "Case K. At nesting depth 0, 1 or 2, optionally the remote main, the main @@ -269,7 +279,10 @@ force-copy (tm/test-that (fn [s] (t/is (= blue (copy-color s))))) (n/reset-copy-instance m) - (tm/test-that (fn [s] (t/is (= (main-color s) (copy-color s)))))])})) + (tm/test-that + (fn [s] + (t/is (= (main-color s) (copy-color s))) + (t/is (empty? (:touched (tm/shape-by-id s (n/lineage-copy-rect s m)))))))])})) (defn- level-color "The fill of the rect at lineage `name`'s nesting level `i`." @@ -350,8 +363,8 @@ 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]]) + agree (n/make-variant-container "vset" [["a" base-color] ["b" base-color]] :size 100) + differ (n/make-variant-container "vset" [["a" base-color] ["b" red]] :size 100) 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)))) @@ -362,7 +375,7 @@ (d/seek #(= b-rect (:shape-ref %)) (vals objects))))] {:setup setup/empty-situation :operation (tm/in-sequence - [(n/create-component m base-color) + [(n/create-component m base-color :size 100) (tm/one-of [agree differ]) (n/make-nested-component-with-variant m "vset" "a") (n/instantiate-copy m) @@ -428,7 +441,7 @@ other-override (n/change-property (n/nth-copy-rect-of m 1) :fills blue)] {:setup setup/empty-situation :operation (tm/in-sequence - [(n/create-component m red) + [(n/create-component m red :size 100) (depth-sweep m) (n/instantiate-copy m) (n/instantiate-copy m) @@ -482,6 +495,7 @@ other (setup/other-page-copy-instance s)] (t/is (= blue (fill-color (setup/main-instance s)))) (t/is (= (if (tm/applied? s override) green blue) (fill-color copy))) + (t/is (= (when (tm/applied? s override) #{:fill-group}) (:touched copy))) (t/is (= blue (fill-color other))) (t/is (nil? (:touched other)))))})) @@ -498,7 +512,7 @@ change-main (n/change-property (n/main-rect-of m) :fills blue)] {:setup setup/empty-situation :operation (tm/in-sequence - [(n/create-component m red) + [(n/create-component m red :size 100) (depth-sweep m) (n/instantiate-copy m) (tm/optional override) @@ -658,6 +672,7 @@ (let [copy (setup/copy-instance s) main (setup/main-instance s) edited (tm/get-choice s copy-edit)] + (t/is (n/has-property-of (tm/get-choice s main-edit) main)) (doseq [edit [:text :font-size]] (t/is (= (if (= edit (:edit edited)) (:value edited) @@ -788,7 +803,8 @@ "Case AD. Of two copies, the first swaps its nested copy and pushes that to the main (update main). Per the swap model of decision (h), update main pushes the copy's component: the main's nested copy becomes an instance of - it, and so does the second copy's." + it, and so do the nested copies of both copies; the first one references + the main's new nested copy and has nothing touched (F16)." [] (let [m "main" main-nested (n/nested-head-under (n/main-head-of m)) @@ -804,16 +820,26 @@ (n/swap-shape first-nested "s1") (n/update-main (n/nth-copy-head-of m 0))]) :asserter (fn [s] - (let [s1 (n/lineage-component-id s "s1")] + (let [s1 (n/lineage-component-id s "s1") + first (tm/shape-by-id s (first-nested s))] (t/is (= s1 (head-component s main-nested))) + (t/is (= s1 (head-component s first-nested))) + (t/is (= red (head-rect-color s first-nested))) + (t/is (= (main-nested s) (:shape-ref first))) + ;; update main leaves the swapped child its swap slot + (tm/known-failure "F16" #{} #{:swap-slot} + (into #{} + (map #(if (ctk/swap-slot? %) :swap-slot %)) + (:touched first))) (t/is (= s1 (head-component s second-nested))) (t/is (= red (head-rect-color s second-nested)))))})) (defn detached-or-duplicated-swapped-copy-follows-its-component "Case AE. A copy swaps its nested copy; then the copy is detached, or duplicated; then the main of the component it swapped to changes. Detached, - the nested copy becomes a top-level copy of that component; duplicated, the - duplicate's nested copy is one too. Either way it follows the change." + the root loses its link and the nested copy becomes a top-level copy of + that component, with no swap slot; duplicated, the duplicate's nested copy + is one too. Either way it follows the change." [] (let [m "main" nested (n/nested-head-in m) @@ -832,6 +858,13 @@ (let [s1 (n/lineage-component-id s "s1")] (t/is (= s1 (head-component s nested))) (t/is (= blue (head-rect-color s nested))) + (when-not (tm/applied? s duplication) + ;; the detached root lost its link; its nested copy is a + ;; top-level copy now, with no swap slot + (let [head (tm/shape-by-id s (nested s))] + (t/is (nil? (:component-id (tm/shape-by-id s ((n/copy-head-of m) s))))) + (t/is (:component-root head)) + (t/is (nil? (ctk/get-swap-slot head))))) (when (tm/applied? s duplication) (t/is (= s1 (head-component s dup-nested))) (t/is (= blue (head-rect-color s dup-nested))))))})) @@ -872,17 +905,26 @@ :asserter (fn [s] (t/is (= [] (setup/misaligned-sub-heads s))))})) +(defn- deleted-copy-child-is-hidden + "Assert that the copy child the one-of `removal` deleted, if it ran, is + still there and hidden: a copy keeps the main's structure." + [s removal] + (when-let [chosen (tm/get-choice s removal)] + (t/is (:hidden (tm/shape-by-id s (tm/resolve-shape-id s (:target chosen))))))) + (defn copy-sub-head-delete-keeps-others-aligned "Case AH (the plugin's CopySubheadDeletePreservesSlots, without its reflow). A grid main holds three nested copies; its copy optionally deletes - its first or its last one. The copy's remaining children still reference - the main's children at the same positions." + its first or its last one. A copy keeps the main's structure, so the + deleted child stays, hidden, and every child still references the main's + child at the same position." [] - {:setup #(setup/component-with-sibling-instances :grid) - :operation (tm/in-sequence [(tm/optional (tm/one-of [(n/remove-child :copy-sub1) - (n/remove-child :copy-sub3)]))]) - :asserter (fn [s] - (t/is (= [] (setup/misaligned-sub-heads s))))}) + (let [removal (tm/one-of [(n/remove-child :copy-sub1) (n/remove-child :copy-sub3)])] + {:setup #(setup/component-with-sibling-instances :grid) + :operation (tm/in-sequence [(tm/optional removal)]) + :asserter (fn [s] + (t/is (= [] (setup/misaligned-sub-heads s))) + (deleted-copy-child-is-hidden s removal))})) (defn copy-sub-head-delete-and-reflow-keeps-others-aligned "Case AI (frontend only; the plugin's CopySubheadDeletePreservesSlots @@ -890,12 +932,13 @@ which reflows its grid. The copy's remaining children still reference the main's children at the same positions." [] - {:setup #(setup/component-with-sibling-instances :grid) - :operation (tm/in-sequence [(tm/optional (tm/one-of [(n/remove-child :copy-sub1) - (n/remove-child :copy-sub3)])) - (tm/optional (n/change-height :copy-root 500))]) - :asserter (fn [s] - (t/is (= [] (setup/misaligned-sub-heads s))))}) + (let [removal (tm/one-of [(n/remove-child :copy-sub1) (n/remove-child :copy-sub3)])] + {:setup #(setup/component-with-sibling-instances :grid) + :operation (tm/in-sequence [(tm/optional removal) + (tm/optional (n/change-height :copy-root 500))]) + :asserter (fn [s] + (t/is (= [] (setup/misaligned-sub-heads s))) + (deleted-copy-child-is-hidden s removal))})) (defn- grid-placement "The cells of grid board `board`, as `{column [child-shape ...]}`." @@ -937,7 +980,10 @@ [cells in-col-3]) (do (t/is (= {:stray #{} :uncelled 0} cells)) - (t/is (= expected in-col-3)))) + (t/is (= expected in-col-3)) + ;; both main children instantiate the same component + (t/is (= [(:shape-ref copy-child)] (mapv :id (get placement 3)))) + (t/is (empty? (get placement 1))))) (t/is (empty? (:touched (tm/role-shape s :copy-root))))))})) (defn update-main-renames-the-component @@ -1256,7 +1302,8 @@ transform (n/transform-in-variant main) shortcut (n/variant-shortcut :create-component [main]) ;; renaming the main to the path's first part syncs the copy's name - ;; in an undo entry of its own: one undo reverts only that sync + ;; in an undo entry of its own: one undo reverts only that sync, so + ;; the component keeps the name and path the transform gave it f6 (fn [op] {:bug "F6" :fails {:undo #{[:object :sync-main-head :frame-id] @@ -1268,6 +1315,7 @@ [:object :unlabelled :extra] [:object :unlabelled :shapes] [:component :sync-main-component :name] + [:component :sync-main-component :path] [:component :sync-main-component :variant-id] [:component :sync-main-component :variant-properties] [:component :unlabelled :extra]} @@ -1486,8 +1534,14 @@ sweep]) :asserter (fn [s] (let [members (n/variant-component-ids s (n/variant-set-id s vset)) - added (count (get-in (tm/get-choice s sweep) [:params :targets]))] - (t/is (= (+ 2 added) (count members))) + targets (get-in (tm/get-choice s sweep) [:params :targets]) + color (fn [component-id] + (let [component (ctkl/get-component (:data (tm/file s)) component-id)] + (fill-color (head-rect s (constantly (:main-instance-id component))))))] + (t/is (= (+ 2 (count targets)) (count members))) + ;; a duplicate keeps its source's rect fill + (t/is (= (frequencies (concat [base-color red] (map {a base-color b red} targets))) + (frequencies (map color members)))) (t/is (apply distinct? (map #(n/component-properties s %) members))) (variant-copy-checks s nested (n/variant-member-component-id s vset "a") green)))})) @@ -1583,7 +1637,9 @@ (t/is (empty? (:applied-tokens main))) (t/is (= 30 (:r1 main))) (if (tm/applied? s own) - (t/is (n/has-token? copy "radius.s" 10)) + (do + (t/is (n/has-token? copy "radius.s" 10)) + (t/is (contains? (:touched copy) :radius-group))) (do (t/is (empty? (:applied-tokens copy))) (t/is (= 30 (:r1 copy))) @@ -1598,7 +1654,7 @@ follows untouched." [] (let [rotate-copy (n/rotate :copy-root 45) - rotate-main (n/rotate :main-root 45) + rotate-main (n/rotate :main-root 30) edits (tm/one-of [(n/change-property :main-instance :fills red) (n/change-height :main-instance 80)])] @@ -1612,7 +1668,7 @@ copy-child (setup/copy-instance situation) expected-rotation (cond (tm/applied? situation rotate-copy) 45 - (tm/applied? situation rotate-main) 45 + (tm/applied? situation rotate-main) 30 :else 0)] (t/is (some? chosen)) (t/is (n/has-property-of chosen copy-child)) @@ -1642,10 +1698,12 @@ moved? (tm/applied? s copy-move)] (if moved? (do - (t/is (= (mapv - main-offset [10 5]) (mapv - copy-offset [7 3]))) + (t/is (every? true? (map mth/close? + (mapv - main-offset [10 5]) + (mapv - copy-offset [7 3])))) (t/is (contains? (:touched (setup/copy-instance s)) :geometry-group))) (do - (t/is (= main-offset copy-offset)) + (t/is (every? true? (map mth/close? main-offset copy-offset))) (t/is (empty? (:touched (setup/copy-instance s)))))) (t/is (empty? (:touched (setup/copy-root s))))))})) @@ -1671,6 +1729,7 @@ (let [copy-child (setup/copy-instance situation) copy-root (setup/copy-root situation) after (rel-pos situation)] + (t/is (mth/close? (:rotation copy-root) 30)) (t/is (contains? (:touched copy-root) :geometry-group)) (t/is (contains? (:touched copy-child) :geometry-group)) (t/is (mth/close? (:height copy-child) 60)) diff --git a/common/src/app/common/test_helpers/composable/comp/nodes.cljc b/common/src/app/common/test_helpers/composable/comp/nodes.cljc index a9ac8d2665..8374294141 100644 --- a/common/src/app/common/test_helpers/composable/comp/nodes.cljc +++ b/common/src/app/common/test_helpers/composable/comp/nodes.cljc @@ -22,6 +22,7 @@ [app.common.logic.variant-properties :as clvp] [app.common.logic.variants :as clv] [app.common.math :as mth] + [app.common.path-names :as cpn] [app.common.test-helpers.components :as thc] [app.common.test-helpers.composable.core :as tm] [app.common.test-helpers.compositions :as tho] @@ -32,7 +33,6 @@ [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] - [app.common.types.file :as ctf] [app.common.types.modifiers :as ctm] [app.common.types.shape.layout :as ctl] [app.common.types.shape.radius :as ctsr] @@ -105,11 +105,19 @@ :fills (-> shape :fills first :fill-color) :opacity (:opacity shape) :name (:name shape) - :margin (-> shape :layout-item-margin :m1) + :margin (when (= :simple (:layout-item-margin-type shape)) + (let [{:keys [m1 m2 m3 m4]} (:layout-item-margin shape)] + (when (= m1 m2 m3 m4) m1))) (throw (ex-info (str "read-property: unsupported property " (pr-str property) " (supported: :fills, :opacity, :name, :margin)") {:property property})))) +(defn- applied-value* + "The value a change of `property` to `value` leaves: a rename cleans the + path, as the layers panel does." + [property value] + (if (= :name property) (cpn/clean-path value) value)) + (defrecord ChangeProperty [target property value] IComponentOperation (op-kind [_] :user) @@ -119,12 +127,17 @@ (let [the-file (tm/file situation) shape-id (tm/target-shape-id situation target) page (thf/current-page the-file) - changes (cls/generate-update-shapes - (pcb/empty-changes nil (:id page)) - #{shape-id} - (fn [shape] (set-property shape property value)) - (:objects page) - {}) + shape (get-in page [:objects shape-id]) + value' (applied-value* property value) + changes (cond-> (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) + #{shape-id} + (fn [shape] (set-property shape property value')) + (:objects page) + {}) + ;; renaming a main root renames its component too + (and (= :name property) (ctk/main-instance? shape)) + (cll/generate-rename-component (:component-id shape) value' (:data the-file))) file' (thf/apply-changes the-file changes)] (-> situation (tm/with-file file') @@ -148,9 +161,9 @@ (extend-type ChangeProperty IPropertyCheck (applied-property [node] (:property node)) - (applied-value [node] (:value node)) + (applied-value [node] (applied-value* (:property node) (:value node))) (has-property-of [node shape] - (= (:value node) (read-property shape (:property node))))) + (= (applied-value node) (read-property shape (:property node))))) ;; --------------------------------------------------------------------------- ;; edit-text — edit the content of a text shape @@ -914,14 +927,18 @@ (defn- new-subtree-head "The id of the shape in `page-after` that is not in `page-before` but whose - parent is: the head of the one subtree added between them." + parent is: the head of the one subtree added between them. Throws when + there is not exactly one, as when the sync also added children to copies." [page-before page-after] - (let [before (:objects page-before)] - (->> (vals (:objects page-after)) - (filter #(and (not (contains? before (:id %))) - (contains? before (:parent-id %)))) - (map :id) - (first)))) + (let [before (:objects page-before) + heads (->> (vals (:objects page-after)) + (filter #(and (not (contains? before (:id %))) + (contains? before (:parent-id %)))) + (map :id))] + (when-not (= 1 (count heads)) + (throw (ex-info (str "Expected one new subtree, found " (count heads)) + {:type ::new-subtree-head :heads heads}))) + (first heads))) (defrecord Duplicate [target] IComponentOperation @@ -938,6 +955,10 @@ shape-id (tm/target-shape-id situation target) page (thf/current-page the-file) objects (:objects page) + _ (when-not (ctk/allow-duplicate? objects (get objects shape-id)) + ;; the frontend's `duplicate-shapes` drops it and does nothing + (throw (ex-info "The shape cannot be duplicated (inside a copy)" + {:type ::duplicate-refused :target target}))) changes (-> (pcb/empty-changes nil) (cll/generate-duplicate-changes objects page @@ -978,29 +999,12 @@ (defn- copied-objects "The subtree of `id` as the clipboard copies it." [file page libraries id] - (let [objects (:objects page) - container (ctn/make-container page :page) - advance (fn [delta copied shape] - (let [new-ref (ctf/advance-shape-ref file page libraries shape delta - {:include-deleted? true})] - (cond-> copied - (and (some? new-ref) (not= new-ref (:shape-ref shape))) - (-> (assoc-in [(:id shape) :shape-ref] new-ref) - (assoc-in [(:id shape) :touched] - (ctf/get-touched-from-ref-chain-until-target-ref - container libraries shape new-ref)))))) - copied (into {} (map (juxt :id identity)) (cfh/get-children-with-self objects id))] - (reduce (fn [copied head] - (if (and (ctk/instance-head? head) (not (ctk/main-instance? head))) - (let [delta (if (nil? (ctk/get-swap-slot head)) - (ctn/get-nesting-level-delta objects head uuid/zero) - 0)] - (if (pos? delta) - (reduce (partial advance delta) copied (cfh/get-children-with-self objects (:id head))) - copied)) - copied)) - copied - (ctn/get-child-heads copied id)))) + (cll/advance-copied-objects file + page + libraries + (into {} (map (juxt :id identity)) + (cfh/get-children-with-self (:objects page) id)) + [id])) (defrecord PasteToRoot [target] IComponentOperation @@ -1067,7 +1071,8 @@ page (thf/current-page the-file) changes (cls/generate-relocate (-> (pcb/empty-changes nil) (pcb/with-page-id (:id page)) - (pcb/with-objects (:objects page))) + (pcb/with-objects (:objects page)) + (pcb/with-library-data (:data the-file))) parent-id (nest-target-index situation parent-id) #{copy-id} @@ -1836,7 +1841,7 @@ page (thf/current-page the-file) [_all-parents changes] (cls/generate-delete-shapes (pcb/empty-changes) - the-file + (:data the-file) page (:objects page) #{shape-id} @@ -1874,7 +1879,8 @@ changes (cls/generate-relocate (-> (pcb/empty-changes nil) (pcb/with-page-id (:id page)) - (pcb/with-objects (:objects page))) + (pcb/with-objects (:objects page)) + (pcb/with-library-data (:data the-file))) parent-id to-index #{shape-id}) diff --git a/common/src/app/common/test_helpers/composable/comp/runner.cljc b/common/src/app/common/test_helpers/composable/comp/runner.cljc index afe767aad9..5937a957ac 100644 --- a/common/src/app/common/test_helpers/composable/comp/runner.cljc +++ b/common/src/app/common/test_helpers/composable/comp/runner.cljc @@ -188,12 +188,29 @@ (let [[situation group] (redo-group situation)] (tm/record-application situation op {:redone (count group)}))) +(def ^:private op-kinds + #{:assembly :user :undo :redo :frontend-only}) + (defn- op-kind "The kind of a leaf operation (see `n/IComponentOperation`), or nil for an - engine operation such as `Test` or `Skip`." + engine operation (`Test`, `Skip`). Throws for any other operation or kind, + which the runner would neither sync nor check." [op] - (when (satisfies? n/IComponentOperation op) - (n/op-kind op))) + (cond + (satisfies? n/IComponentOperation op) + (let [kind (n/op-kind op)] + (when-not (contains? op-kinds kind) + (throw (ex-info (str "Unknown operation kind " (pr-str kind)) + {:type ::unknown-op-kind :op op :kind kind}))) + kind) + + (tm/engine-op? op) + nil + + :else + (throw (ex-info (str (pr-str (type op)) " does not implement " + "`n/IComponentOperation`") + {:type ::unknown-op :op op})))) (defn- check-recorded-changes! "Throw unless `op` recorded its changes exactly when it is a user operation." @@ -227,48 +244,69 @@ [situation] (uc/snapshot (tm/file situation))) -(defn- try-round-trip - "Run `round-trip` (situation -> situation) on `situation`. When it throws, - record the error as a failure of `phase` at `step` and return `situation` - unchanged." - [situation step phase round-trip] +(defn- attempt + "`[(f) nil]`, or `[nil error]` when `f` throws." + [f] (try - (round-trip situation) - (catch #?(:clj Exception :cljs :default) e - (uc/add-error situation step phase (str (ex-message e) " " (pr-str (ex-data e))))))) + [(f) nil] + (catch #?(:clj Throwable :cljs :default) e + [nil e]))) + +(defn- round-trip-phase + "Run `f` (situation -> situation) on `from` as round-trip `phase` at `step`. + Returns `[situation nil]`, or, when `f` throws, `[nil failed]`, with + `failed` the situation the variant goes on from (`back-to`) holding the + failures of `from` plus the error." + [from back-to step phase f] + (let [[result e] (attempt #(f from))] + (if e + [nil (uc/with-failures-of + back-to + (uc/add-error from step phase (str (ex-message e) " " (pr-str (ex-data e))) + (or (:type (ex-data e)) :exception)))] + [result nil]))) (defn- check-step "The round trip of user step `op` (see `uc`): `before` is the normalized - file before it and `depth` the undo depth before it." + file before it and `depth` the undo depth before it. The variant goes on + from the redone situation, or from the one after the step when undo or + redo throws." [situation op before depth] (let [step (uc/step situation op) after (snapshot situation)] (if (= depth (undo-depth situation)) (uc/compare-states situation step :no-undo-entry before after) - (try-round-trip - situation step :undo - (fn [situation] - (let [undone (first (undo-group situation)) - undone (uc/compare-states undone step :undo before (snapshot undone)) - redone (first (redo-group undone))] - (uc/compare-states redone step :redo after (snapshot redone)))))))) + (let [[undone failed] (round-trip-phase situation situation step :undo + (comp first undo-group))] + (or failed + (let [undone (uc/compare-states undone step :undo before (snapshot undone)) + [redone failed] (round-trip-phase undone situation step :redo + (comp first redo-group))] + (or failed + (uc/compare-states redone step :redo after (snapshot redone))))))))) (defn- check-variant "The end-of-variant round trip (see `uc`): undo back to the baseline, then - redo all." + redo all. Returns `situation` with the failures the round trip found, so + the asserter judges the state the operations produced." [situation] (let [{:keys [depth] :as baseline} (uc/baseline situation) times (- (undo-depth situation) depth) - final (snapshot situation)] + final (snapshot situation) + times-of (fn [f] #(nth (iterate (comp first f) %) times))] + (assert (not (neg? times)) "the undo stack is below the round trip's baseline") (if (pos? times) - (try-round-trip - situation nil :variant-undo - (fn [situation] - (let [undone (nth (iterate (comp first undo-group) situation) times) - undone (uc/compare-states undone nil :variant-undo - (:snapshot baseline) (snapshot undone)) - redone (nth (iterate (comp first redo-group) undone) times)] - (uc/compare-states redone nil :variant-redo final (snapshot redone))))) + (let [[undone failed] (round-trip-phase situation situation nil :variant-undo + (times-of undo-group))] + (or failed + (let [undone (uc/compare-states undone nil :variant-undo + (:snapshot baseline) (snapshot undone)) + [redone failed] (round-trip-phase undone situation nil :variant-redo + (times-of redo-group))] + (uc/with-failures-of + situation + (or failed + (uc/compare-states redone nil :variant-redo final (snapshot redone))))))) situation))) (defn- mark-baseline @@ -344,13 +382,16 @@ (let [opts (merge default-opts {:undo-check? (uc/enabled? case-map)} opts)] - (if (:undo-check? opts) - (-> (setup) - (uc/with-runner :pure) - (mark-baseline) - (run-op operation opts) - (check-variant)) - (run-op (setup) operation opts))))) + (cond-> (if (:undo-check? opts) + (-> (setup) + (uc/with-runner :pure) + (mark-baseline) + (run-op operation opts) + (check-variant)) + (run-op (setup) operation opts)) + ;; assembly steps and a user step that changed nothing are not + ;; validated on their own + (:sync? opts) (validate-settled!))))) (defn run-all "Enumerate `operation` into its concrete variants and run each with @@ -359,3 +400,10 @@ ([case-map] (run-all case-map {})) ([case-map opts] (tm/run-all case-map #(run-variant (merge case-map %) opts)))) + +(defn run-each + "Run every variant of `case-map` with `run-variant` and call `f` on its + situation before the next variant runs (see `tm/run-each`)." + ([case-map f] (run-each case-map {} f)) + ([case-map opts f] + (tm/run-each case-map #(run-variant (merge case-map %) opts) f))) diff --git a/common/src/app/common/test_helpers/composable/comp/setups.cljc b/common/src/app/common/test_helpers/composable/comp/setups.cljc index a1abe8c0fb..5ddbbbb5b1 100644 --- a/common/src/app/common/test_helpers/composable/comp/setups.cljc +++ b/common/src/app/common/test_helpers/composable/comp/setups.cljc @@ -246,14 +246,16 @@ (defn misaligned-sub-heads "The indices of the copy root's children whose :shape-ref is not the main - root's child at the same index (positional alignment)." + root's child at the same index (positional alignment), plus `:count` when + the copy and the main have a different number of children." [situation] (let [main (:shapes (main-root situation)) copy (:shapes (copy-root situation)) ref #(:shape-ref (tm/shape-by-id situation %))] - (->> (map vector (range) copy main) - (remove (fn [[_ c m]] (= m (ref c)))) - (mapv first)))) + (cond-> (->> (map vector (range) copy main) + (remove (fn [[_ c m]] (= m (ref c)))) + (mapv first)) + (not= (count copy) (count main)) (conj :count)))) (defn component-with-many-children diff --git a/common/src/app/common/test_helpers/composable/comp/undo_check.cljc b/common/src/app/common/test_helpers/composable/comp/undo_check.cljc index 00bab266d6..807c69eeed 100644 --- a/common/src/app/common/test_helpers/composable/comp/undo_check.cljc +++ b/common/src/app/common/test_helpers/composable/comp/undo_check.cljc @@ -80,12 +80,15 @@ (defn add-error "Record that the round trip could not run `phase` at `step` (see `step`; - nil for the end-of-variant phases): `error` says why." - [situation step phase error] - (add-failure situation {:phase phase - :step step - :signature #{[:error]} - :error error})) + nil for the end-of-variant phases): `error` says why and `kind`, when + given, names the error in the signature (the `:type` of its ex-data)." + ([situation step phase error] + (add-error situation step phase error nil)) + ([situation step phase error kind] + (add-failure situation {:phase phase + :step step + :signature #{(cond-> [:error] kind (conj kind))} + :error error}))) (defn- labelled "`value` with every uuid replaced by its test label. Labels are valid only @@ -102,11 +105,13 @@ (defn- differing-keys "The keys, other than those in `skip`, whose values differ between the maps - `expected` and `actual`." + `expected` and `actual`, or that only one of them holds (a nil value + differs from an absent key)." [expected actual skip] (->> (into (set (keys expected)) (keys actual)) (remove skip) - (filter #(not= (get expected %) (get actual %))))) + (filter #(or (not= (contains? expected %) (contains? actual %)) + (not= (get expected %) (get actual %)))))) (defn- entities-signature "What differs between the maps of entities by id `expected` and `actual`: @@ -158,7 +163,8 @@ situation (add-failure situation {:phase phase :step step - :signature (signature expected actual) + :signature (or (not-empty (signature expected actual)) + #{[:unexplained]}) :diff (labelled (thn/diff expected actual))}))) (defn compare-index @@ -178,6 +184,12 @@ [situation] (get situation ::failures [])) +(defn with-failures-of + "`situation` with the failures recorded in `other`, a later situation of + the same variant." + [situation other] + (assoc situation ::failures (failures other))) + (defn- matches? "Whether the known failure `mark` pins `failure` exactly." [{:keys [fails op]} failure] @@ -194,20 +206,42 @@ {:type ::unpinned-mark :mark mark})))) +(defn- for-runner? + [{:keys [runners]} runner] + (or (nil? runners) (contains? runners runner))) + +(defn applying-marks + "The known failures of `case-map` that apply to `situation`, one of its + variants: marks of its runner whose `:op` ran and whose `:when` holds." + [situation case-map] + (let [marks (get-in case-map [:undo-check :known-failures])] + (run! check-mark! marks) + (filterv (fn [{:keys [op] pred :when :as mark}] + (and (for-runner? mark (::runner situation)) + (or (nil? op) (tm/applied? situation op)) + (or (nil? pred) (pred situation)))) + marks))) + +(defn check-marks-applied! + "Assert that every known failure of `case-map` for `runner` applied to at + least one variant; `applied` holds the marks that did (see + `applying-marks`). A mark that applies nowhere pins nothing." + [case-map runner applied] + (when (enabled? case-map) + (doseq [{:keys [bug] :as mark} (get-in case-map [:undo-check :known-failures]) + :when (and (for-runner? mark runner) + (not (contains? (set applied) mark)))] + (t/is false (str "Known undo failure " bug " applies to no variant of the " + (name runner) " runner"))))) + (defn verdict "The failures of `situation`, a variant of `case-map`, that no known failure of the case pins (`:unexpected`), and the pinned phases of the known failures that apply to the variant but did not fail as pinned (`:resolved`, each the mark with its `:phase`)." [situation case-map] - (let [marks (get-in case-map [:undo-check :known-failures]) - _ (run! check-mark! marks) - applies? (fn [{:keys [op runners] pred :when}] - (and (or (nil? runners) (contains? runners (::runner situation))) - (or (nil? op) (tm/applied? situation op)) - (or (nil? pred) (pred situation)))) - known (filter applies? marks) - found (failures situation)] + (let [known (applying-marks situation case-map) + found (failures situation)] {:unexpected (filterv (fn [failure] (not-any? #(matches? % failure) known)) found) :resolved (vec (for [mark known phase (keys (:fails mark)) diff --git a/common/src/app/common/test_helpers/composable/core.cljc b/common/src/app/common/test_helpers/composable/core.cljc index c66cb81198..ad99ed74a5 100644 --- a/common/src/app/common/test_helpers/composable/core.cljc +++ b/common/src/app/common/test_helpers/composable/core.cljc @@ -357,8 +357,11 @@ (defn one-of "Constructor for the one-of operator: one case per alternative of - `alternatives`. Ask it which one ran with `get-choice`." + `alternatives`. Ask it which one ran with `get-choice`. Throws when there + is no alternative, which would leave the case with no variant." [alternatives] + (when (empty? alternatives) + (throw (ex-info "one-of with no alternatives" {:type ::empty-one-of}))) (assign-id (->OneOf (vec alternatives)))) (defrecord Skip [] @@ -409,18 +412,49 @@ (->> (setup) (apply-to operation))) +(defn- variants + "The concrete variants of `operation`. Throws when there is none." + [operation] + (let [variants (enumerate operation)] + (when (empty? variants) + (throw (ex-info "The operation has no variant" {:type ::no-variants}))) + variants)) + (defn run-all "The resulting situations of every variant of `operation`, in order, each run by `run-variant-fn` (default `run-variant`) on `{:setup :operation}` - with a fresh label map." + with a fresh label map. Labels name the shapes of the last variant only: + to judge each variant, use `run-each`." ([case-map] (run-all case-map run-variant)) ([{:keys [setup operation]} run-variant-fn] - (->> (enumerate operation) + (->> (variants operation) (mapv (fn [variant] (thi/reset-idmap!) (run-variant-fn {:setup setup :operation variant})))))) +(defn run-each + "Run every variant of `operation` with `run-variant-fn` on `{:setup + :operation}`, each with a fresh label map, and call `f` on its situation + before the next variant runs, while labels still name its shapes." + [{:keys [setup operation]} run-variant-fn f] + (doseq [variant (variants operation)] + (thi/reset-idmap!) + (f (run-variant-fn {:setup setup + :operation variant})))) + +(defn counting-assertions + "Call `f` with an atom that counts the assertions (passed, failed or + errored) reported while `f` runs; `f` may reset it." + [f] + (let [made (atom 0) + report t/report] + (binding [t/report (fn [m] + (when (contains? #{:pass :fail :error} (:type m)) + (swap! made inc)) + (report m))] + (f made)))) + (defn sequence-ops "The steps of the concrete `variant`, in order, with sequences flattened. A `RecordedChoice` stays one step, so an interpreter can record the choice @@ -433,6 +467,11 @@ :else [variant])) +(defn engine-op? + "Whether `op` is a leaf operation of the engine (`Test` or `Skip`)." + [op] + (or (instance? Test op) (instance? Skip op))) + (defn sequence? "Whether `op` is a `Sequence`; its steps are under `:steps`." [op] @@ -473,6 +512,9 @@ found. While the bug is open, `actual` must be exactly `pinned`, the wrong value the bug gives; any other value fails, `expected` included." [bug expected pinned actual] + (when (= expected pinned) + (throw (ex-info (str "Known failure " bug " pins the expected value") + {:type ::pin-equals-expected :bug bug :value pinned}))) (t/is (= pinned actual) (str "Known failure " bug ": expected " (pr-str expected) ", pinned to the bug's " (pr-str pinned) diff --git a/common/test/common_tests/files/repair_components_test.cljc b/common/test/common_tests/files/repair_components_test.cljc index 8a21495621..bc208a2125 100644 --- a/common/test/common_tests/files/repair_components_test.cljc +++ b/common/test/common_tests/files/repair_components_test.cljc @@ -55,6 +55,14 @@ file' (thf/apply-changes file {:redo-changes changes} :validate? false)] (recur file' (cfv/validate-file file' libraries) (inc passes)))))))) +(defn- repair-once + "`file` after one pass of the repair of the errors with `code` only, so the + repair of another error found in the same pass cannot do its work." + [file code] + (let [errors (filter #(= code (:code %)) (cfv/validate-file file {}))] + (assert (seq errors) (str "no " code " error")) + (thf/apply-changes file {:redo-changes (cfr/repair-file file {} errors)} :validate? false))) + ;; ---- Configurations (defn- simple @@ -131,6 +139,11 @@ (get-in (ctkl/get-component (:data file) (thi/id component-label) true) [:objects (thi/id label)])) +(defn- copy-link + "The `[component-id shape-ref]` of the copy :copy-root." + [file] + ((juxt :component-id :shape-ref) (ths/get-shape file :copy-root))) + (defn- slot-group [id] #{(ctk/build-swap-slot-group id)}) @@ -147,17 +160,25 @@ (t/is (= (thi/id :file1) (:component-file (ths/get-shape file' :main-root)))))) (t/deftest component-not-found - (let [[found file' errors] (repair (ths/update-shape (simple) :copy-root :component-id (uuid/next)))] + (let [file (ths/update-shape (simple) :copy-root :component-id (uuid/next)) + [found file' errors] (repair file)] (t/is (= #{:component-not-found :ref-shape-not-found} found)) (t/is (nil? errors)) ;; the copy is detached - (t/is (nil? (:component-id (ths/get-shape file' :copy-root)))))) + (t/is (nil? (:component-id (ths/get-shape file' :copy-root)))) + (t/testing "by its own repair" + (t/is (nil? (:component-id (ths/get-shape (repair-once file :component-not-found) :copy-root))))))) (t/deftest invalid-main-instance-id (let [[found file' errors] (repair (thc/update-component (simple) :component1 :main-instance-id (uuid/next)))] (t/is (= #{:invalid-main-instance-id :ref-shape-not-found} found)) (t/is (nil? errors)) - (t/is (= (thi/id :main-root) (:main-instance-id (thc/get-component file' :component1)))))) + (t/is (= (thi/id :main-root) (:main-instance-id (thc/get-component file' :component1)))) + ;; the :ref-shape-not-found repair, run in the same pass, detaches the copy + (tm/known-failure "F60" + [(thi/id :component1) (thi/id :main-root)] + [nil nil] + (copy-link file')))) (t/deftest invalid-main-instance-page (let [file (-> (simple) @@ -167,7 +188,12 @@ [found file' errors] (repair file)] (t/is (= #{:invalid-main-instance-page :ref-shape-not-found} found)) (t/is (nil? errors)) - (t/is (= (thi/id :page1) (:main-instance-page (thc/get-component file' :component1)))))) + (t/is (= (thi/id :page1) (:main-instance-page (thc/get-component file' :component1)))) + ;; the :ref-shape-not-found repair, run in the same pass, detaches the copy + (tm/known-failure "F60" + [(thi/id :component1) (thi/id :main-root)] + [nil nil] + (copy-link file')))) (t/deftest invalid-main-instance ;; the component names the copy as its main; the repair of @@ -175,7 +201,12 @@ (let [[found file' errors] (repair (thc/update-component (simple) :component1 :main-instance-id (thi/id :copy-root)))] (t/is (= #{:invalid-main-instance :invalid-main-instance-id :ref-shape-not-found} found)) (t/is (nil? errors)) - (t/is (= (thi/id :main-root) (:main-instance-id (thc/get-component file' :component1)))))) + (t/is (= (thi/id :main-root) (:main-instance-id (thc/get-component file' :component1)))) + ;; the :ref-shape-not-found repair, run in the same pass, detaches the copy + (tm/known-failure "F60" + [(thi/id :component1) (thi/id :main-root)] + [nil nil] + (copy-link file')))) (t/deftest shape-ref-in-main (let [[found file' errors] (repair (ths/update-shape (simple) :main-root :shape-ref (thi/id :copy-root)))] @@ -221,6 +252,18 @@ ;; no matching shape: the nested copy is detached (t/is (nil? (:shape-ref (ths/get-shape file' :copy2-nested-head)))))) +(t/deftest ref-shape-not-found-pointing-at-another-copy + ;; the nested copy points at the same nested copy of another copy of the + ;; outer component: it is reassigned to the main that one references + (let [file (-> (nested) + (thc/instantiate-component :component2 :copy3-root + :children-labels [:copy3-nested-head :copy3-child])) + [found file' errors] (repair (ths/update-shape file :copy2-nested-head :shape-ref (thi/id :copy3-nested-head)))] + (t/is (contains? found :ref-shape-not-found)) + (t/is (nil? errors)) + (t/is (= (thi/id :main2-nested-head) (:shape-ref (ths/get-shape file' :copy2-nested-head)))) + (t/is (ctk/instance-head? (ths/get-shape file' :copy2-nested-head))))) + (t/deftest ref-shape-not-found-in-a-copy-child ;; the reference of a non-head copy shape is never checked: the check reads ;; the library from the shape itself, and only heads have one @@ -283,7 +326,9 @@ (t/is (nil? errors)) ;; moved back to the page root, as a top main (t/is (= uuid/zero (:parent-id main))) - (t/is (true? (:component-root main))))) + (t/is (true? (:component-root main))) + (t/testing "its own repair makes it a nested main" + (t/is (nil? (:component-root (ths/get-shape (repair-once file :root-main-not-allowed) :main-root))))))) (t/deftest nested-main-not-allowed (let [[found file' errors] (repair (ths/update-shape (simple) :main-root :component-root nil))] @@ -325,7 +370,10 @@ [found file' errors] (repair file)] (t/is (= #{:shape-ref-cycle} found)) (t/is (nil? errors)) - (t/is (not= (thi/id :nested-a) (:shape-ref (deleted-object file' :component2 :nested-a)))))) + ;; the nested copy with the cycle is detached, the other one is kept + (t/is (nil? (:shape-ref (deleted-object file' :component2 :nested-a)))) + (t/is (nil? (:component-id (deleted-object file' :component2 :nested-a)))) + (t/is (= (thi/id :main1-root) (:shape-ref (deleted-object file' :component2 :nested-b)))))) ;; ---- Swap slots @@ -342,6 +390,7 @@ [found file' errors] (repair file)] (t/is (= #{:duplicate-slot} found)) (t/is (nil? errors)) + (t/is (= (thi/id :nested-a) (ctk/get-swap-slot (ths/get-shape file' :copy-a)))) (t/is (nil? (ctk/get-swap-slot (ths/get-shape file' :copy-b)))))) (t/deftest component-duplicate-slot @@ -352,6 +401,7 @@ [found file' errors] (repair file)] (t/is (= #{:component-duplicate-slot} found)) (t/is (nil? errors)) + (t/is (= (thi/id :nested-a) (ctk/get-swap-slot (deleted-object file' :component2 :nested-a)))) (t/is (nil? (ctk/get-swap-slot (deleted-object file' :component2 :nested-b)))))) (t/deftest missing-slot diff --git a/common/test/common_tests/logic/composable_runner_test.cljc b/common/test/common_tests/logic/composable_runner_test.cljc index 441a7b34eb..eb457933c7 100644 --- a/common/test/common_tests/logic/composable_runner_test.cljc +++ b/common/test/common_tests/logic/composable_runner_test.cljc @@ -440,3 +440,132 @@ (t/is (= [:pass] (reports :wrong))) (t/is (= [:fail] (reports :right))) (t/is (= [:fail] (reports :other))))) + +(defn- report-types + "The types of the assertions `f` reports, in order, without reporting them." + [f] + (let [types (atom [])] + (binding [t/report #(swap! types conj (:type %))] + (f)) + @types)) + +(t/deftest known-failure-refuses-a-pin-equal-to-the-expected-value + (t/is (thrown? #?(:clj Exception :cljs :default) + (tm/known-failure "F0" :right :right :right)))) + +(t/deftest check-asserts-each-unpinned-or-resolved-failure + (let [edit (tm/assign-id (->WrongUndoEdit)) + situation (r/run-variant {:setup setup/simple-component-with-copy + :operation edit}) + pin #{[:object :copy-root :name]} + known {:bug "F0" :fails {:undo pin :redo pin :variant-undo pin} :op edit} + check #(report-types (fn [] (uc/check! situation {:undo-check %})))] + (t/is (= [:fail :fail :fail] (check {}))) + (t/is (= [] (check {:known-failures [known]}))) + (t/is (= [:fail] (check {:known-failures [(assoc-in known [:fails :variant-redo] pin)]}))) + (t/is (= [] (check {:off "testing the switch"}))))) + +(t/deftest known-failure-marks-apply-by-runner-condition-and-step + (let [wrong (tm/assign-id (->WrongUndoEdit)) + right (n/change-property :main-child :fills red) + situation (r/run-variant {:setup setup/simple-component-with-copy + :operation (tm/in-sequence [wrong right])}) + pin #{[:object :copy-root :name]} + known {:bug "F0" :fails {:undo pin :redo pin :variant-undo pin} :op wrong} + verdict #(uc/verdict situation {:undo-check {:known-failures [%]}}) + phases (fn [k mark] (mapv :phase (k (verdict mark))))] + (t/is (= [] (phases :unexpected known))) + (t/testing "a mark of another runner covers nothing" + (t/is (= [:undo :redo :variant-undo] (phases :unexpected (assoc known :runners #{:frontend})))) + (t/is (= [] (phases :resolved (assoc known :runners #{:frontend}))))) + (t/testing "a mark whose condition fails covers nothing" + (t/is (= [:undo :redo :variant-undo] + (phases :unexpected (assoc known :when (constantly false)))))) + (t/testing "a mark covers only the failures of its own step" + (let [mark (assoc known :op right :fails {:undo pin :redo pin})] + (t/is (= [:undo :redo :variant-undo] (phases :unexpected mark))) + (t/is (= [:undo :redo] (phases :resolved mark))))))) + +(t/deftest a-mark-that-applies-to-no-variant-fails + (let [edit (tm/assign-id (->WrongUndoEdit)) + pin #{[:object :copy-root :name]} + mark {:bug "F0" :fails {:undo pin} :op edit} + case-map {:undo-check {:known-failures [mark]}}] + (t/is (= [:fail] (report-types #(uc/check-marks-applied! case-map :pure [])))) + (t/is (= [] (report-types #(uc/check-marks-applied! case-map :pure [mark])))) + (t/is (= [] (report-types #(uc/check-marks-applied! + {:undo-check {:known-failures [(assoc mark :runners #{:pure})]}} + :frontend [])))))) + +;; A user operation whose undo points the copy root at a shape that does not +;; exist, so the undo leaves an invalid file. +(defrecord BreakingUndoEdit [] + n/IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [this 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 % :opacity 0.5) + (:objects page) + {}) + changes (update changes :undo-changes + (partial mapv #(cond-> % + (= :mod-obj (:type %)) + (update :operations conj {:type :set + :attr :shape-ref + :val (uuid/next) + :ignore-touched true + :ignore-geometry false}))))] + (-> situation + (tm/with-file (thf/apply-changes file changes)) + (n/record-changes changes) + (tm/record-application this {}))))) + +(t/deftest round-trip-records-an-error-with-its-type + (let [situation (r/run-variant {:setup setup/simple-component-with-copy + :operation (tm/in-sequence + [(n/change-property :main-child :fills red) + (->BreakingUndoEdit)])}) + [undo variant-undo] (uc/failures situation)] + (t/is (= [:undo :variant-undo] (phases situation))) + (t/is (= #{[:error :validation]} (:signature undo))) + (t/is (= #{[:error :validation]} (:signature variant-undo))) + (t/testing "the variant goes on from the state after the step" + (t/is (= 0.5 (:opacity (setup/copy-root situation)))) + (t/is (= red (fill-of (setup/copy-instance situation))))))) + +;; An operation that implements no component operation kind. +(defrecord KindlessOp [] + tm/IOperation + (apply-to [_ situation] situation)) + +(t/deftest an-operation-without-a-kind-is-rejected + (t/is (= ::r/unknown-op (error-type (->KindlessOp))))) + +(t/deftest one-of-needs-alternatives + (t/is (thrown? #?(:clj Exception :cljs :default) (tm/one-of [])))) + +(t/deftest run-each-judges-a-variant-while-its-labels-hold + (let [choice (tm/one-of [(n/change-property :main-child :fills red) + (n/change-property :main-child :fills green)]) + seen (atom [])] + (r/run-each {:setup setup/simple-component-with-labeled-copy + :operation (tm/in-sequence [choice])} + (fn [situation] + (swap! seen conj [(= (thi/id :copy-child) (:id (setup/copy-instance situation))) + (fill-of (setup/copy-instance situation))]))) + (t/is (= [[true red] [true green]] @seen)))) + +(t/deftest counting-assertions-counts-every-report + (let [counted (atom nil)] + (report-types + #(tm/counting-assertions + (fn [made] + (t/is true) + (t/is false) + (reset! counted @made)))) + (t/is (= 2 @counted)))) diff --git a/common/test/common_tests/logic/composable_sync_test.cljc b/common/test/common_tests/logic/composable_sync_test.cljc index 11cb637dbb..af72c74d4a 100644 --- a/common/test/common_tests/logic/composable_sync_test.cljc +++ b/common/test/common_tests/logic/composable_sync_test.cljc @@ -6,9 +6,10 @@ (ns common-tests.logic.composable-sync-test "Runs the shared composable component cases through the pure runner, on the - JVM and in JS. The geometry cases (N, Z, AI and the rotation case) need - the frontend placement step and case X a pending frontend sync, so only - the frontend interpreter runs them." + JVM and in JS. Only the frontend interpreter runs the geometry cases (N, Z, + AI and the rotation case), which need the frontend placement step, case X, + which needs a pending frontend sync, case AJ, which needs the frontend + reflow, and cases AT..AX, whose variant actions are frontend events." (:require [app.common.test-helpers.composable.comp.cases :as cases] [app.common.test-helpers.composable.comp.runner :as r] @@ -20,14 +21,25 @@ (t/use-fixtures :each thi/test-fixture) (defn- check - "Run every variant of `case-map`, apply its asserter to each result and - assert that its undo/redo round trip passed." + "Run every variant of `case-map`, apply its asserter to each result before + the next variant runs and assert that its undo/redo round trip passed. A + variant whose inline tests and asserter make no assertion fails, and so + does a known undo failure that applies to no variant." [{:keys [asserter] :as case-map}] - (doseq [situation (r/run-all case-map)] - (t/testing (str "operations:\n " (tm/describe-applied situation)) - (when asserter - (asserter situation)) - (uc/check! situation case-map)))) + (let [applied (atom #{})] + (tm/counting-assertions + (fn [made] + (r/run-each case-map + (fn [situation] + (t/testing (str "operations:\n " (tm/describe-applied situation)) + (when asserter + (asserter situation)) + (let [n @made] + (t/is (pos? n) "the variant made no assertion")) + (uc/check! situation case-map) + (swap! applied into (uc/applying-marks situation case-map)) + (reset! made 0)))))) + (uc/check-marks-applied! case-map :pure @applied))) (t/deftest case-b-copy-override-survives-later-main-change (check (cases/copy-override-survives-later-main-change))) diff --git a/common/test/common_tests/logic/variants_switch_test.cljc b/common/test/common_tests/logic/variants_switch_test.cljc index 85a6a74af8..d77d952737 100644 --- a/common/test/common_tests/logic/variants_switch_test.cljc +++ b/common/test/common_tests/logic/variants_switch_test.cljc @@ -15,6 +15,7 @@ [app.common.logic.shapes :as cls] [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] @@ -3210,7 +3211,7 @@ (size-is rect' 200 50) (t/is (contains? (:touched rect') :geometry-group)))) -(t/deftest test-switch-with-h-sizing-fix-keeps-only-the-resized-height +(t/deftest test-switch-with-h-sizing-fix-keeps-the-resized-size (let [file (-> (thf/sample-file :file1) (thv/add-variant-with-child :v01 :c01 :m01 :c02 :m02 :r01 :r02 @@ -3221,8 +3222,11 @@ rect (copy-child file :copy01) file' (tho/swap-component-in-shape file :copy01 :c02 {:new-shape-label :copy02 :keep-touched? true})] (size-is rect 200 100) - ;; the fixed width comes from the new variant; the height override stays - (size-is (copy-child file' :copy02) 100 100))) + ;; the variants agree on the size, so the touched size is carried; a + ;; fixed sizing takes the new variant's width instead + (let [rect' (copy-child file' :copy02)] + (tm/known-failure "F61" [200 100] [100 100] + (mapv #(mth/round (get-in rect' [:selrect %])) [:width :height]))))) (t/deftest test-switch-keeps-a-resized-path-of-same-size-variants (let [triangle (fn [x0 y0] @@ -3276,8 +3280,12 @@ (t/is (= "new line 2" (get-in agree text-path-1))) (t/is (= "25" (get-in agree font-size-path-0))) (t/is (= "25" (get-in agree font-size-path-1))) + ;; the carried style stays an override + (t/is (contains? (:touched agree) :content-group)) (t/is (= "new line 1" (get-in disagree text-path-0))) (t/is (= "new line 2" (get-in disagree text-path-1))) (t/is (= "50" (get-in disagree font-size-path-0))) - (t/is (= "50" (get-in disagree font-size-path-1))))) + (t/is (= "50" (get-in disagree font-size-path-1))) + ;; nothing was carried, so nothing is touched + (t/is (not (contains? (:touched disagree) :content-group))))) diff --git a/common/test/common_tests/types/container_test.cljc b/common/test/common_tests/types/container_test.cljc index 55bc0e6459..695685caef 100644 --- a/common/test/common_tests/types/container_test.cljc +++ b/common/test/common_tests/types/container_test.cljc @@ -8,6 +8,7 @@ (:require [app.common.geom.point :as gpt] [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] @@ -330,7 +331,24 @@ objects (page-objects file) labels #(set (map (comp label :id) (ctc/get-children-in-instance objects (thi/id %))))] (t/is (= #{:main1 :main1-child} (labels :main1))) - (t/is (= #{:main2} (labels :main2))))) + (t/is (= #{:main2} (labels :main2))) + ;; each ancestor comes back once per child below it + (tm/known-failure "F59" 2 3 (count (ctc/get-children-in-instance objects (thi/id :main1)))))) + +(t/deftest copy-parent-above-a-plain-parent + ;; a rect in a plain group inside a copy: the copy is two levels up + (let [copy-id (uuid/next) + group-id (uuid/next) + copy (make-shape copy-id :type :frame :component-id (uuid/next) + :component-file (uuid/next) :component-root true + :shape-ref (uuid/next) :shapes [group-id]) + group (make-shape group-id :type :group :parent-id copy-id :shapes []) + rect (make-shape (uuid/next) :parent-id group-id) + objects (objects-map copy group rect)] + (t/is (ctc/has-any-copy-parent? objects group)) + ;; the walk passes on the parent's id where it expects a shape, so it + ;; stops after the direct parent + (tm/known-failure "F63" true false (ctc/has-any-copy-parent? objects rect)))) (t/deftest container-of-a-component (let [file (placement-file) @@ -360,7 +378,11 @@ (ctc/remove-swap-keep-attrs shape)))) (t/is (= [nil nil] ((juxt :layout-item-h-sizing :layout-item-v-sizing) - (ctc/remove-swap-keep-attrs fixed)))))) + (ctc/remove-swap-keep-attrs fixed)))) + (t/testing "auto sizing out of a layout is not kept" + (t/is (= [nil nil] + ((juxt :layout-item-h-sizing :layout-item-v-sizing) + (ctc/remove-swap-keep-attrs (dissoc shape :layout)))))))) (t/deftest component-instance-with-default-options (let [file (placement-file) @@ -368,5 +390,8 @@ [root shapes] (ctc/make-component-instance (thf/current-page file) component (:data file) (gpt/point 0 0))] (t/is (= (thi/id :c1) (:component-id root))) + (t/is (:component-root root)) (t/is (not (ctk/main-instance? root))) - (t/is (= 2 (count shapes))))) + (t/is (= 2 (count shapes))) + (t/testing "each shape references its main" + (t/is (= #{(thi/id :main1) (thi/id :main1-child)} (set (map :shape-ref shapes))))))) diff --git a/common/test/common_tests/types/file_test.cljc b/common/test/common_tests/types/file_test.cljc index 4608111a09..f818c368bb 100644 --- a/common/test/common_tests/types/file_test.cljc +++ b/common/test/common_tests/types/file_test.cljc @@ -10,6 +10,7 @@ the original ref of a swapped shape, and the lookups on deleted components." (:require + [app.common.data :as d] [app.common.files.validate :as cfv] [app.common.test-helpers.components :as thc] [app.common.test-helpers.composable.core :as tm] @@ -52,11 +53,13 @@ :copy-root-params {:children-labels [:copy-child]}) (thc/instantiate-component :lib-component :lib-copy :library library - :children-labels [:lib-copy-child])) + :children-labels [:lib-copy-child]) + (ths/update-shape :lib-copy-child :touched #{:fill-group})) file' (ctf/detach-external-references file (:id file))] (t/testing "a copy of a library component becomes plain shapes" (t/is (= {} (links file' :lib-copy))) - (t/is (= {} (links file' :lib-copy-child)))) + (t/is (= {} (links file' :lib-copy-child))) + (tm/known-failure "F52" nil #{:fill-group} (:touched (ths/get-shape file' :lib-copy-child)))) (t/testing "a copy of a local component keeps its links" (t/is (= (links file :copy) (links file' :copy))) (t/is (= (links file :copy-child) (links file' :copy-child)))) @@ -111,7 +114,13 @@ :typography-ref-file library-id} {:text "local" :typography-ref-id (thi/id :typography) - :typography-ref-file (:id file)}]}]}]})))) + :typography-ref-file (:id file)}]}]}]}) + (ths/add-sample-shape :local-rect + :type :rect + :fill-color-ref-id (thi/id :local-color) + :fill-color-ref-file (:id file) + :stroke-color-ref-id (thi/id :local-color) + :stroke-color-ref-file (:id file))))) (defn- text-leaves [file] @@ -124,6 +133,10 @@ file' (ctf/detach-external-references file (:id file)) rect' (ths/get-shape file' :rect)] (t/is (= {} (select-keys rect' [:fill-color-ref-file :stroke-color-ref-file]))) + (t/testing "local refs are kept" + (t/is (= {:fill-color-ref-file (:id file) :stroke-color-ref-file (:id file)} + (select-keys (ths/get-shape file' :local-rect) + [:fill-color-ref-file :stroke-color-ref-file])))) (t/is (= [{} {:typography-ref-file (:id file)}] (text-leaves file'))) (t/testing "a fill ref inside `:fills`" (tm/known-failure "F57" nil library-id (-> rect' :fills first :fill-color-ref-file))))) @@ -159,12 +172,16 @@ roots (->> (ctpl/get-page data' (:id (second pages'))) (ctn/shapes-seq) (filter ctk/main-instance?) - (sort-by :y))] + (d/index-by :component-id))] (t/is (= ["Page 1" "Main components"] (map :name pages'))) - (t/is (= 2 (count roots))) + (t/is (= #{(thi/id :component1) (thi/id :component2)} (set (keys roots)))) (t/testing "the second component goes below the first, a grid gap apart" - (let [[first-root second-root] roots] + (let [first-root (get roots (thi/id :component1)) + second-root (get roots (thi/id :component2))] (t/is (<= (+ (:y first-root) (:height first-root) 50) (:y second-root))))) + (t/testing "the copies now use the file's own components" + (t/is (= (:id file) (:component-file (ths/get-shape file' :copy1)))) + (t/is (= (:id file) (:component-file (ths/get-shape file' :copy2))))) (t/is (= #{} (validation-errors file'))))) ;; ----- Original ref of a swapped shape @@ -251,19 +268,27 @@ (t/deftest update-objects-tree-updates-and-removes (let [file (-> (thf/sample-file :file) (tho/add-frame-with-child :frame :child) + (tho/add-frame-with-child :gone :gone-child) (tho/add-rect :rect)) container (ctn/make-container (thf/current-page file) :page) + visited (atom #{}) result (ctf/update-objects-tree container (fn [shape] + (swap! visited conj (:id shape)) (condp = (:id shape) - (thi/id :frame) {:result :update - :updated-shape (assoc shape :name "Updated")} - (thi/id :rect) {:result :remove} - {:result :keep})))] - (t/is (= "Updated" (:name (ctst/get-shape result (thi/id :frame))))) - (t/is (some? (ctst/get-shape result (thi/id :child)))) + (thi/id :rect) {:result :remove} + (thi/id :gone) {:result :remove} + {:result :update + :updated-shape (assoc shape :name "Updated")})))] + (t/testing "an update reaches the children of an updated shape" + (t/is (= "Updated" (:name (ctst/get-shape result (thi/id :frame))))) + (t/is (= "Updated" (:name (ctst/get-shape result (thi/id :child)))))) (t/is (nil? (ctst/get-shape result (thi/id :rect)))) + (t/testing "a removed shape goes with its children, which are not visited" + (t/is (nil? (ctst/get-shape result (thi/id :gone)))) + (t/is (nil? (ctst/get-shape result (thi/id :gone-child)))) + (t/is (not (contains? @visited (thi/id :gone-child))))) (t/testing "an unknown result" (t/is (thrown? #?(:clj Exception :cljs :default) (ctf/update-objects-tree container (constantly {:result :other}))))))) @@ -277,10 +302,28 @@ libraries {(:id file) file} chain (ctf/get-ref-chain-until-target-ref page libraries (ths/get-shape file :copy-child) - (ths/get-shape file :copy))] + (thi/id :copy))] (t/testing "the chain runs to the main and stops there" (t/is (= [(thi/id :copy-child) (thi/id :main-child)] (map :id chain)))))) +(t/deftest ref-chain-stops-at-the-target + ;; the target is the second link of a chain three links long + (let [file (-> (thf/sample-file :file) + (tho/add-two-levels-nested-component-with-copy + :c1 :main1 :main1-child + :c2 :main2 :nested-head1 + :c3 :main3 :nested-head2 :nested-subhead2 + :copy3)) + copy-c2 (first (:shapes (ths/get-shape file :copy3))) + copy-c1 (ths/get-shape-by-id file (first (:shapes (ths/get-shape-by-id file copy-c2)))) + chain (ctf/get-ref-chain-until-target-ref (thf/current-page file) {(:id file) file} + copy-c1 (thi/id :nested-subhead2))] + ;; the stop compares each shape with the target's id, so it never holds + (tm/known-failure "F62" + [(:id copy-c1) (thi/id :nested-subhead2)] + [(:id copy-c1) (thi/id :nested-subhead2) (thi/id :nested-head1) (thi/id :main1)] + (mapv :id chain)))) + (t/deftest near-match-with-context (let [file (-> (thf/sample-file :file) (tho/add-simple-component-with-copy :component :main :main-child @@ -290,4 +333,5 @@ (ths/get-shape file :copy-child) :with-context? true)] (t/is (= (thi/id :main-child) (:id match))) - (t/is (some? (:container (meta match)))))) + (t/is (= :page (:type (:container (meta match))))) + (t/is (= (:id (thf/current-page file)) (:id (:container (meta match))))))) diff --git a/frontend/src/app/main/data/workspace/clipboard.cljs b/frontend/src/app/main/data/workspace/clipboard.cljs index 877e535f75..8d4e5d29a7 100644 --- a/frontend/src/app/main/data/workspace/clipboard.cljs +++ b/frontend/src/app/main/data/workspace/clipboard.cljs @@ -23,7 +23,6 @@ [app.common.transit :as t] [app.common.types.component :as ctk] [app.common.types.container :as ctn] - [app.common.types.file :as ctf] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] @@ -70,42 +69,11 @@ [potok.v2.core :as ptk] [promesa.core :as p])) -(defn- advance-shape - [file libraries page level-delta head-id objects shape] - (let [new-shape-ref (ctf/advance-shape-ref file page libraries shape level-delta {:include-deleted? true}) - container (ctn/make-container page :page) - ;; The head becomes a root copy, which cannot carry a swap slot, so - ;; strip inherited slots only for it. Nested sub-heads keep them so - ;; they still pair with the children of the new near main. - head? (= (:id shape) head-id) - new-touched (ctf/get-touched-from-ref-chain-until-target-ref - container libraries shape new-shape-ref :remove-slots? head?)] - (cond-> objects - (and (some? new-shape-ref) (not= new-shape-ref (:shape-ref shape))) - (update (:id shape) assoc :shape-ref new-shape-ref :touched new-touched)))) - -(defn- advance-copy - [file libraries page objects shape] - (if (and (ctk/instance-head? shape) (not (ctk/main-instance? shape))) - (let [level-delta (if (nil? (ctk/get-swap-slot shape)) - (ctn/get-nesting-level-delta (:objects page) shape uuid/zero) - 0)] - (if (pos? level-delta) - (reduce (partial advance-shape file libraries page level-delta (:id shape)) - objects - (cfh/get-children-with-self objects (:id shape))) - objects)) - objects)) - (defn advance-copies "When copying an instance that is nested inside another one, we need to advance the shape refs to one or more levels of remote mains." [file libraries page selected data] - (let [heads (mapcat #(ctn/get-child-heads (:objects data) %) selected)] - (update data :objects - #(reduce (partial advance-copy file libraries page) - % - heads)))) + (update data :objects #(cll/advance-copied-objects file page libraries % selected))) (defn copy-selected [] diff --git a/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs b/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs index af14ae9570..848015d982 100644 --- a/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs @@ -145,6 +145,14 @@ (t/is (= :settled (await (ftm/await-step [(fill-main-child red)])))) (t/is (= red (ftm/fill-of :copy-child)))) +(t/deftest ^:async install-forgets-work-no-watcher-owns + ;; With no layout watcher running, stopping one clears nothing: the install + ;; itself must forget the pending work. + (ftm/uninstall!) + (wrf/start! :sync-file [(random-uuid)]) + (ftm/install! (setup/simple-component-with-labeled-copy)) + (t/is (empty? (wrf/pending)))) + (t/deftest skipped-optional-keeps-the-undo-baseline ;; The end-of-variant round trip undoes back to the last file install. A ;; skipped optional installs nothing, so the baseline stays at the setup, @@ -156,5 +164,6 @@ :operation (tm/in-sequence [(n/change-property :main-instance :fills red) (tm/optional later)])} (fn [situation] - (when-not (tm/applied? situation later) - (t/is (= -1 (:depth (uc/baseline situation)))))))))) + ;; neither the skip nor the user step moves it + (t/is (= -1 (:depth (uc/baseline situation))) + (if (tm/applied? situation later) "with the later edit" "skipped"))))))) diff --git a/frontend/test/frontend_tests/composable_tests/interpreter.cljs b/frontend/test/frontend_tests/composable_tests/interpreter.cljs index f1178b6a1e..9a1fcdba87 100644 --- a/frontend/test/frontend_tests/composable_tests/interpreter.cljs +++ b/frontend/test/frontend_tests/composable_tests/interpreter.cljs @@ -77,14 +77,19 @@ (set! dwth/update-thumbnail orig) (reset! original-update-thumbnail nil))) +(declare uninstall!) + (def fixture "An `:each` fixture for tests that run the component watcher: a fresh label - map and no thumbnail rendering. Its `:after` runs after an async test's - `done`, so it covers the whole test." + map and no thumbnail rendering, and the watchers `install!` starts stopped + at the end. Its `:after` runs after an async test's `done`, so it covers + the whole test." {:before (fn [] (cthi/reset-idmap!) (install-thumbnail-noop!)) - :after restore-thumbnail!}) + :after (fn [] + (uninstall!) + (restore-thumbnail!))}) ;; -------------------------------------------------------------------------- ;; Operations as workspace events @@ -140,11 +145,17 @@ (instance? n/ChangeProperty op) (let [{:keys [target property value]} op id (tm/target-shape-id situation target)] - (if (= :margin property) + (case property ;; the sidebar's layout child margin + :margin (let [shape (n/set-property {} property value)] [(dwsl/update-layout-child [id] (select-keys shape [:layout-item-margin :layout-item-margin-type]))]) + + ;; the layers panel's rename, which renames a main's component too + :name + [(dw/end-rename-shape id value)] + [(dwsh/update-shapes #{id} (fn [shape] (n/set-property shape property value)))])) (instance? n/EditText op) @@ -313,7 +324,7 @@ ;; -------------------------------------------------------------------------- ;; Longest a step may take to settle; a step that takes longer fails. -(def ^:private step-timeout-ms 2000) +(def ^:private step-timeout-ms 10000) (defn- install-situation-event "An event that installs the situation's file as the current one, its @@ -584,14 +595,25 @@ (not (instance? tm/Skip (unwrap op)))) (mark-baseline)))) +(defonce ^:private step-errors + ;; The errors the store reported (`st/on-error`) while a step ran: Potok + ;; catches an error thrown by an event, so the step would settle as if the + ;; event did nothing. + (atom [])) + +(defn- describe-op + "`op` as its fields: the JS test build strips record names." + [op] + (pr-str (dissoc (into {} op) ::tm/id))) + (defn- run-ops "Run the op units `ops` in order, each `sync-op?` one on the live file and - the others as events awaited with `await-step`. Calls `k` with the final - situation, or with nil after failing the test when a step did not - settle." - [situation ops k] + the others as events awaited with `await-step`. Resolves with the final + situation, or with nil after failing the test when a step did not settle + or one of its events raised an error." + [situation ops] (if (empty? ops) - (k situation) + (js/Promise.resolve situation) (let [op (first ops) kind (let [op (unwrap op)] (when (satisfies? n/IComponentOperation op) @@ -601,29 +623,42 @@ before (when check-step? (snapshot)) index-before (undo-index)] (if (sync-op? op) - (run-ops (run-sync-op situation op) (rest ops) k) - (.then (await-step (op-events op situation) step-timeout-ms (op-ready op situation)) - (fn [result] - (if (= :settled result) - (let [situation (record-op situation op)] + (run-ops (run-sync-op situation op) (rest ops)) + (do + (reset! step-errors []) + (.then (await-step (op-events op situation) step-timeout-ms (op-ready op situation)) + (fn [result] + (let [[errors] (reset-vals! step-errors [])] (cond - check-step? - (.then (check-step situation (unwrap op) before index-before) - #(run-ops % (rest ops) k)) + (seq errors) + (do + (t/is false (str "Step raised an error: " (describe-op (unwrap op)) + "; " (ex-message (first errors)))) + nil) - ;; never undo past the state a case's own undo went back to - (and (::undo-check? situation) - (= :undo kind) - (< (undo-index) (:depth (uc/baseline situation)))) - (run-ops (mark-baseline situation) (rest ops) k) + (not= :settled result) + (do + (t/is false (str "Step did not settle in " step-timeout-ms "ms: " + (describe-op (unwrap op)) + "; pending: " (pr-str (describe-pending (:timeout result))))) + nil) :else - (run-ops situation (rest ops) k))) - (do - (t/is false (str "Step did not settle in " step-timeout-ms "ms: " - (pr-str (type (unwrap op))) - "; pending: " (pr-str (describe-pending (:timeout result))))) - (k nil))))))))) + (let [situation (record-op situation op)] + (cond + check-step? + ;; go on from the redone file, as the pure runner does + (.then (check-step situation (unwrap op) before index-before) + #(run-ops (tm/with-file % (current-file)) (rest ops))) + + ;; never undo past the state a case's own undo went back to + (and (::undo-check? situation) + (= :undo kind) + (< (undo-index) (:depth (uc/baseline situation)))) + (run-ops (mark-baseline situation) (rest ops)) + + :else + (run-ops situation (rest ops))))))))))))) (defonce ^:private original-store ;; The store at load time. Some test namespaces `set!` st/state and @@ -656,7 +691,8 @@ (rx/tap (fn [{:keys [ids]}] (wrf/finish! (wrf/start! :text-measure ids)))) (rx/ignore) - (rx/take-until (rx/filter (ptk/type? ::headless-text-measurement) stream)))))) + (rx/take-until (rx/filter (ptk/type? ::headless-text-measurement) stream)) + (rx/take-until (rx/filter (ptk/type? ::stop-headless-text-measurement) stream)))))) (defn install! "Install `situation` in the global store and start the watchers the workspace @@ -675,24 +711,42 @@ (headless-text-measurement)) situation) +(defn uninstall! + "Stop the watchers `install!` started and forget their pending work, so + they do not react to what later tests do with the store." + [] + (st/emit! (dw/finalize-edit-watchers) + ;; the component and token watchers stop when the page closes + (ptk/data-event :app.main.data.workspace.pages/finalize-page) + (ptk/data-event ::stop-headless-text-measurement)) + (wrf/reset-pending!)) + (defn- run-variant "Set up one variant on the global store and run its ops. `setup` returns a situation (file + roles). With `undo-check?`, runs the undo/redo round - trip of each user step and of the variant. Calls `k` with the final - situation, or nil when a step did not settle." - [setup ops undo-check? k] - ;; a fresh label map per variant, as `tm/run-all` does + trip of each user step and of the variant. Resolves with the final + situation, or nil when a step failed." + [setup ops undo-check?] + ;; a fresh label map per variant, as `tm/run-each` does (cthi/reset-idmap!) (let [situation (-> (setup) (assoc ::undo-check? undo-check?) (uc/with-runner :frontend) (install!))] - (run-ops (cond-> situation undo-check? (mark-baseline)) - ops - (fn [situation] - (if (and situation undo-check?) - (.then (check-variant situation) k) - (k situation)))))) + (.then (run-ops (cond-> situation undo-check? (mark-baseline)) ops) + (fn [situation] + (if (and situation undo-check?) + (.then (check-variant situation) + ;; the asserter judges the state the operations produced + #(uc/with-failures-of situation %)) + situation))))) + +(defn- assertions-made + "How many assertions (passed, failed or errored) the running test has + reported so far." + [] + (let [{:keys [pass fail error]} (:report-counters (t/get-current-env))] + (+ pass fail error))) ;; -------------------------------------------------------------------------- ;; Test entry point @@ -701,10 +755,12 @@ (defn check "Run every variant of `case-map` through the frontend, apply `asserter` (default the case map's `:asserter`) to each result and check its undo/redo - round trip (`app.common.test-helpers.composable.comp.undo-check`). Calls the - async test's `done` at the end. RPC calls are mocked, `rx/timer` fires at - once, for the delayed RPC of the library update, and DOM lookups find - nothing, for the delayed focus after adding a variant." + round trip (`app.common.test-helpers.composable.comp.undo-check`). A + variant that makes no assertion fails, and so does a known undo failure + that applies to no variant; an error in a variant is reported and the next + one runs. Calls the async test's `done` at the end. RPC calls are mocked, + `rx/timer` fires at once, for the delayed RPC of the library update, and + DOM lookups find nothing, for the delayed focus after adding a variant." ([done case-map] (check done case-map (:asserter case-map))) ([done {:keys [setup operation] :as case-map} asserter] (mock/with-mocks @@ -712,20 +768,31 @@ rx/timer mock/timer-mock dom/get-element (constantly nil)} (fn [inner-done] - (let [variants (tm/enumerate operation)] - (letfn [(run-next [vs] - (if (empty? vs) - (inner-done) - (run-variant - setup - (tm/sequence-ops (first vs)) - (uc/enabled? case-map) - (fn [situation] - (when situation - (t/testing (str "operations:\n " (tm/describe-applied situation)) - (when asserter - (asserter situation)) - (uc/check! situation case-map))) - (run-next (rest vs))))))] - (run-next variants)))) + (let [variants (tm/enumerate operation) + on-error @st/on-error + applied (atom #{}) + judge (fn [variant] + (let [made (assertions-made)] + (-> (js/Promise.resolve) + (.then #(run-variant setup (tm/sequence-ops variant) (uc/enabled? case-map))) + (.then (fn [situation] + (when situation + (t/testing (str "operations:\n " (tm/describe-applied situation)) + (when asserter + (asserter situation)) + (t/is (< made (assertions-made)) "the variant made no assertion") + (uc/check! situation case-map) + (swap! applied into (uc/applying-marks situation case-map)))))) + (.catch (fn [e] + (t/report {:type :error :message "the variant raised an error" + :expected nil :actual e}))))))] + (t/is (seq variants) "the case has no variant") + (reset! st/on-error (fn [e] (swap! step-errors conj e) (on-error e))) + (-> (reduce (fn [p variant] (.then p #(judge variant))) (js/Promise.resolve) variants) + (.then #(uc/check-marks-applied! case-map :frontend @applied)) + (.catch (fn [e] (t/report {:type :error :message "the case raised an error" + :expected nil :actual e}))) + (.finally (fn [] + (reset! st/on-error on-error) + (inner-done)))))) done))) diff --git a/frontend/test/frontend_tests/data/workspace_edit_watchers_test.cljs b/frontend/test/frontend_tests/data/workspace_edit_watchers_test.cljs index a4c0691f54..85b7ca70b7 100644 --- a/frontend/test/frontend_tests/data/workspace_edit_watchers_test.cljs +++ b/frontend/test/frontend_tests/data/workspace_edit_watchers_test.cljs @@ -7,7 +7,9 @@ (ns frontend-tests.data.workspace-edit-watchers-test "Tests the lifecycle of the workspace edit watchers (`dw/initialize-edit-watchers`): starting them again, as a file reload - does, replaces the running ones instead of adding a second set." + does, replaces the running ones instead of adding a second set. Checked + through the undo stack watcher, the one whose double would show in the + entries an edit adds." (:require [app.common.test-helpers.composable.comp.setups :as setup] [app.common.test-helpers.ids-map :as thi] diff --git a/frontend/test/frontend_tests/data/workspace_libraries_test.cljs b/frontend/test/frontend_tests/data/workspace_libraries_test.cljs index f5a62fbcf7..16979d8101 100644 --- a/frontend/test/frontend_tests/data/workspace_libraries_test.cljs +++ b/frontend/test/frontend_tests/data/workspace_libraries_test.cljs @@ -68,9 +68,13 @@ (count (get-in @st/state [:workspace-undo :items]))) (defn- step - "Run `events` and wait until their work drains." + "Run `events` and wait until their work drains; fails the test when it + does not." [& events] - (ftm/await-step (vec events))) + (.then (ftm/await-step (vec events)) + (fn [result] + (t/is (= :settled result) "the step settled") + result))) (defn- select [& labels] @@ -157,7 +161,7 @@ (await (step dwu/undo)) (t/is (= 2 (component-count))))) -(t/deftest ^:async add-multiple-components-skips-copies +(t/deftest ^:async add-multiple-components-refuses-a-selection-with-a-copy-child (install-file! (two-components)) (await (step (select :rect-a :copy-a-child) (dwl/add-multiple-components))) (t/is (= 2 (component-count)))) @@ -202,9 +206,13 @@ (await (step (dwl/update-component (cthi/id :copy)))) (let [library' (get-in @st/state [:files (:id library)])] (t/is (= override (-> (cths/get-shape library' :lib-main-child) :fills first :fill-color)))) - (t/testing "a shape that is not a head is left as it is" + (t/testing "a shape that is not a head pushes nothing" + (await (step (dwsh/update-shapes #{(cthi/id :copy-child)} + #(assoc % :fills (cths/sample-fills-color :fill-color "#333333"))))) (await (step (dwl/update-component (cthi/id :copy-child)))) - (t/is (= override (fill :copy-child)))))) + (let [library' (get-in @st/state [:files (:id library)])] + (t/is (= override (-> (cths/get-shape library' :lib-main-child) :fills first :fill-color)))) + (t/is (= "#333333" (fill :copy-child)))))) (t/deftest ^:async rename-component-to-a-blank-name (install-file! (two-components)) diff --git a/frontend/test/frontend_tests/data/workspace_library_links_test.cljs b/frontend/test/frontend_tests/data/workspace_library_links_test.cljs index 876fa0860f..681843eef8 100644 --- a/frontend/test/frontend_tests/data/workspace_library_links_test.cljs +++ b/frontend/test/frontend_tests/data/workspace_library_links_test.cljs @@ -13,6 +13,7 @@ [app.common.test-helpers.files :as cthf] [app.common.test-helpers.ids-map :as cthi] [app.common.test-helpers.variants :as cthv] + [app.main.data.event :as ev] [app.main.data.workspace.libraries :as dwl] [app.main.repo :as rp] [beicon.v2.core :as rx] @@ -40,6 +41,20 @@ [calls] (set (map first @calls))) +(defn- watch-events + "Collect the props of the analytics events `store` receives from now on." + [store] + (let [events (atom [])] + (rx/sub! (->> (ptk/input-stream store) + (rx/filter (ptk/type? ::ev/event)) + (rx/map deref)) + #(swap! events conj %)) + events)) + +(defn- named + [events name] + (filterv #(= name (::ev/name %)) @events)) + (defn- merge-state "An event that merges `m` into the state, for what the workspace loads before these events run." @@ -76,15 +91,20 @@ :get-file-object-thumbnails {"thumbnail-id" "thumbnail-uri"} :get-library-usage {:used-in 3}})} (fn [inner-done] - (ths/run-store - (ths/setup-store file) inner-done - [(merge-state {:shared-files {(:id library) {:library-summary {:variants [{} {}]}}}}) - (dwl/link-file-to-library (:id file) (:id library))] - (fn [state] - (t/is (= #{(:id library) (:id dependency)} (linked-to state (:id file)))) - (t/is (= "thumbnail-uri" (get-in state [:thumbnails "thumbnail-id" :uri]))) - (t/testing "a library with variants asks how much it is used" - (t/is (contains? (commands calls) :get-library-usage)))))) + (let [store (ths/setup-store file) + events (watch-events store)] + (ths/run-store + store inner-done + [(merge-state {:shared-files {(:id library) {:library-summary {:variants [{} {}]}}}}) + (dwl/link-file-to-library (:id file) (:id library))] + (fn [state] + (t/is (= #{(:id library) (:id dependency)} (linked-to state (:id file)))) + (t/is (= "thumbnail-uri" (get-in state [:thumbnails "thumbnail-id" :uri]))) + (t/testing "a library with variants reports how much it is used" + (t/is (contains? (commands calls) :get-library-usage)) + (t/is (= [[3 2]] + (mapv (juxt :library-used-in :variants-count) + (named events "link-file-to-library-variants"))))))))) done)))) (t/deftest link-skips-libraries-already-loaded @@ -134,12 +154,14 @@ {rp/cmd! (rpc calls {:unlink-file-from-library nil :get-file-libraries []})} (fn [inner-done] + ;; the file is marked as a library of itself, so only the guard + ;; that keeps the current file keeps it (ths/run-store - (ths/setup-store file) inner-done + (ths/setup-store (assoc file :library-of (:id file))) inner-done [(dwl/libraries-fetched (:id file) [library dependency]) (dwl/unlink-file-from-library (:id file) (:id library))] (fn [state] - (t/is (empty? (linked-to state (:id file)))) + (t/is (= #{(:id file)} (linked-to state (:id file)))) (t/is (some? (get-in state [:files (:id file)])))))) done)))) @@ -161,10 +183,12 @@ (mock/with-mocks {rp/cmd! (rpc calls {:set-file-shared nil})} (fn [inner-done] - (ths/run-store - (ths/setup-store file) inner-done - [(dwl/set-file-shared (:id file) shared?)] - #(check % @calls))) + (let [store (ths/setup-store file) + events (watch-events store)] + (ths/run-store + store inner-done + [(dwl/set-file-shared (:id file) shared?)] + #(check % @calls (named events "set-file-variants-shared"))))) done)))) (t/deftest share-a-file-with-variants @@ -173,17 +197,19 @@ (let [file (-> (cthf/sample-file :file1) (cthv/add-variant :v01 :c01 :m01 :c02 :m02))] ((share file true - (fn [state calls] + (fn [state calls variant-events] (t/is (true? (get-in state [:files (:id file) :is-shared]))) - (t/is (= [[:set-file-shared {:id (:id file) :is-shared true}]] calls)))) + (t/is (= [[:set-file-shared {:id (:id file) :is-shared true}]] calls)) + (t/is (= 1 (count variant-events)) "it reports that the shared file has variants"))) done)))) (t/deftest unshare-a-file (t/async done - (let [file (cthf/sample-file :file1)] + (let [file (cthf/sample-file :file1 :is-shared true)] ((share file false - (fn [state calls] + (fn [state calls variant-events] (t/is (false? (get-in state [:files (:id file) :is-shared]))) - (t/is (= [[:set-file-shared {:id (:id file) :is-shared false}]] calls)))) + (t/is (= [[:set-file-shared {:id (:id file) :is-shared false}]] calls)) + (t/is (empty? variant-events)))) done)))) diff --git a/frontend/test/frontend_tests/data/workspace_library_updates_test.cljs b/frontend/test/frontend_tests/data/workspace_library_updates_test.cljs index 96c22d96a2..defd54b934 100644 --- a/frontend/test/frontend_tests/data/workspace_library_updates_test.cljs +++ b/frontend/test/frontend_tests/data/workspace_library_updates_test.cljs @@ -20,6 +20,7 @@ [app.main.data.workspace.libraries :as dwl] [app.main.repo :as rp] [app.main.store :as st] + [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] [frontend-tests.composable-tests.interpreter :as ftm] [frontend-tests.helpers.mock :as mock] @@ -90,6 +91,21 @@ [] (set (map :cmd @mock/rpc-calls))) +(def ^:private rpc-on-subscribe + ;; An `rp/cmd!` double that records a call when its stream is subscribed, + ;; as the real one sends the request only then. + (mock/stub + (fn [cmd params & _] + (rx/defer (fn [] + (swap! mock/rpc-calls conj {:cmd cmd :params params}) + (rx/of nil)))))) + +(defn- await-sync-status-sent + "Wait for the request that tells the server the file synced with the + library, which `sync-file` sends after a delay." + [] + (await-until #(contains? (rpc-commands) :update-file-library-sync-status))) + ;; ----- Which libraries need a sync (t/deftest assets-need-sync @@ -117,15 +133,17 @@ (t/deftest ^:async sync-dialog-updates-the-copies (await (mock/with-mocks* - {rp/cmd! mock/rpc-cmd-mock} + {rp/cmd! rpc-on-subscribe + rx/timer mock/timer-mock} (install-with-library! true) (t/is (= :settled (await (ftm/await-step [(dwl/notify-sync-file)] 1000 sync-dialog-shown?)))) ((-> (notification) :accept :callback)) (await (await-until #(= new-color (copy-fill)))) (t/is (= new-color (copy-fill))) (t/is (not= :visible (:status (notification)))) + (t/is (some? (:synced-at (live-library)))) (t/is (not= synced-at (:synced-at (live-library)))) - (t/is (contains? (rpc-commands) :update-file-library-sync-status))))) + (t/is (= :settled (await (await-sync-status-sent))))))) (t/deftest ^:async sync-dialog-dismiss-ignores-the-changes (await @@ -187,14 +205,16 @@ (t/deftest ^:async sync-from-an-external-library (await (mock/with-mocks* - {rp/cmd! mock/rpc-cmd-mock} + {rp/cmd! rpc-on-subscribe + rx/timer mock/timer-mock} (let [library (install-with-library! true)] (await (ftm/await-step [(dwl/set-updating-library true) (dwl/sync-file (:id (ftm/current-file)) (:id library))])) (t/is (= new-color (copy-fill))) (t/is (not (:updating-library @st/state))) + (t/is (some? (:synced-at (live-library)))) (t/is (not= synced-at (:synced-at (live-library)))) - (t/is (contains? (rpc-commands) :update-file-library-sync-status)))))) + (t/is (= :settled (await (await-sync-status-sent)))))))) (t/deftest ^:async set-updating-library (await (ftm/await-step [(dwl/set-updating-library true)])) diff --git a/frontend/test/frontend_tests/data/workspace_sync_barrier_test.cljs b/frontend/test/frontend_tests/data/workspace_sync_barrier_test.cljs index 03f0485efe..dc2d4bd8c5 100644 --- a/frontend/test/frontend_tests/data/workspace_sync_barrier_test.cljs +++ b/frontend/test/frontend_tests/data/workspace_sync_barrier_test.cljs @@ -11,11 +11,16 @@ composable interpreter rely on it." (:require [app.common.test-helpers.composable.comp.setups :as setup] + [app.common.test-helpers.ids-map :as thi] + [app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.reflow :as wrf] [app.main.store :as st] [app.plugins.reflow :as pwrf] + [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] - [frontend-tests.composable-tests.interpreter :as ftm])) + [frontend-tests.composable-tests.interpreter :as ftm] + [frontend-tests.helpers.async :as async] + [potok.v2.core :as ptk])) (t/use-fixtures :each ftm/fixture) @@ -27,24 +32,30 @@ (defn- run-commit "Install a component with a copy and emit the main child fill commit with - `commit-opts`. Once the wait settles, call `check` with whether the sync - wait was open right after the commit. Fails the test when the wait does not - settle." + `commit-opts`. Once the wait settles, call `check` (which may return a + promise) with whether the sync wait was open right after the commit and an + atom with the ids of the components the watcher touched. Fails the test + when the wait does not settle." [done commit-opts check] (ftm/install! (setup/simple-component-with-labeled-copy)) - (let [file-id (:id (ftm/current-file))] + (let [file-id (:id (ftm/current-file)) + touched (atom #{}) + sub (rx/sub! (rx/filter (ptk/type? ::dwl/touch-component) st/stream) + #(swap! touched into @%))] (st/emit! (ftm/fill-commit :main-child red commit-opts)) (let [open? (sync-pending? file-id)] (-> (pwrf/wait-for-layout-update nil 2000) - (.then #(check open?) + (.then #(check open? touched) #(t/is false "the sync wait did not settle")) (.catch #(t/is false (str "the check threw: " %))) - (.finally done))))) + (.finally (fn [] + (rx/dispose! sub) + (done))))))) (t/deftest user-edit-holds-the-wait-until-copies-sync (t/async done (run-commit done {} - (fn [open?] + (fn [open? _] (t/is open?) (t/is (= red (ftm/fill-of :copy-child))))))) @@ -53,17 +64,26 @@ ;; the component for them, after a timer turn; the wait must cover that. (t/async done (run-commit done {:save-undo? false} - (fn [open?] - (t/is open?))))) + (fn [open? touched] + (t/is open?) + (t/is (= #{(thi/id :component1)} @touched) "the watcher touched it") + (t/is (= setup/labeled-fill (ftm/fill-of :copy-child)) "no sync"))))) + +(defn- dropped + "The check of a commit the watcher drops: no wait opens, and the copies do + not sync, even once everything it could start has settled." + [open? touched] + (t/is (not open?)) + (-> (async/settle) + (.then #(pwrf/wait-for-layout-update nil 2000)) + (.then (fn [_] + (t/is (= setup/labeled-fill (ftm/fill-of :copy-child))) + (t/is (empty? @touched)))))) (t/deftest translation-commit-leaves-nothing-pending (t/async done - (run-commit done {:translation? true} - (fn [open?] - (t/is (not open?)))))) + (run-commit done {:translation? true} dropped))) (t/deftest derived-commit-leaves-nothing-pending (t/async done - (run-commit done {:skip-component-sync? true} - (fn [open?] - (t/is (not open?)))))) + (run-commit done {:skip-component-sync? true} dropped))) diff --git a/plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts b/plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts index ddbd96695f..9f968f0f8b 100644 --- a/plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts +++ b/plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts @@ -29,7 +29,7 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase const opCreateRed = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(RED), "red"); const fillColor = new ShapePropFillColor(); const opacity = new ShapePropOpacity(); - const { copyInstance } = opCreateComponent.roles; + const { copyInstance, remoteInstance } = opCreateComponent.roles; const copyNested = (s: Situation) => opCreateComponent.getNestedInstance(s, 1); const redComponent = (s: Situation) => opCreateRed.getMainComponent(s); @@ -52,7 +52,12 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase new OpReset(copyNested, "the copy's nested copy"), new OpAssert("the reset undoes the swap and keeps the copy's opacity", (s) => { const head = copyNested(s); - Assert.that(head.component()?.id !== redComponent(s).id, "the nested copy is no longer red"); + const original = s.get(remoteInstance).component(); + Assert.that(original != null, "the original component exists"); + Assert.that( + head.component()?.id === original?.id, + "the nested copy is an instance of the original component again" + ); fillColor.assertEqual(fillColor.read(opCreateComponent.contentCreator.getRectangle(head)), BASELINE); // the reset clears the opacity, which the API then reads as null Assert.knownFailure( diff --git a/plugins/apps/composable-test-suite/src/composable-tests/operations/OpDetach.ts b/plugins/apps/composable-test-suite/src/composable-tests/operations/OpDetach.ts index 9211f924f7..ebd018c5b0 100644 --- a/plugins/apps/composable-test-suite/src/composable-tests/operations/OpDetach.ts +++ b/plugins/apps/composable-test-suite/src/composable-tests/operations/OpDetach.ts @@ -24,8 +24,13 @@ export class OpDetach extends Operation { async applyTo(situation: Situation): Promise { // act on the settled document, as a user would await PenpotSync.awaitPropagation(); - resolveTarget(this.target, situation).detach(); + const shape = resolveTarget(this.target, situation); + shape.detach(); await PenpotSync.awaitPropagation(); + // an API call that fails only logs, so a case would go on as if nothing happened + if (shape.component() != null) { + throw new Error(`the detach did not take effect: ${this}`); + } } toString(): string { diff --git a/plugins/apps/composable-test-suite/src/composable-tests/operations/OpSwap.ts b/plugins/apps/composable-test-suite/src/composable-tests/operations/OpSwap.ts index a295aa12fb..e98d4cecb2 100644 --- a/plugins/apps/composable-test-suite/src/composable-tests/operations/OpSwap.ts +++ b/plugins/apps/composable-test-suite/src/composable-tests/operations/OpSwap.ts @@ -30,8 +30,13 @@ export class OpSwap extends Operation { async applyTo(situation: Situation): Promise { // act on the settled document, as a user would await PenpotSync.awaitPropagation(); - resolveTarget(this.target, situation).swapComponent(this.component(situation)); + const to = this.component(situation); + resolveTarget(this.target, situation).swapComponent(to); await PenpotSync.awaitPropagation(); + // an API call that fails only logs, so a case would go on as if nothing happened + if (resolveTarget(this.target, situation).component()?.id !== to.id) { + throw new Error(`the swap did not take effect: ${this}`); + } } toString(): string {