✨ Make composable interpreter steps wait for pending work

The composable interpreter treated a step as done after a 60 ms gap
with no commits, and treated its 2 s timeout as done too. Slow sync or
reflow work could finish after the step, so a case could assert on a
half-synced file.

Each event step now waits, as the plugin waitForLayoutUpdate does,
until every pending work tracked by the reflow registry has drained:
the watcher's sync wait, the sync it starts, and layout and text
reflow. A step that does not drain within 2 s fails the test and names
the work still pending, and the next variant starts with nothing
pending.

The tests cover an edit with a deliberately slow sync, undo and redo
steps that must wait for the watcher's touch-component, translation
and derived commits, a sync that never finishes, and a restart of the
edit watchers, which must keep the undo entries of an edit the same.
This commit is contained in:
alonso.torres 2026-10-09 11:51:14 +02:00
parent 54339d0940
commit a4d42c72db
5 changed files with 285 additions and 50 deletions

View File

@ -123,13 +123,21 @@ nestings do not propagate between each other.
**Interpreter:** installs the situation's files into the global `st/state` (aux files tagged
`:library-of`), starts the production watchers the app starts — `dw/initialize-edit-watchers`
(undo stack, layout, text reflow, WASM text measurement; stopped by `dw/finalize-edit-watchers`)
and `dwl/watch-library-changes` (component + token watchers) — then maps
(undo stack, layout, text reflow, WASM text measurement; stopped by `dw/finalize-edit-watchers`,
replaced when started again) and `dwl/watch-library-changes` (component + token watchers;
replaced when started again) — then maps
event-ops to REAL workspace events (`dwsh/update-shapes`, `dwl/component-swap`,
`dwv/variants-switch`, `dwt/increase-rotation` — which runs the `check-delta` placement
classification — `dwt/update-dimensions`, `dwu/undo`, `dwl/sync-file`, …) and runs sync-ops'
`apply-to` against the live store file; awaits settlement (idle-gap heuristic + per-op grace) and
re-reads `:file` each step so the shared accessors keep working.
`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
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
`dwl/sync-file`), `frontend-tests.data.workspace-sync-barrier-test`. Re-reads `:file` each step
so the shared accessors keep working.
STORE-SWAP IMMUNITY: other test namespaces `set!` `st/state`/`st/stream` and never restore, while
the `app.main.refs` lenses stay bound to the ORIGINAL atoms — propagation then dies silently. The
interpreter captures the atoms at namespace-load time and re-`set!`s them per variant.

View File

@ -0,0 +1,174 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.composable-tests.completion-contract-test
"Tests the interpreter's completion contract: a step resolves only once the
work it caused has drained, whatever kind of commit it makes, and reports
the pending work when it does not drain in time. Component sync is slowed
down on purpose, so a step that resolved early would see a half-synced
file."
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.main.data.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.reflow :as wrf]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.undo :as dwu]
[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]
[potok.v2.core :as ptk]))
;; The watcher schedules thumbnail renders that reach `window`, absent
;; headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(def ^:private original "#abcdef")
(def ^:private red "#ff0000")
;; How much later than asked the slowed-down sync starts.
(def ^:private sync-delay-ms 150)
(defn- deferred-sync-file
"A replacement for `dwl/sync-file` that holds its sync wait open and runs
`work` on the event that `sync-file`, the real constructor, builds."
[sync-file work]
(mock/stub
(fn [& args]
(let [event (apply sync-file args)
file-id (first args)]
(ptk/reify ::deferred-sync-file
ptk/WatchEvent
(watch [_ _ _]
(wrf/with-pending :sync-file [file-id] (work event))))))))
(defn- slow-sync
[event]
(->> (rx/of event)
(rx/delay sync-delay-ms)))
(defn- endless-sync
[_]
(rx/create (fn [_] nil)))
(defn- pause
[ms]
(js/Promise. (fn [resolve] (js/setTimeout resolve ms))))
(defn- fill-main-child
[color]
(dwsh/update-shapes #{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color color))))
(defn- fill-of
[label]
(-> (ths/get-shape (ftm/current-file) label) :fills first :fill-color))
(defn- raw-fill-commit
"A main child fill commit with `opts` merged into its params."
[opts]
(let [page (thf/current-page (ftm/current-file))
changes (cls/generate-update-shapes
(pcb/empty-changes nil (:id page))
#{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color red))
(:objects page)
{})]
(dch/commit-changes (merge {:redo-changes (:redo-changes changes)
:undo-changes (:undo-changes changes)}
opts))))
(t/deftest ^:async edit-step-waits-for-slow-sync
(let [sync-file dwl/sync-file]
(await
(mock/with-mocks*
{dwl/sync-file (deferred-sync-file sync-file slow-sync)}
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (= :settled (await (ftm/await-step [(fill-main-child red)]))))
(t/is (= red (fill-of :copy-child)))))))
(t/deftest ^:async undo-and-redo-steps-follow-a-slow-sync
;; Undo must find the slow sync already committed: it reverts the edit and
;; its sync together only when both are on the undo stack. The pause after
;; the undo step lets any work that outlived the edit step land.
(let [sync-file dwl/sync-file]
(await
(mock/with-mocks*
{dwl/sync-file (deferred-sync-file sync-file slow-sync)}
(ftm/install! (setup/simple-component-with-labeled-copy))
(await (ftm/await-step [(fill-main-child red)]))
(t/is (= :settled (await (ftm/await-step [dwu/undo]))))
(await (pause (* 2 sync-delay-ms)))
(t/is (= original (fill-of :main-child)))
(t/is (= original (fill-of :copy-child)))
(t/is (= :settled (await (ftm/await-step [dwu/redo]))))
(t/is (= red (fill-of :main-child)))
(t/is (= red (fill-of :copy-child)))))))
(defn- watch-touches
"Count the `touch-component` events emitted from now on. Returns
`[count-atom subscription]`."
[]
(let [touches (atom 0)
sub (rx/sub! (rx/filter (ptk/type? ::dwl/touch-component) st/stream)
(fn [_] (swap! touches inc)))]
[touches sub]))
(t/deftest ^:async undo-and-redo-steps-wait-for-the-watcher
;; Undo and redo start no sync: the watcher only touches the component, a
;; timer turn after the commit. A step that resolved on the commit alone
;; would finish before that touch.
(ftm/install! (setup/simple-component-with-labeled-copy))
(await (ftm/await-step [(fill-main-child red)]))
(let [[touches sub] (watch-touches)]
(t/is (= :settled (await (ftm/await-step [dwu/undo]))))
(t/is (= 1 @touches) "the undo step waited for the watcher")
(t/is (= :settled (await (ftm/await-step [dwu/redo]))))
(t/is (= 2 @touches) "the redo step waited for the watcher")
(rx/dispose! sub)))
(t/deftest ^:async dropped-commit-steps-settle
;; Translation and derived commits start no sync; their steps must still
;; resolve.
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (= :settled (await (ftm/await-step [(raw-fill-commit {:translation? true})]))))
(t/is (= :settled (await (ftm/await-step [(raw-fill-commit {:skip-component-sync? true})])))))
(defn- run-endless-step
"Install a component whose sync never finishes and run a main edit step with
a short timeout. Resolves with the step result and the file id."
[]
(let [sync-file dwl/sync-file]
(mock/with-mocks*
{dwl/sync-file (deferred-sync-file sync-file endless-sync)}
(ftm/install! (setup/simple-component-with-labeled-copy))
(-> (ftm/await-step [(fill-main-child red)] 100)
(.then (fn [result] [result (:id (ftm/current-file))]))))))
(t/deftest ^:async step-that-never-settles-reports-the-pending-work
(let [[result file-id] (await (run-endless-step))]
(t/is (contains? (get-in result [:timeout file-id]) :sync-file))))
(t/deftest ^:async timed-out-step-does-not-hold-up-the-next-variant
;; The endless sync stays pending; installing the next variant forgets it.
(await (run-endless-step))
(ftm/install! (setup/simple-component-with-labeled-copy))
(t/is (empty? (wrf/pending)))
(t/is (= :settled (await (ftm/await-step [(fill-main-child red)]))))
(t/is (= red (fill-of :copy-child))))

View File

@ -16,8 +16,10 @@
2. an ASYNC interpreter that drives a sequence of operations through the REAL
app: it installs the situation's file into the global store, starts the
real component-change watcher, then for each operation dispatches its
event(s) and AWAITS settlement (so the app's AUTOMATIC propagation — not a
manual sync — is what runs), re-reading the file from the store after each.
event(s) and AWAITS all pending work it caused (`await-step`: the
watcher's sync wait and layout/text reflow, so the app's AUTOMATIC
propagation — not a manual sync — is what runs), re-reading the file
from the store after each. A step that does not settle in time fails.
3. `check` — the test-facing entry: takes {:setup :operation} + an OPTIONAL
asserter; enumerates the operation and runs each variant; assertions may
be inline (`Test` ops) and/or in the asserter.
@ -42,9 +44,9 @@
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.main.data.changes :as dch]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.reflow :as wrf]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.thumbnails :as dwth]
[app.main.data.workspace.transforms :as dwt]
@ -52,6 +54,7 @@
[app.main.data.workspace.variants :as dwv]
[app.main.repo :as rp]
[app.main.store :as st]
[app.plugins.reflow :as pwrf]
[beicon.v2.core :as rx]
[cljs.test :as t]
[frontend-tests.helpers.mock :as mock]
@ -215,15 +218,8 @@
;; (2) Async interpreter
;; --------------------------------------------------------------------------
(def ^:private settle-debounce-ms
"Resolve a step once the store's commit stream has been idle this long. This
captures the edit commit AND the watcher's follow-up sync commit, without a
fixed total delay. (Provisional: a fully deterministic per-op stopper would
await that op's specific component-changed/sync; debounce-idle is robust enough
for now.)"
60)
(def ^:private settle-timeout-ms 2000)
;; Longest a step may take to settle; a step that takes longer fails.
(def ^:private step-timeout-ms 2000)
(defn- install-situation-event
"An UpdateEvent installing the situation's files into the (global) store: the
@ -251,19 +247,26 @@
(let [st @st/state]
(get-in st [:files (:current-file-id st)])))
(defn- await-settle
"Dispatch `events` into the global store, then call `k` once the commit stream
has gone idle (debounced). A hard timeout guarantees progress."
[events k]
(let [stream (ptk/input-stream st/state)
commits (->> stream (rx/filter dch/commit?))
;; resolve on first idle gap after a commit, or on timeout
settled (->> commits
(rx/debounce settle-debounce-ms)
(rx/take 1)
(rx/timeout settle-timeout-ms (rx/of :settle/timeout)))]
(rx/subscribe settled (fn [_] (k)))
(doseq [e events] (st/emit! e))))
(defn await-step
"Emit `events` into the global store and return a promise that resolves with
`:settled` once every pending work has drained: component sync (the
watcher's wait for each commit and the sync it starts) and layout and text
reflow, as tracked by `app.main.data.workspace.reflow`. It waits the way the
plugin `waitForLayoutUpdate` does. When `timeout-ms` (default
`step-timeout-ms`) passes first, it resolves with `{:timeout pending}`, the
work still pending then. Relies on every producer opening its pending work
synchronously while the events are processed."
([events] (await-step events step-timeout-ms))
([events timeout-ms]
(doseq [e events] (st/emit! e))
(-> (pwrf/wait-for-layout-update nil timeout-ms)
(.then (constantly :settled))
(.catch (fn [_] {:timeout (wrf/pending)})))))
(defn- describe-pending
"The pending work map with the ids replaced by their test labels, if any."
[pending]
(update-keys pending #(or (cthi/label %) %)))
(defn- record-op
"Record an operation's application onto the situation (after its effect settled),
@ -333,34 +336,30 @@
(st/emit! (install-file-event (tm/file situation)))
situation))
(defn- op-grace-ms
"Extra wait AFTER an event-op has settled, before proceeding. Always zero:
the `rx/timer` and `rp/cmd!` calls that `SyncFromLibrary` schedules are
mocked (see `check`) so they fire instantly and succeed."
[_op]
0)
(defn- run-ops
"Async fold over `ops` (concrete operation units, in order — plain ops and/or
one-of RecordedChoice wrappers). Threads the situation. A SYNCHRONOUS op
(`sync-op?` — file-transforming or an inline `Test`) is applied synchronously
via `apply-to`; every other op dispatches its real workspace event(s) and awaits
settlement (plus a per-op grace period, see `op-grace-ms`). The file is re-read
from the store after each. Calls `k` with the final situation."
via `apply-to`; every other op dispatches its real workspace event(s) and
awaits all pending work (`await-step`). The file is re-read from the store
after each. Calls `k` with the final situation, or with nil when a step did
not settle in time; that step fails the test, naming the work still
pending."
[situation ops k]
(if (empty? ops)
(k situation)
(let [op (first ops)]
(if (sync-op? op)
(run-ops (run-sync-op situation op) (rest ops) k)
(await-settle
(op-events op situation)
(fn []
(let [continue #(run-ops (record-op situation op) (rest ops) k)
grace (op-grace-ms op)]
(if (pos? grace)
(js/setTimeout continue grace)
(continue)))))))))
(.then (await-step (op-events op situation))
(fn [result]
(if (= :settled result)
(run-ops (record-op situation op) (rest ops) k)
(do
(t/is false (str "Step did not settle in " step-timeout-ms "ms: "
(pr-str (type (if (tm/recorded-choice? op) (tm/choice-of op) op)))
"; pending: " (pr-str (describe-pending (:timeout result)))))
(k nil)))))))))
(defonce ^:private original-store
;; Captured at namespace-LOAD time — i.e. before any test in the run executes.
@ -383,11 +382,14 @@
(defn install!
"Install `situation` in the global store and start the watchers the workspace
starts, replacing the previous variant's. Restores the global store first (a
preceding namespace may have swapped it). Returns the situation."
preceding namespace may have swapped it) and forgets any pending work left
over, so a step that timed out earlier cannot hold up this variant's steps.
Stopping the previous layout watcher clears it too, but on the first install
of a run there is none. Returns the situation."
[situation]
(restore-global-store!)
(wrf/reset-pending!)
(st/emit! (install-situation-event situation)
(dw/finalize-edit-watchers)
(dw/initialize-edit-watchers)
(dwl/watch-library-changes))
situation)
@ -439,7 +441,7 @@
;; variant is a Sequence (or a single op).
(tm/sequence-ops (first vs))
(fn [situation]
(when asserter
(when (and asserter situation)
(t/testing (str "operations:\n " (tm/describe-applied situation))
(asserter situation)))
(run-next (rest vs))))))]

View File

@ -0,0 +1,47 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(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."
(:require
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.main.data.workspace :as dw]
[app.main.data.workspace.shapes :as dwsh]
[app.main.store :as st]
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.interpreter :as ftm]))
;; The watcher schedules thumbnail renders that reach `window`, absent
;; headless (see `ftm/install-thumbnail-noop!`).
(t/use-fixtures :each
{:before (fn []
(thi/reset-idmap!)
(ftm/install-thumbnail-noop!))
:after ftm/restore-thumbnail!})
(defn- undo-entries-for-an-edit
"Install a component with a copy, start the edit watchers `starts` times,
edit the main child and resolve with the number of undo entries added."
[starts]
(ftm/install! (setup/simple-component-with-labeled-copy))
(dotimes [_ (dec starts)]
(st/emit! (dw/initialize-edit-watchers)))
(swap! st/state dissoc :workspace-undo)
(-> (ftm/await-step
[(dwsh/update-shapes #{(thi/id :main-child)}
#(assoc % :fills (ths/sample-fills-color :fill-color "#ff0000")))])
(.then (fn [_]
(count (get-in @st/state [:workspace-undo :items]))))))
(t/deftest ^:async restarted-edit-watchers-record-each-commit-once
(let [once (await (undo-entries-for-an-edit 1))
twice (await (undo-entries-for-an-edit 2))]
(t/is (pos? once))
(t/is (= once twice))))

View File

@ -8,6 +8,7 @@
[frontend-tests.browser-history-test]
[frontend-tests.code-gen-style-test]
[frontend-tests.composable-tests.comp.sync-test]
[frontend-tests.composable-tests.completion-contract-test]
[frontend-tests.copy-as-svg-test]
[frontend-tests.data.comments-filters-test]
[frontend-tests.data.dashboard-test]
@ -29,6 +30,7 @@
[frontend-tests.data.workspace-colors-test]
[frontend-tests.data.workspace-comments-test]
[frontend-tests.data.workspace-context-menu-test]
[frontend-tests.data.workspace-edit-watchers-test]
[frontend-tests.data.workspace-interactions-test]
[frontend-tests.data.workspace-mcp-test]
[frontend-tests.data.workspace-media-test]
@ -167,6 +169,7 @@
['frontend-tests.basic-shapes-test
'frontend-tests.code-gen-style-test
'frontend-tests.composable-tests.comp.sync-test
'frontend-tests.composable-tests.completion-contract-test
'frontend-tests.copy-as-svg-test
'frontend-tests.data.comments-filters-test
'frontend-tests.data.dashboard-test
@ -188,6 +191,7 @@
'frontend-tests.data.workspace-colors-test
'frontend-tests.data.workspace-comments-test
'frontend-tests.data.workspace-context-menu-test
'frontend-tests.data.workspace-edit-watchers-test
'frontend-tests.data.workspace-interactions-test
'frontend-tests.data.workspace-mcp-test
'frontend-tests.data.workspace-media-test