mirror of
https://github.com/penpot/penpot.git
synced 2026-11-15 06:31:02 +00:00
2c16db6fae
Review found two defects in the bulk build. A reference may name a tempid the transaction never defines, because ref-resolver answers with whatever ctf/find-ref-shape names and that shape can sit in a container the builder skipped. The flattener resolved such a target to nil, which puts a nil-valued reference in the index. d/db-with refuses the whole transaction there, with :transact/syntax and "Tempids used only as value", so the bulk path refuses it too and names the defect: :projection/dangling-reference. A unit test pins both refusals, and pins that the same transaction works on both paths once the target is defined. The flattener is now tx->datoms, taking a transaction, so the case is testable without a document that reaches it. The timings in the docstring were the prototype's, taken on a JVM that had served the session. Re-taken thirty seconds after boot, with the first pass reported apart: a build is 800 ms cold and 471 to 513 ms warm against 2,357 ms and 2,147 to 2,181 ms, so 4.2 times rather than 5.3. The walk alone is 314 to 325 ms and steady from the first pass, which puts the flatten and the load together at about 185 ms of a warm build. Entity ids are an artefact of the interning order, and the docstring now says so: deleting one leaf shape shifts every later id. Two builds of one document are comparable by id and two builds of two documents are not, which is a constraint on whatever compares them. backend suite unchanged at 161 pre-existing failures, 826 tests and 5499 assertions against 824 and 5491 before.
946 lines
47 KiB
Clojure
946 lines
47 KiB
Clojure
;; 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 INC Sucursal en España SL
|
|
|
|
(ns backend-tests.graph-overlay-test
|
|
"The semantic suite of the datascript graph overlay: the beadpot graph
|
|
test suite (beadpot:tests/graph/transform) ported from Cypher to
|
|
Datalog, one fixture file.
|
|
|
|
Every deftest names the beadpot test it ports and the Penpot helper
|
|
that is the correctness oracle. A backported assertion that disagrees
|
|
with a helper is a beadpot bug: the helper's answer is asserted and the
|
|
divergence is noted in the docstring. Beadpot's idempotency tests have
|
|
no port here: `app.graph.overlay/build` is a pure function of the
|
|
document, so linking twice cannot duplicate an edge by construction.
|
|
|
|
The fixture is built exclusively with the common test helpers
|
|
(`app.common.test-helpers.*`), so it stays a legal file
|
|
(`thf/validate-file!` runs before the overlay is built)."
|
|
(:require
|
|
[app.common.files.helpers :as cfh]
|
|
[app.common.test-helpers.components :as thc]
|
|
[app.common.test-helpers.compositions :as tho]
|
|
[app.common.test-helpers.files :as thf]
|
|
[app.common.test-helpers.ids-map :as thi]
|
|
[app.common.test-helpers.shapes :as ths]
|
|
[app.common.test-helpers.tokens :as tht]
|
|
[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.shape :as cts]
|
|
[app.common.types.text :as txt]
|
|
[app.common.types.tokens-lib :as ctob]
|
|
[app.common.uuid :as uuid]
|
|
[app.graph.overlay :as overlay]
|
|
[app.graph.overlay.queries :as queries]
|
|
[clojure.test :as t]
|
|
[datascript.built-ins :as bi]
|
|
[datascript.core :as d]))
|
|
|
|
(t/use-fixtures :each thi/test-fixture)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; the fixture file
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- sample-fill
|
|
"A fill carrying a library color reference."
|
|
[color-id]
|
|
{:fill-color "#000000"
|
|
:fill-opacity 1
|
|
:fill-color-ref-id color-id})
|
|
|
|
(defn- sample-stroke
|
|
"A stroke carrying a library color reference."
|
|
[color-id]
|
|
{:stroke-style :solid
|
|
:stroke-alignment :inner
|
|
:stroke-width 1
|
|
:stroke-color "#000000"
|
|
:stroke-opacity 1
|
|
:stroke-color-ref-id color-id})
|
|
|
|
(defn- refs-content
|
|
"Text content whose text nodes carry `:typography-ref-id` and, when
|
|
`color-id` is given, a fill referencing it. Only text nodes are touched:
|
|
the content schema forbids these attributes on the root and
|
|
paragraph-set nodes."
|
|
[text typography-id color-id]
|
|
(let [content (txt/change-text nil text)]
|
|
(txt/transform-nodes
|
|
txt/is-text-node?
|
|
(fn [node]
|
|
(cond-> (assoc node :typography-ref-id typography-id)
|
|
(some? color-id)
|
|
(assoc :fills [(sample-fill color-id)])))
|
|
content)))
|
|
|
|
(defn- refs-text-shape
|
|
"A text shape whose content nodes carry the given references."
|
|
[typography-id color-id]
|
|
(-> (cts/setup-shape {:type :text :x 0 :y 0})
|
|
(assoc :content (refs-content "Typography sample" typography-id color-id)
|
|
:position-data nil)))
|
|
|
|
(defn- oracle-containers
|
|
"The builder's resolution containers, one per page plus one per
|
|
component that carries its own `:objects` snapshot, as [ctn-container
|
|
container-id] pairs (`app.graph.overlay/ref-resolver`)."
|
|
[data]
|
|
(concat (map (fn [[id page]] [(ctn/make-container page :page) id])
|
|
(:pages-index data))
|
|
(keep (fn [[cid component]]
|
|
(when (seq (:objects component))
|
|
[(ctn/make-container component :component) cid]))
|
|
(:components data))))
|
|
|
|
(defn- document-containers
|
|
"Every [container-id objects] pair the overlay indexes: the pages, plus
|
|
the `:objects` snapshot a deleted component carries
|
|
(`app.common.types.file/load-component-objects`)."
|
|
[data]
|
|
(map (fn [[container cid]] [cid (:objects container)])
|
|
(oracle-containers data)))
|
|
|
|
(defn- oracle-refs
|
|
"`ctf/find-ref-shape`'s answer for every copy shape, as
|
|
[src-container src-id tgt-container tgt-id]: the oracle behind the
|
|
builder-resolved `:shape/refers-to` (`:include-deleted? true`,
|
|
`:with-context? true`)."
|
|
[data]
|
|
(let [file {:id (:id data) :data data}]
|
|
(into #{}
|
|
(for [[container cid] (oracle-containers data)
|
|
shape (vals (:objects container))
|
|
:when (:shape-ref shape)
|
|
:let [ref (ctf/find-ref-shape file container {} shape
|
|
:include-deleted? true
|
|
:with-context? true)]
|
|
:when (some? ref)]
|
|
[cid (:id shape)
|
|
(:id (:container (meta ref)))
|
|
(:id ref)]))))
|
|
|
|
(defn- semantic-fixture
|
|
"One rich file exercising every indexed attribute:
|
|
|
|
- page 1 holds a board with three children, two text shapes whose
|
|
content nodes reference a typography (one of them an undefined id),
|
|
and a rect referencing an undefined colour;
|
|
- :comp-1 (frame, child, grandchild) has a copy with labelled children;
|
|
- :comp-2 is deleted through a raw :del-component change, so its record
|
|
keeps the main-instance subtree in its own :objects;
|
|
- :comp-a/:comp-b/:comp-c model a variant swap: the copy of :comp-c
|
|
carries a nested instance of :comp-a which is swapped for :comp-b,
|
|
seeding the swapped-in head with a swap slot;
|
|
- two token sets hold four tokens; three are applied to shapes, one of
|
|
them under two attributes, and one applied name the lib never defines;
|
|
- page 2 holds one rect referencing a library colour.
|
|
|
|
Returns {:file file :data data :db db}."
|
|
[]
|
|
;; Asset ids that are labelled but never added to the library: references
|
|
;; to them must produce no edge.
|
|
(thi/new-id! :color-ghost)
|
|
(thi/new-id! :typo-ghost)
|
|
|
|
(let [file (-> (thf/sample-file :semantic-file :page-label :main-page)
|
|
(ths/add-sample-library-color :color-fill :name "Fill red" :color "#ff0000")
|
|
(ths/add-sample-library-color :color-stroke :name "Stroke blue" :color "#0000ff")
|
|
(ths/add-sample-library-color :color-unused :name "Unused green" :color "#00ff00")
|
|
(ths/add-sample-typography :typo-main :name "Main typography")
|
|
(ths/add-sample-typography :typo-unused :name "Unused typography")
|
|
(tho/add-frame :board :name "Board")
|
|
(ths/add-sample-shape :board-rect {:type :rect
|
|
:name "Board rect"
|
|
:parent-label :board
|
|
:fills [(sample-fill (thi/id :color-fill))]
|
|
:strokes [(sample-stroke (thi/id :color-stroke))]})
|
|
(ths/add-sample-shape :board-circle {:type :circle
|
|
:name "Board circle"
|
|
:parent-label :board
|
|
:fills [(sample-fill (thi/id :color-ghost))]})
|
|
(tho/add-text :board-text "Board label" :text-params {:parent-label :board})
|
|
(ths/add-sample-shape :typo-text (refs-text-shape (thi/id :typo-main) (thi/id :color-fill)))
|
|
(ths/add-sample-shape :ghost-typo-text (refs-text-shape (thi/id :typo-ghost) nil))
|
|
(ths/add-sample-shape :ghost-rect {:type :rect
|
|
:name "Ghost rect"
|
|
:fills [(sample-fill (thi/id :color-ghost))]})
|
|
(tho/add-frame :comp-1-root :name "C1 root")
|
|
(ths/add-sample-shape :comp-1-child {:type :rect
|
|
:name "C1 child"
|
|
:parent-label :comp-1-root})
|
|
(ths/add-sample-shape :comp-1-grandchild {:type :circle
|
|
:name "C1 grandchild"
|
|
:parent-label :comp-1-child})
|
|
(thc/make-component :comp-1 :comp-1-root)
|
|
(thc/instantiate-component :comp-1 :comp-1-copy
|
|
:children-labels [:comp-1-copy-child :comp-1-copy-grandchild])
|
|
(tho/add-frame :comp-2-root :name "C2 root")
|
|
(ths/add-sample-shape :comp-2-child {:type :rect
|
|
:name "C2 child"
|
|
:parent-label :comp-2-root})
|
|
(thc/make-component :comp-2 :comp-2-root))]
|
|
|
|
(let [file (thf/apply-changes file {:redo-changes [{:type :del-component
|
|
:id (thi/id :comp-2)}]})
|
|
file (-> file
|
|
(tho/add-frame :comp-a-root :name "CA root")
|
|
(thc/make-component :comp-a :comp-a-root)
|
|
(tho/add-frame :comp-b-root :name "CB root")
|
|
(thc/make-component :comp-b :comp-b-root)
|
|
(tho/add-frame :comp-c-root :name "CC root")
|
|
(thc/instantiate-component :comp-a :nested-a :parent-label :comp-c-root)
|
|
(thc/make-component :comp-c :comp-c-root)
|
|
(thc/instantiate-component :comp-c :comp-c-copy :children-labels [:nested-a-copy])
|
|
(thc/component-swap :nested-a-copy :comp-b :swapped-b))
|
|
|
|
file (-> file
|
|
(tht/add-tokens-lib)
|
|
(tht/update-tokens-lib
|
|
(fn [lib]
|
|
(-> lib
|
|
(ctob/add-set (ctob/make-token-set :id (thi/new-id! :token-set-a)
|
|
:name "core"))
|
|
(ctob/add-set (ctob/make-token-set :id (thi/new-id! :token-set-b)
|
|
:name "layout"))
|
|
(ctob/add-token (thi/id :token-set-a)
|
|
(ctob/make-token :id (thi/new-id! :token-color-fill)
|
|
:name "color.fill"
|
|
:type :color
|
|
:value "#112233"))
|
|
(ctob/add-token (thi/id :token-set-a)
|
|
(ctob/make-token :id (thi/new-id! :token-color-stroke)
|
|
:name "color.stroke"
|
|
:type :color
|
|
:value "#445566"))
|
|
(ctob/add-token (thi/id :token-set-b)
|
|
(ctob/make-token :id (thi/new-id! :token-size)
|
|
:name "size.dim"
|
|
:type :dimensions
|
|
:value 100))
|
|
(ctob/add-token (thi/id :token-set-b)
|
|
(ctob/make-token :id (thi/new-id! :token-spacing)
|
|
:name "spacing.gap"
|
|
:type :spacing
|
|
:value 8))))))
|
|
|
|
file (-> file
|
|
;; one token applied under two attributes: two uses
|
|
(tht/apply-token-to-shape :board-rect "size.dim" [:width :height] [:width :height] 100)
|
|
;; one token applied by two shapes: two uses
|
|
(tht/apply-token-to-shape :board-rect "color.fill" [:fill] [:fill] "#112233")
|
|
(tht/apply-token-to-shape :board-circle "color.fill" [:fill] [:fill] "#112233")
|
|
;; an applied name the lib never defines: no use
|
|
(tht/apply-token-to-shape :ghost-rect "ghost.token" [:fill] [:fill] "#000000"))
|
|
|
|
file (-> file
|
|
(thf/add-sample-page :second-page :name "Second page")
|
|
(ths/add-sample-shape :page2-rect {:type :rect
|
|
:name "P2 rect"
|
|
:fills [(sample-fill (thi/id :color-fill))]}))]
|
|
|
|
(thf/validate-file! file)
|
|
{:file file
|
|
:data (:data file)
|
|
:db (overlay/build (:data file) file)})))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; components
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest component-inventory-matches-the-component-record-map
|
|
;; beadpot:tests/graph/transform/test_components.py::test_component_nodes_created
|
|
;; Oracle: the `:components` map of the data, and `ctkl/get-component`
|
|
;; include-deleted behaviour. The overlay indexes every record, deleted
|
|
;; ones included; the Ladybug projection drops deleted components, so the
|
|
;; two counts diverge on this fixture by design.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
records (:components data)
|
|
deleted-id (thi/id :comp-2)
|
|
deleted (ctkl/get-component data deleted-id true)]
|
|
|
|
(t/is (= (count records) (:components (queries/stats db))))
|
|
(t/is (= (count (ctkl/components-seq data))
|
|
(- (:components (queries/stats db))
|
|
(count (ctkl/deleted-components-seq data)))))
|
|
|
|
;; the deleted record is an entity flagged :component/deleted
|
|
(t/is (true? (:deleted deleted)))
|
|
(t/is (true? (:component/deleted (d/entity db (d/entid db [:component/id deleted-id])))))
|
|
|
|
;; the oracle: include-deleted? controls visibility; the overlay keeps it
|
|
(t/is (nil? (ctkl/get-component data deleted-id)))
|
|
(t/is (some? (ctkl/get-component data deleted-id true)))
|
|
|
|
;; the :del-component change snapshotted the main-instance subtree into
|
|
;; the record's own :objects, so the overlay has a component container
|
|
;; over that copy
|
|
(t/is (seq (:objects deleted)))
|
|
(let [container-eid (queries/container-eid db deleted-id)
|
|
snapshot-ids (d/q '[:find [?s ...]
|
|
:in $ ?id
|
|
:where
|
|
[?s :shape/container ?c]
|
|
[?c :container/id ?id]]
|
|
db deleted-id)]
|
|
(t/is (= :component (:container/kind (d/entity db container-eid))))
|
|
(t/is (= (count (:objects deleted)) (count snapshot-ids)))
|
|
(doseq [sid (keys (:objects deleted))]
|
|
(t/is (some? (queries/shape-eid db container-eid sid))
|
|
(str "snapshot shape " sid))))
|
|
|
|
;; the inventory the rest of the suite leans on, pinned once:
|
|
;; 22 page shapes + 2 root frames + 2 snapshot shapes = 26 shape
|
|
;; entities; 2 pages + the deleted component's snapshot = 3
|
|
;; containers; 5 folded token applications (the 4 resolvable uses
|
|
;; plus the ghost name, which the encoding stores); 6 copy shapes
|
|
;; carrying a shape-ref, all 6 resolved by the builder
|
|
(t/is (= {:documents 1
|
|
:containers 3
|
|
:shapes 26
|
|
:components 5
|
|
:colors 3
|
|
:typographies 2
|
|
:token-sets 2
|
|
:tokens 4
|
|
:token-uses 5
|
|
:refs-resolved 6
|
|
:refs-carried 6}
|
|
(dissoc (queries/stats db) :datoms)))))
|
|
|
|
(t/deftest components-are-children-of-the-document
|
|
;; beadpot:tests/graph/transform/test_components.py::test_component_nodes_are_children_of_document
|
|
;; Oracle: the document entity of the overlay. Every component record,
|
|
;; deleted ones included, is a child of the one document entity.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
doc-eid (d/entid db [:document/id (:id data)])
|
|
attached (d/q '[:find ?c ?d
|
|
:where
|
|
[?c :component/document ?d]]
|
|
db)]
|
|
(t/is (= (count (:components data)) (count attached)))
|
|
(t/is (every? #(= doc-eid (second %)) attached))))
|
|
|
|
(t/deftest refers-to-pairs-match-find-ref-shape
|
|
;; beadpot:tests/graph/transform/test_components.py::test_refers_to_edges_match_shape_refs
|
|
;; One RefersTo per copy shape the helper resolves, each pointing at the
|
|
;; shape `ctf/find-ref-shape` names. Oracle: `ctf/find-ref-shape` with
|
|
;; `:include-deleted? true` and `:with-context? true`, per copy shape,
|
|
;; per container. The builder-resolution retrofit replaced the id-join
|
|
;; encoding (`:shape/shape-ref` joined on `:shape/id`) with the helper's
|
|
;; answer materialised at build time; the consumer texts (`queries/refers-to-pairs`
|
|
;; and the `refers-to` rule) did not move.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
pairs (set (queries/refers-to-pairs db))]
|
|
|
|
;; every pair is the helper's answer: target container and id from
|
|
;; the context the helper attaches
|
|
(t/is (= (oracle-refs data) pairs))
|
|
|
|
;; all six copy shapes on the fixture resolve
|
|
(t/is (= 6 (count pairs)))))
|
|
|
|
(t/deftest instance-heads-link-only-to-live-components
|
|
;; beadpot:tests/graph/transform/test_components.py::test_all_instance_heads_linked_to_their_component
|
|
;; Oracle: `ctk/instance-of?`. The `instance-of` rule scoped to page
|
|
;; shapes must equal a scan of the predicate over the live component
|
|
;; records. The deleted component contributes nothing, even though its
|
|
;; orphaned main root still passes the raw predicate.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
live-comps (ctkl/components-seq data)
|
|
rule-pairs (set (d/q '[:find ?cid ?sid
|
|
:in $ %
|
|
:where
|
|
(on-page ?s)
|
|
(instance-of ?s ?c)
|
|
[?c :component/id ?cid]
|
|
[?s :shape/id ?sid]]
|
|
db queries/rules))
|
|
expected (set (for [component live-comps
|
|
[pid page] (:pages-index data)
|
|
[sid shape] (:objects page)
|
|
:when (ctk/instance-of? shape (:id data) (:id component))]
|
|
[(:id component) sid]))
|
|
deleted-id (thi/id :comp-2)]
|
|
|
|
(t/is (= expected rule-pairs))
|
|
(t/is (= 8 (count rule-pairs)))
|
|
|
|
;; no link to the deleted component
|
|
(t/is (empty? (d/q '[:find [?sid ...]
|
|
:in $ % ?cid
|
|
:where
|
|
(instance-of ?s ?c)
|
|
[?c :component/id ?cid]
|
|
[?s :shape/id ?sid]]
|
|
db queries/rules deleted-id)))
|
|
|
|
;; but its orphaned main root still passes the raw predicate
|
|
(let [main-root (get-in data [:pages-index (thi/id :main-page)
|
|
:objects (thi/id :comp-2-root)])]
|
|
(t/is (some? main-root))
|
|
(t/is (ctk/instance-of? main-root (:id data) deleted-id)))))
|
|
|
|
(t/deftest main-instance-frames-are-among-the-linked-heads
|
|
;; beadpot:tests/graph/transform/test_components.py::test_main_instances_are_linked
|
|
;; Oracle: the component records' :main-instance-page/:main-instance-id.
|
|
;; One main instance per live component, and each of those frames is an
|
|
;; instance head linked through `queries/instances-of`.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
triples (queries/component-main-instances db)
|
|
live (ctkl/components-seq data)]
|
|
|
|
(t/is (= (set (map :id (filter #(and (:main-instance-id %)
|
|
(:main-instance-page %))
|
|
live)))
|
|
(set (map first triples))))
|
|
(t/is (= (count live) (count triples)))
|
|
(doseq [[cid pid mid] triples]
|
|
(t/is (contains? (set (queries/instances-of db cid (:id data)))
|
|
[pid mid])))))
|
|
|
|
(t/deftest parent-heads-match-the-container-walk
|
|
;; No beadpot counterpart: this is the overlay's own pin that its parent
|
|
;; topology equals the document's. Oracle: `ctn/get-parent-heads` over the
|
|
;; page objects, order included (top-down), for every shape on every page.
|
|
(let [{:keys [data db]} (semantic-fixture)]
|
|
(doseq [[pid page] (:pages-index data)
|
|
[sid shape] (:objects page)]
|
|
(let [expected (mapv :id (ctn/get-parent-heads (:objects page) shape))
|
|
actual (queries/parent-heads db pid sid)]
|
|
(t/is (= expected actual)
|
|
(str "parent heads of " sid))))
|
|
|
|
;; a copy's descendant: the copy root is its only head
|
|
(t/is (= [(thi/id :comp-1-copy)]
|
|
(queries/parent-heads db (thi/id :main-page)
|
|
(thi/id :comp-1-copy-grandchild))))
|
|
|
|
;; a nested instance: two heads, outer first
|
|
(t/is (= [(thi/id :comp-c-root) (thi/id :nested-a)]
|
|
(queries/parent-heads db (thi/id :main-page) (thi/id :nested-a))))))
|
|
|
|
(t/deftest instances-of-matches-an-instance-of-scan
|
|
;; beadpot:tests/graph/transform/test_components.py::test_all_instance_heads_linked_to_their_component
|
|
;; (the exhaustive complement: the query against the scan)
|
|
;; Oracle: `ctk/instance-of?` over every page's objects. The standing
|
|
;; query traverses the `instance-of` rule, whose live-component guard
|
|
;; is the rule's business, so the scan runs over the live component
|
|
;; records only; the deleted component's orphaned main root is pinned
|
|
;; below to answer nothing.
|
|
(let [{:keys [data db]} (semantic-fixture)]
|
|
(doseq [component (ctkl/components-seq data)]
|
|
(let [expected (set (for [[pid page] (:pages-index data)
|
|
[sid shape] (:objects page)
|
|
:when (ctk/instance-of? shape (:id data) (:id component))]
|
|
[pid sid]))]
|
|
(t/is (= expected (set (queries/instances-of db (:id component) (:id data))))
|
|
(str "instances of " (:name component)))))
|
|
|
|
;; the deleted component: the rule's live guard answers nothing,
|
|
;; while the raw predicate still sees the orphaned main root
|
|
(let [deleted-id (thi/id :comp-2)]
|
|
(t/is (empty? (queries/instances-of db deleted-id (:id data))))
|
|
(let [main-root (get-in data [:pages-index (thi/id :main-page)
|
|
:objects (thi/id :comp-2-root)])]
|
|
(t/is (ctk/instance-of? main-root (:id data) deleted-id))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; descendants and identity
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest descendants-and-shape-identity-match-the-document
|
|
;; beadpot:tests/graph/transform/test_denormalization.py, the page_id and
|
|
;; component_id denormalization suite, mapped onto the overlay's identity
|
|
;; claim: shape ids are not unique, the (container, shape) pair is, so
|
|
;; every page object, the uuid/zero root frame of every page included,
|
|
;; must resolve through `queries/shape-eid`. The overlay does NOT
|
|
;; denormalize component-id downward (beadpot and Ladybug do): the
|
|
;; [?a :shape/component-id _] datom must equal `ctk/instance-head?`
|
|
;; exactly, or the `instance-of` rule stops answering `ctk/instance-of?`.
|
|
;; Oracle: `cfh/get-children-ids` and `ctk/instance-head?`.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
page1-id (thi/id :main-page)
|
|
page1 (get-in data [:pages-index page1-id])
|
|
board-id (thi/id :board)
|
|
objects (:objects page1)]
|
|
|
|
;; descendants: the overlay formulation of cfh/get-children-ids
|
|
(t/is (= (set (cfh/get-children-ids objects board-id))
|
|
(queries/descendant-ids db page1-id board-id)))
|
|
(t/is (= (set (filter #(= :rect (:type (get objects %)))
|
|
(cfh/get-children-ids objects board-id)))
|
|
(queries/descendant-ids-of-type db page1-id board-id :rect)))
|
|
(t/is (= (set (filter #(= :text (:type (get objects %)))
|
|
(cfh/get-children-ids objects board-id)))
|
|
(queries/descendant-ids-of-type db page1-id board-id :text)))
|
|
(t/is (= #{} (queries/descendant-ids db page1-id (thi/id :board-rect))))
|
|
|
|
;; identity: every object of every page resolves, uuid/zero included
|
|
(doseq [[pid page] (:pages-index data)
|
|
[sid _shape] (:objects page)]
|
|
(let [container-eid (queries/container-eid db pid)
|
|
shape-eid (queries/shape-eid db container-eid sid)]
|
|
(t/is (some? shape-eid)
|
|
(str "shape " sid " of page " pid))))
|
|
|
|
;; uuid/zero keys the root frame of every page: two distinct entities
|
|
(let [p1-root (queries/shape-eid db (queries/container-eid db page1-id)
|
|
uuid/zero)
|
|
p2-root (queries/shape-eid db (queries/container-eid db (thi/id :second-page))
|
|
uuid/zero)]
|
|
(t/is (some? p1-root))
|
|
(t/is (some? p2-root))
|
|
(t/is (not= p1-root p2-root))
|
|
(t/is (= 2 (count (queries/shape-eids db uuid/zero)))))
|
|
|
|
;; no downward denormalization: the overlay stores component-id iff the
|
|
;; helper sees a head
|
|
(doseq [[pid page] (:pages-index data)
|
|
[sid shape] (:objects page)]
|
|
(let [entity (d/entity db (queries/shape-eid db (queries/container-eid db pid)
|
|
sid))]
|
|
(t/is (= (boolean (ctk/instance-head? shape))
|
|
(boolean (some? (:shape/component-id entity))))
|
|
(str "component-id denormalization on " sid))
|
|
(when (:component-id shape)
|
|
(t/is (= (:component-id shape) (:shape/component-id entity))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Euler-tour numbering
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest euler-intervals-equal-the-walk-and-are-globally-disjoint-or-nested
|
|
;; No beadpot counterpart. The Euler-tour retrofit's two invariants:
|
|
;; (1) the interval form answers the recursive form, and both equal
|
|
;; `cfh/get-children-ids` (the oracle) for every frame of every
|
|
;; container; (2) one global counter numbers every container
|
|
;; (`app.graph.overlay/euler-numbering` threads it file-wide), so
|
|
;; [enter exit] intervals across the whole file are pairwise
|
|
;; disjoint-or-nested — a partial overlap is the signature of the
|
|
;; per-container-counter bug the 20260820 report guards against.
|
|
(let [{:keys [data db]} (semantic-fixture)]
|
|
(doseq [[cid objects] (document-containers data)
|
|
shape (vals objects)
|
|
:when (= :frame (:type shape))]
|
|
(let [sid (:id shape)
|
|
expected (set (cfh/get-children-ids objects sid))]
|
|
(t/is (= expected (queries/descendant-ids db cid sid))
|
|
(str "interval descendants of " sid))
|
|
(t/is (= expected (queries/descendant-ids-walk db cid sid))
|
|
(str "walk descendants of " sid))))
|
|
|
|
;; the global-counter claim: every [enter exit] pair across all
|
|
;; containers is disjoint or properly nested, never partially
|
|
;; overlapping
|
|
(let [enters (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/enter))
|
|
exits (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/exit))
|
|
intervals (mapv (fn [[eid enter]] [enter (get exits eid)]) enters)
|
|
ok? (fn [[e0 e1] [f0 f1]]
|
|
(or (<= e1 f0) (<= f1 e0)
|
|
(and (< e0 f0) (< f1 e1))
|
|
(and (< f0 e0) (< e1 f1))))]
|
|
(doseq [i (range (count intervals))
|
|
j (range (inc i) (count intervals))]
|
|
(t/is (ok? (nth intervals i) (nth intervals j))
|
|
(str "intervals " (pr-str (nth intervals i)) " and "
|
|
(pr-str (nth intervals j)) " partially overlap"))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; swap slots
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest fills-swap-slot-matches-swap-slot-entries
|
|
;; beadpot:tests/graph/transform/test_variants.py::test_fills_swap_slot_count_matches_fixture
|
|
;; and ::test_fills_swap_slot_id_matches_touched_entry
|
|
;; Oracle: `ctk/get-swap-slot` over the document. The swapped-in nested
|
|
;; copy root carries the replaced shape's id as its swap slot; the overlay
|
|
;; surfaces exactly one FillsSwapSlot per document swap-slot entry whose
|
|
;; target resolves. beadpot's test_swap_slot_entries_stripped_from_touched
|
|
;; is vacuous here: the overlay never stores :touched, so there is nothing
|
|
;; to strip.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
pairs (d/q '[:find ?sid ?sslot ?tid
|
|
:in $ %
|
|
:where
|
|
(on-page ?s)
|
|
(fills-swap-slot ?s ?t)
|
|
(on-page ?t)
|
|
[?s :shape/id ?sid]
|
|
[?s :shape/swap-slot ?sslot]
|
|
[?t :shape/id ?tid]]
|
|
db queries/rules)
|
|
slots (for [[_cid objects] (document-containers data)
|
|
shape (vals objects)
|
|
:let [slot (ctk/get-swap-slot shape)]
|
|
:when (some? slot)]
|
|
[(:id shape) slot])]
|
|
|
|
;; the count matches the swap-slot entries the helper finds
|
|
(t/is (= (count slots) (count pairs)))
|
|
|
|
;; one swapped-in head, one slot, one edge
|
|
(t/is (= 1 (count pairs)))
|
|
|
|
(doseq [[sid sslot tid] pairs]
|
|
;; the slot names the replaced shape: source and target differ, and
|
|
;; the target is a shape on a page
|
|
(t/is (= sslot tid))
|
|
(t/is (not= sid tid))
|
|
(t/is (= (thi/id :swapped-b) sid))
|
|
(t/is (= (thi/id :nested-a) tid)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; tokens
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest token-inventory-matches-the-tokens-lib
|
|
;; beadpot:tests/graph/transform/test_tokens.py::test_graph_round_trip_preserves_token_inventory
|
|
;; and ::test_graph_all_tokens_present
|
|
;; Oracle: the tokens lib itself. The overlay stores identity, type and
|
|
;; set membership; values and themes stay in the lib.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
lib (:tokens-lib data)
|
|
tokens (ctob/get-all-tokens lib)
|
|
graph-names (set (d/q '[:find [?n ...]
|
|
:where
|
|
[?t :token/name ?n]]
|
|
db))
|
|
graph-types (into {} (d/q '[:find ?type (count ?t)
|
|
:where
|
|
[?t :token/type ?type]]
|
|
db))]
|
|
|
|
(t/is (= (set (map :name tokens)) graph-names))
|
|
(t/is (= (frequencies (map :type tokens)) graph-types))
|
|
(t/is (= (count (ctob/get-sets lib)) (:token-sets (queries/stats db))))
|
|
(t/is (= 4 (:tokens (queries/stats db))))
|
|
|
|
;; token -> set membership, per the lib's own getters
|
|
(doseq [set* (ctob/get-sets lib)
|
|
token (vals (ctob/get-tokens- set*))]
|
|
(let [set-eid (d/entid db [:token-set/id (ctob/get-id set*)])
|
|
tok-eid (d/entid db [:token/id (:id token)])]
|
|
(t/is (some? tok-eid))
|
|
(t/is (= set-eid (:db/id (:token/set (d/entity db tok-eid))))
|
|
(str "set of token " (:name token)))
|
|
(t/is (= (ctob/get-name set*)
|
|
(:token-set/name (d/entity db set-eid))))))))
|
|
|
|
(t/deftest applied-tokens-produce-exactly-the-resolvable-uses
|
|
;; beadpot:tests/graph/transform/test_tokens.py::test_link_applied_tokens_creates_exact_edge_set
|
|
;; plus ::test_shared_token_has_multiple_incoming_edges and
|
|
;; ::test_same_token_two_attributes_yields_two_edges
|
|
;; Oracle: a scan of every container's :applied-tokens, restricted to
|
|
;; names the lib defines. The consumer texts are unchanged; underneath,
|
|
;; the token-use entities are gone and the `uses-token` rule reads the
|
|
;; folded token attributes instead. beadpot's enum-key parsing test is a
|
|
;; document-format concern that Clojure keywords make moot.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data)))
|
|
expected (set (for [[cid objects] (document-containers data)
|
|
shape (vals objects)
|
|
[prop name] (:applied-tokens shape)
|
|
:when (contains? lib-names name)]
|
|
[cid (:id shape) prop]))
|
|
actual (set (mapcat #(queries/shapes-using-token db %) lib-names))]
|
|
|
|
(t/is (= expected actual))
|
|
|
|
;; 5 folded applications on the fixture: the 4 resolvable uses the
|
|
;; rule surfaces, plus the ghost name the encoding still stores
|
|
(t/is (= 5 (:token-uses (queries/stats db))))
|
|
|
|
;; a token applied by two shapes has two uses
|
|
(let [shared (queries/shapes-using-token db "color.fill")]
|
|
(t/is (= #{(thi/id :board-rect) (thi/id :board-circle)}
|
|
(set (map second shared)))))
|
|
|
|
;; one shape applying one token under two attributes yields two triples
|
|
(let [two-attrs (queries/shapes-using-token db "size.dim")]
|
|
(t/is (= 2 (count two-attrs)))
|
|
(t/is (= 1 (count (set (map second two-attrs)))))
|
|
(t/is (= #{:width :height} (set (map #(nth % 2) two-attrs)))))
|
|
|
|
;; a name the lib never defines produces no edge...
|
|
(t/is (empty? (queries/shapes-using-token db "ghost.token")))
|
|
|
|
;; ...but the folded encoding stores it: the datom is present, the
|
|
;; rule hides it (its join on :token/name finds no entity)
|
|
(let [ghost-eid (queries/shape-eid db (queries/container-eid db (thi/id :main-page))
|
|
(thi/id :ghost-rect))]
|
|
(t/is (= "ghost.token" (:token/fill (d/entity db ghost-eid))))
|
|
(t/is (= [[:token/fill "ghost.token"]]
|
|
(map (juxt :a :v) (d/datoms db :eavt ghost-eid :token/fill)))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; colors and typographies
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest used-colors-and-typographies-match-the-raw-refs
|
|
;; beadpot's LinkUsedColors and LinkUsedTypographies transforms, verified
|
|
;; against the raw shape maps. Oracle: the shapes whose fills, strokes, or
|
|
;; text-content fills carry the color's ref id, and the shapes whose text
|
|
;; content carries the typography's ref id, read straight off the maps.
|
|
;; Unresolvable refs (id not in the library) produce no edge, mirroring
|
|
;; beadpot's node_exists guard.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
containers (document-containers data)
|
|
fill-refs (fn [fills] (into #{} (keep :fill-color-ref-id) fills))
|
|
stroke-refs (fn [strokes] (into #{} (keep :stroke-color-ref-id) strokes))
|
|
node-fill-refs (fn [content]
|
|
(into #{} (comp (mapcat :fills) (keep :fill-color-ref-id))
|
|
(txt/node-seq content)))
|
|
node-typo-refs (fn [content]
|
|
(into #{} (keep :typography-ref-id) (txt/node-seq content)))
|
|
color-users (fn [color-id]
|
|
(set (for [[cid objects] containers
|
|
shape (vals objects)
|
|
:when (or (contains? (fill-refs (:fills shape)) color-id)
|
|
(contains? (stroke-refs (:strokes shape)) color-id)
|
|
(contains? (node-fill-refs (:content shape)) color-id))]
|
|
[cid (:id shape)])))
|
|
typo-users (fn [typo-id]
|
|
(set (for [[cid objects] containers
|
|
shape (vals objects)
|
|
:when (contains? (node-typo-refs (:content shape)) typo-id)]
|
|
[cid (:id shape)])))]
|
|
|
|
(doseq [color-id (keys (:colors data))]
|
|
(t/is (= (color-users color-id)
|
|
(set (queries/shapes-using-color db color-id)))
|
|
(str "users of color " color-id)))
|
|
|
|
(doseq [typo-id (keys (:typographies data))]
|
|
(t/is (= (typo-users typo-id)
|
|
(set (queries/shapes-using-typography db typo-id)))
|
|
(str "users of typography " typo-id)))
|
|
|
|
;; pinned membership: fill, text-content fill, and cross-page use
|
|
(t/is (= #{[(thi/id :main-page) (thi/id :board-rect)]
|
|
[(thi/id :main-page) (thi/id :typo-text)]
|
|
[(thi/id :second-page) (thi/id :page2-rect)]}
|
|
(set (queries/shapes-using-color db (thi/id :color-fill)))))
|
|
(t/is (= #{[(thi/id :main-page) (thi/id :board-rect)]}
|
|
(set (queries/shapes-using-color db (thi/id :color-stroke)))))
|
|
(t/is (= #{[(thi/id :main-page) (thi/id :typo-text)]}
|
|
(set (queries/shapes-using-typography db (thi/id :typo-main)))))
|
|
(t/is (empty? (queries/shapes-using-typography db (thi/id :typo-unused))))
|
|
|
|
;; unresolvable refs produce no edge
|
|
(t/is (empty? (queries/shapes-using-color db (thi/id :color-ghost))))
|
|
(t/is (empty? (queries/shapes-using-typography db (thi/id :typo-ghost))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; the R1 invariance pin
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(def ^:private control-symbols
|
|
"Clause heads that structure a query rather than call a function, the
|
|
console gate's own list (`app.graph.overlay.console`)."
|
|
'#{not not-join or or-join and pull})
|
|
|
|
(def ^:private rule-names
|
|
(into #{} (map (comp first first)) queries/rules))
|
|
|
|
(def ^:private allowed-query-symbols
|
|
"The closed call vocabulary: the shared rules, datascript's built-in
|
|
query fns and aggregates, and the control forms — exactly the set the
|
|
console gate admits."
|
|
(-> #{}
|
|
(into (keys bi/query-fns))
|
|
(into (keys bi/aggregates))
|
|
(into control-symbols)
|
|
(into rule-names)))
|
|
|
|
(defn- query-call-symbols
|
|
"Every symbol in call position: heads of list clauses (rule
|
|
invocations, predicates, control forms). Mirrors the console gate's
|
|
walk over the query form."
|
|
[form]
|
|
(cond
|
|
(seq? form)
|
|
(into (if (symbol? (first form)) [(first form)] [])
|
|
(mapcat query-call-symbols)
|
|
(rest form))
|
|
|
|
(coll? form)
|
|
(into [] (mapcat query-call-symbols) form)
|
|
|
|
:else []))
|
|
|
|
(t/deftest consumer-query-texts-invoke-only-shared-rules
|
|
;; The R1 invariance claim. The 20260820 report verified the same
|
|
;; consumer query texts across the pre-retrofit and post-retrofit
|
|
;; encodings (docs.local/graph/20260820-report-graph-overlay-datascript.md);
|
|
;; this test holds two of them — instances inside a subtree, shapes
|
|
;; using a token — written once, runs them against the current
|
|
;; encoding, and pins that their call positions name only shared rules
|
|
;; and datascript built-ins. A text that cannot see an encoding cannot
|
|
;; break when the encoding changes.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data)))
|
|
instances-in-subtree
|
|
'[:find ?pid ?id
|
|
:in $ % ?cid ?sid
|
|
:where
|
|
[?c :container/id ?cid]
|
|
[?s :shape/container ?c]
|
|
[?s :shape/id ?sid]
|
|
(descendant-of ?i ?s)
|
|
(instance-of ?i ?comp)
|
|
[?i :shape/container ?pc]
|
|
[?pc :container/id ?pid]
|
|
[?i :shape/id ?id]]
|
|
shapes-using-token
|
|
'[:find ?cid ?id
|
|
:in $ % ?name
|
|
:where
|
|
[?tok :token/name ?name]
|
|
(uses-token ?s ?tok ?a)
|
|
[?s :shape/container ?c]
|
|
[?c :container/id ?cid]
|
|
[?s :shape/id ?id]]]
|
|
|
|
;; the texts answer on the current encoding: instances inside
|
|
;; comp-c's root are exactly the nested comp-a head
|
|
(t/is (= #{[(thi/id :main-page) (thi/id :nested-a)]}
|
|
(set (d/q instances-in-subtree db queries/rules
|
|
(thi/id :main-page) (thi/id :comp-c-root)))))
|
|
|
|
;; and every token text's answer equals the standing fn's
|
|
(doseq [name lib-names]
|
|
(t/is (= (set (map #(subvec % 0 2) (queries/shapes-using-token db name)))
|
|
(set (d/q shapes-using-token db queries/rules name)))
|
|
(str "token query text on " name)))
|
|
|
|
;; the texts only reference rule names: every list-clause head is a
|
|
;; shared rule or a datascript built-in, nothing else
|
|
(doseq [q [instances-in-subtree shapes-using-token]]
|
|
(doseq [sym (query-call-symbols q)]
|
|
(t/is (contains? allowed-query-symbols sym)
|
|
(str "call symbol " sym " in " (pr-str q)))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; parity counting
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest ladybug-parity-counts-pin-the-fixture
|
|
;; Hand-computed expectations under the Ladybug projection's conventions,
|
|
;; so the parity fn itself is pinned: page shapes minus root frames,
|
|
;; pages, and live components. 22 page shapes + 2 pages + 4 live
|
|
;; components = 28 IsChildOf; 8 on-page instance heads against live
|
|
;; components; 1 on-page swap slot. `:refers-to` now counts the
|
|
;; builder-resolved page->page references (the `refers-to` rule scoped
|
|
;; to page shapes on both sides), not id-join pairs: the derivation
|
|
;; below reads `ctf/find-ref-shape`'s answer per copy shape and keeps
|
|
;; the page->page ones. On this fixture every copy resolves to a live
|
|
;; main on a page, so the count is still 6 — the encoding changed, the
|
|
;; number did not.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
pages (vals (:pages-index data))
|
|
page-shapes (remove #(= uuid/zero (:id %))
|
|
(mapcat #(vals (:objects %)) pages))
|
|
live-comps (ctkl/components-seq data)
|
|
shape-on-page? (fn [id] (some #(contains? (:objects %) id) pages))
|
|
page-container? (fn [cid] (contains? (:pages-index data) cid))
|
|
live-head? (fn [shape]
|
|
(some (fn [component]
|
|
(ctk/instance-of? shape (:id data) (:id component)))
|
|
live-comps))
|
|
derived {:is-child-of (+ (count page-shapes)
|
|
(count pages)
|
|
(count live-comps))
|
|
:is-instance-of (count (filter live-head? page-shapes))
|
|
:refers-to (count (filter (fn [[_scid _sid tcid _tid]]
|
|
(page-container? tcid))
|
|
(oracle-refs data)))
|
|
:fills-swap-slot (count (filter #(let [slot (ctk/get-swap-slot %)]
|
|
(and slot (shape-on-page? slot)))
|
|
page-shapes))}]
|
|
|
|
(t/is (= derived (queries/ladybug-parity-counts db)))
|
|
(t/is (= {:is-child-of 28
|
|
:is-instance-of 8
|
|
:refers-to 6
|
|
:fills-swap-slot 1}
|
|
(queries/ladybug-parity-counts db)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; the build path
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest the-bulk-build-and-a-transaction-produce-one-graph
|
|
;; `overlay/build` assigns entity ids itself and loads the index bottom-up,
|
|
;; where transacting the same entity maps lets datascript assign them. The
|
|
;; two must index the same graph, and a transform that read the half-built
|
|
;; index instead of the document is the way that stops being true: the
|
|
;; bulk path has no half-built index to read, so such a transform would
|
|
;; silently see nothing here and see something on the transact path.
|
|
;;
|
|
;; Entity ids differ between the paths and carry no meaning, so the
|
|
;; comparison reads every id back through the tempid that minted it.
|
|
(let [{:keys [file]} (semantic-fixture)
|
|
tx (overlay/build-tx (:data file) file)
|
|
transacted (d/with (d/empty-db overlay/schema) tx)
|
|
by-tempid (fn [tempids]
|
|
(into {} (map (fn [[tempid eid]] [eid tempid]))
|
|
(dissoc tempids :db/current-tx)))
|
|
ref-attr? (into #{}
|
|
(keep (fn [[attr decl]]
|
|
(when (= :db.type/ref (:db/valueType decl)) attr)))
|
|
overlay/schema)
|
|
canonical (fn [db eid->tempid]
|
|
(into #{}
|
|
(map (fn [datom]
|
|
[(get eid->tempid (:e datom) (:e datom))
|
|
(:a datom)
|
|
(if (ref-attr? (:a datom))
|
|
(get eid->tempid (:v datom) (:v datom))
|
|
(:v datom))]))
|
|
(d/datoms db :eavt)))
|
|
bulk (overlay/build (:data file) file)
|
|
bulk-ids (reduce (fn [acc entity]
|
|
(let [tempid (:db/id entity)]
|
|
(if (contains? acc tempid)
|
|
acc
|
|
(assoc acc tempid (inc (count acc))))))
|
|
{}
|
|
tx)]
|
|
(t/is (= (count (d/datoms (:db-after transacted) :eavt))
|
|
(count (d/datoms bulk :eavt))))
|
|
(t/is (= (canonical (:db-after transacted) (by-tempid (:tempids transacted)))
|
|
(canonical bulk (by-tempid (into {} (map (fn [[t e]] [t e])) bulk-ids)))))
|
|
(t/is (= (queries/stats (:db-after transacted)) (queries/stats bulk)))
|
|
(t/is (= (queries/edge-counts (:db-after transacted)) (queries/edge-counts bulk)))))
|
|
|
|
(t/deftest a-reference-to-an-undefined-tempid-is-refused-on-both-paths
|
|
;; `ref-resolver` answers with the tempid of whatever shape
|
|
;; `ctf/find-ref-shape` names, and that shape can sit in a container the
|
|
;; builder skipped, so a reference may name a tempid the transaction never
|
|
;; defines. `d/db-with` refuses such a transaction outright, so the bulk
|
|
;; path must refuse it too: resolving the target to nil would index a
|
|
;; nil-valued reference, and allocating an entity for it would index an
|
|
;; edge to nothing, and neither would say so. This is a unit test of the
|
|
;; flattener rather than of a document, because no fixture reaches the
|
|
;; case and the risk lives here.
|
|
(let [tx [{:db/id "doc" :document/id (uuid/next)}
|
|
{:db/id "c/1" :container/id (uuid/next) :container/document "doc"}
|
|
{:db/id "s/1" :shape/id (uuid/next) :shape/container "c/1"
|
|
:shape/refers-to "s/absent"}]]
|
|
(t/is (thrown? clojure.lang.ExceptionInfo (overlay/tx->datoms tx)))
|
|
(t/is (= :projection/dangling-reference
|
|
(:error (ex-data (try (overlay/tx->datoms tx) (catch Throwable e e)))))
|
|
"the refusal names the defect rather than the symptom")
|
|
(t/is (thrown? clojure.lang.ExceptionInfo (d/with (d/empty-db overlay/schema) tx))
|
|
"as the transact path always did")
|
|
(let [whole (conj tx {:db/id "s/absent" :shape/id (uuid/next) :shape/container "c/1"})]
|
|
(t/is (= (count (d/datoms (:db-after (d/with (d/empty-db overlay/schema) whole)) :eavt))
|
|
(count (d/datoms (d/init-db (overlay/tx->datoms whole) overlay/schema) :eavt)))
|
|
"and with the target defined, both paths carry the same datoms"))))
|