diff --git a/common/src/app/common/test_helpers/composable/oracle.cljc b/common/src/app/common/test_helpers/composable/oracle.cljc index 59e4164573..d930403bb5 100644 --- a/common/src/app/common/test_helpers/composable/oracle.cljc +++ b/common/src/app/common/test_helpers/composable/oracle.cljc @@ -133,31 +133,54 @@ (defn canonical "Design data with shape, component and grid-cell IDs named by tree path. - Pure and frontend backends allocate different IDs for the same action." + Pure and frontend backends allocate different IDs for the same action. + Missing references use retained source paths; live names take precedence." ([situation] (canonical situation {})) ([situation opts] (let [files (sort-by (comp str key) (snapshot situation)) - ids (atom {#uuid "00000000-0000-0000-0000-000000000000" :root})] - (letfn [(name-tree [objects id path] + ids (atom {#uuid "00000000-0000-0000-0000-000000000000" :root})] + (letfn [(name-tree [names objects id path] (when-let [shape (get objects id)] - (swap! ids assoc id path) + (swap! names assoc id path) (doseq [[cell-id cell] (:layout-grid-cells shape)] - (swap! ids assoc cell-id [path :cell (:row cell) (:column cell)])) + (swap! names assoc cell-id [path :cell (:row cell) (:column cell)])) (doseq [[index child] (map-indexed vector (:shapes shape))] - (name-tree objects child (conj path index)))))] - (doseq [[file-index [file-id file]] (map-indexed vector files)] - (swap! ids assoc file-id [:file file-index]) - (doseq [[page-index page-id] (map-indexed vector (get-in file [:data :pages])) - :let [page (get-in file [:data :pages-index page-id])]] - (swap! ids assoc page-id [:file file-index :page page-index]) - (doseq [[index child] (map-indexed vector (get-in page [:objects #uuid "00000000-0000-0000-0000-000000000000" :shapes]))] - (name-tree (:objects page) child [:file file-index :page page-index index]))) - (doseq [[index [component-id component]] - (map-indexed vector (sort-by (comp str key) (get-in file [:data :components]))) - :let [path [:file file-index :component index]]] - (swap! ids assoc component-id path) - (when (:objects component) - (name-tree (:objects component) (:main-instance-id component) (conj path :main))))) + (name-tree names objects child (conj path index))))) + (name-file [names file path] + (swap! names assoc (:id file) path) + (doseq [[page-index page-id] (map-indexed vector (get-in file [:data :pages])) + :let [page (get-in file [:data :pages-index page-id]) + path (conj path :page page-index)]] + (swap! names assoc page-id path) + (doseq [[index child] (map-indexed vector (get-in page [:objects #uuid "00000000-0000-0000-0000-000000000000" :shapes]))] + (name-tree names (:objects page) child (conj path index)))) + (doseq [[index [component-id component]] + (map-indexed vector (sort-by (comp str key) (get-in file [:data :components]))) + :let [path (conj path :component index)]] + (swap! names assoc component-id path) + (when (:objects component) + (name-tree names (:objects component) (:main-instance-id component) (conj path :main)))))] + (doseq [[file-index [_ file]] (map-indexed vector files)] + (name-file ids file [:file file-index])) + (when (:accepted-libraries situation) + (doseq [[file-id file objects shape] + (sort-by #(pr-str (get @ids (:id (nth % 3)))) + (for [[file-id file] files + objects (cf/object-trees file) + shape (vals objects) + :when (and (:shape-ref shape) (contains? @ids (:id shape)))] + [file-id file objects shape])) + :when (not (contains? @ids (:shape-ref shape)))] + (let [libraries (cf/reference-libraries situation file-id (:id shape)) + container (ctn/make-container {:objects objects} :page)] + (when-let [reference (ctf/find-ref-shape file container libraries shape + :include-deleted? true :with-context? true)] + (let [source (:file (meta reference))] + (when-let [source-path (get @ids (:id source))] + (let [names (atom {})] + (name-file names source source-path) + (when-let [path (get @names (:shape-ref shape))] + (swap! ids assoc (:shape-ref shape) [:retained-ref (get @ids (:id shape)) path]))))))))) (walk/postwalk #(if (uuid? %) (get @ids % %) %) (design-snapshot situation opts)))))) (defn- paired-matrix-effects diff --git a/common/test/common_tests/logic/composable_gen_test.cljc b/common/test/common_tests/logic/composable_gen_test.cljc index 0a8047b046..63889dd80c 100644 --- a/common/test/common_tests/logic/composable_gen_test.cljc +++ b/common/test/common_tests/logic/composable_gen_test.cljc @@ -27,10 +27,93 @@ [app.common.test-helpers.shapes :as ths] [app.common.test-helpers.texts :as thtx] [app.common.uuid :as uuid] - [clojure.test :as t])) + [clojure.test :as t] + [clojure.walk :as walk])) (t/use-fixtures :each thi/test-fixture) +(t/deftest canonical-retained-references-survive-independent-uuid-allocation + (let [program {:world [0 0 {:library true :library-depth 0 :library-grid true :stale-libraries true}] + :ops [[:library-add-child 0] [:library-add-child 0] [:library-sync] [:library-undo 0]]} + situation (:situation (cg/run program)) + identifiers (atom #{}) + _ (walk/postwalk #(do (when (uuid? %) (swap! identifiers conj %)) %) situation) + mapping (into {uuid/zero uuid/zero} + (map #(vector % (uuid/next))) (sort-by str (disj @identifiers uuid/zero))) + renamed (walk/postwalk #(if (uuid? %) (get mapping %) %) situation) + expected (oracle/canonical situation) + actual (oracle/canonical renamed)] + (t/is (true? (oracle/equivalent? expected actual))) + (t/is (empty? (for [file (vals expected) + objects (cf/object-trees file) + shape (vals objects) + :when (uuid? (:shape-ref shape))] + (:shape-ref shape)))))) + +(t/deftest canonical-retained-references-preserve-identity-and-reject-corruption + (let [situation (:situation + (cg/run {:world [0 0 {:library true :library-depth 0 :library-grid true :stale-libraries true}] + :ops [[:library-add-child 0] [:library-add-child 0] [:library-sync] + [:library-undo 0] [:library-undo 0] [:library-add-child 0]]})) + source-op (cg/resolve-op situation {} [:library-add-child 0]) + owner (:library-id source-op) + main-id (get-in source-op [:shape :id]) + source (get (cf/all-files situation) owner) + current (:shapes (tm/shape-by-id (tm/with-file situation source) main-id)) + copy (:shape (first (filter #(= main-id (get-in % [:shape :shape-ref])) (cg/tree situation)))) + accepted (get (cf/reference-libraries situation copy) owner) + prior (:shapes (tm/shape-by-id (tm/with-file situation accepted) main-id)) + retained (set (remove (set current) prior)) + objects (:objects (thf/current-page (tm/file situation))) + images (filterv #(contains? retained (:shape-ref (get objects %))) (:shapes copy)) + id (first images) + other (second images) + canonical (oracle/canonical situation) + trees (mapcat cf/object-trees (vals canonical)) + live-ids (into #{} (mapcat keys) trees) + missing (remove live-ids (keep :shape-ref (mapcat vals trees))) + replaced (first (remove (set prior) current)) + corrupt (fn [changes] + (let [file (tm/file situation) + page-id (:id (thf/current-page file))] + (oracle/canonical + (tm/with-file situation + (reduce-kv #(assoc-in %1 [:data :pages-index page-id :objects %2 :shape-ref] %3) + file changes)))))] + (t/is (= 2 (count retained))) + (t/is (= [2 2] (sort (vals (frequencies missing))))) + (t/is (not-any? uuid? missing)) + (doseq [changes [{id (uuid/next)} + {id (:shape-ref (get objects other))} + {id (:shape-ref (get objects other)) other (:shape-ref (get objects id))} + {id replaced}]] + (t/is (false? (oracle/equivalent? canonical (corrupt changes))))) + (let [file (first (filter #(= (:name source) (:name %)) (vals canonical))) + main (first (filter :main-instance (mapcat vals (cf/object-trees file))))] + (t/is (= (mapv #(conj (:id main) %) (range (count (:shapes main)))) (:shapes main)))))) + +(t/deftest canonical-retained-versions-do-not-merge-replacements-at-the-same-path + (let [situation (:situation + (cg/run {:world [0 0 {:library true :library-depth 0 :library-grid true :stale-libraries true}] + :ops [[:library-add-child 0] [:reset 0] [:library-undo 0] + [:library-add-child 0] [:reset 1] [:library-undo 0]]})) + canonical (oracle/canonical situation) + trees (mapcat cf/object-trees (vals canonical)) + live-ids (into #{} (mapcat keys) trees) + retained (remove live-ids (keep :shape-ref (mapcat vals trees))) + objects (:objects (thf/current-page (tm/file situation))) + missing (vec (filter #(and (:shape-ref %) (not (some (fn [tree] (get tree (:shape-ref %))) + (mapcat cf/object-trees (vals (cf/all-files situation)))))) + (vals objects))) + file (tm/file situation) + page-id (:id (thf/current-page file)) + swapped (-> file + (assoc-in [:data :pages-index page-id :objects (:id (first missing)) :shape-ref] (:shape-ref (second missing))) + (assoc-in [:data :pages-index page-id :objects (:id (second missing)) :shape-ref] (:shape-ref (first missing))))] + (t/is (= 2 (count retained) (count (set retained)) (count missing))) + (t/is (not-any? uuid? retained)) + (t/is (false? (oracle/equivalent? canonical (oracle/canonical (tm/with-file situation swapped))))))) + (t/deftest empty-grid-direction-edits-resolve-and-change-the-requested-shape (doseq [depth [0 1] scope [nil 1]] diff --git a/frontend/test/frontend_tests/composable_tests/generated_test.cljs b/frontend/test/frontend_tests/composable_tests/generated_test.cljs index 678d9a347c..8e712a6afe 100644 --- a/frontend/test/frontend_tests/composable_tests/generated_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/generated_test.cljs @@ -20,7 +20,6 @@ [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] [clojure.test.check.generators :as gen] - [clojure.walk :as walk] [frontend-tests.composable-tests.interpreter :as ftm] [frontend-tests.helpers.mock :as mock])) @@ -41,10 +40,8 @@ (defn- ^:async replay-program "Replay a JVM-shrunk EDN program against the async frontend. The pure runner chooses targets independently and both must make the same choices." - [{:keys [world ops parity-failures] :as program}] + [{:keys [world ops] :as program}] (try - (when-not (every? (set ops) (keys parity-failures)) - (throw (ex-info "A parity failure mark names no replay step" {:marks (keys parity-failures)}))) (let [initial (cg/initial-state world)] (loop [state initial live (ftm/start-generated (:situation initial)) @@ -91,14 +88,9 @@ (let [parity {:relative-free-head-placement true} expected (oracle/canonical (:situation next-state) parity) actual (oracle/canonical next-live parity)] - (if-let [{:keys [bug pinned]} (get parity-failures tuple)] - (tm/known-failure bug [true [nil nil]] pinned - [(true? (oracle/equivalent? expected actual)) - (walk/postwalk #(if (uuid? %) :unmapped-ref %) - (thn/diff expected actual))]) - (t/is (true? (oracle/equivalent? expected actual)) - (str "Backend mismatch at " tuple "; replay " (pr-str program) - "; diff " (pr-str (thn/diff expected actual)))))) + (t/is (true? (oracle/equivalent? expected actual)) + (str "Backend mismatch at " tuple "; replay " (pr-str program) + "; diff " (pr-str (thn/diff expected actual))))) (t/is (empty? (uc/failures next-live)) (pr-str (uc/failures next-live))) (recur next-state next-live (rest tuples)))) (let [checked (await (ftm/finish-generated live))] @@ -244,14 +236,9 @@ :ops ops})))) (t/deftest ^:async accepted-source-child-undo-keeps-backend-parity - (let [difference {[:file 0] {:data {:pages-index - {[:file 0 :page 0] {:objects - {[:file 0 :page 0 0 2] {:shape-ref :unmapped-ref} - [:file 0 :page 0 1 2] {:shape-ref :unmapped-ref}}}}}}}] - (await (replay {:world [0 0 {:library true :library-depth 0 :library-grid true :stale-libraries true}] - :ops [[:library-add-child 0] [:library-add-child 0] [:library-sync] - [:library-undo 0] [:undo] [:library-redo 0] [:redo]] - :parity-failures {[:library-undo 0] {:bug :F251 :pinned [false [difference difference]]}}})))) + (await (replay {:world [0 0 {:library true :library-depth 0 :library-grid true :stale-libraries true}] + :ops [[:library-add-child 0] [:library-add-child 0] [:library-sync] + [:library-undo 0] [:undo] [:library-redo 0] [:redo]]}))) (t/deftest ^:async transitive-library-acceptance-keeps-each-editors-reference-history (await (replay {:world [0 0 {:library true :library-depth 0 :library-dependency true :stale-libraries true}] @@ -281,8 +268,7 @@ before (tm/file live) live (await (ftm/run-generated-source-step live owner (n/undo))) source (get (cf/all-files live) owner) - current (:shapes (tm/shape-by-id (tm/with-file live source) main-id)) - removed (first (remove (set current) ids))] + current (:shapes (tm/shape-by-id (tm/with-file live source) main-id))] (t/is (= 5 (count ids))) (t/is (= 4 (count current))) (t/is (= before (tm/file live))) @@ -290,12 +276,11 @@ (let [accepted (get (cf/reference-libraries live shape) owner)] (t/is (= ids (:shapes (tm/shape-by-id (tm/with-file live accepted) main-id)))))) (t/is (nil? (oracle/check live {}))) - (tm/known-failure :F251 [] [removed removed] - (vec (for [file (vals (oracle/canonical live)) - objects (cf/object-trees file) - shape (vals objects) - :when (uuid? (:shape-ref shape))] - (:shape-ref shape)))) + (t/is (= [] (vec (for [file (vals (oracle/canonical live)) + objects (cf/object-trees file) + shape (vals objects) + :when (uuid? (:shape-ref shape))] + (:shape-ref shape))))) (t/is (empty? (uc/failures (await (ftm/finish-generated live))))) (ftm/uninstall!)))))