content: nested-tree CvRDT (crdt-tree.sx) + 17 convergence tests (727/727)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
253
lib/content/tests/crdt-tree.sx
Normal file
253
lib/content/tests/crdt-tree.sx
Normal file
@@ -0,0 +1,253 @@
|
||||
;; Extension — nested-tree CvRDT. Sections nest and merge collaboratively;
|
||||
;; convergence is order/replica/duplicate-insensitive like the flat layer.
|
||||
|
||||
(st-bootstrap-classes!)
|
||||
(content-bootstrap-blocks!)
|
||||
(content-bootstrap-doc!)
|
||||
(content-bootstrap-render!)
|
||||
(content-bootstrap-section!)
|
||||
|
||||
(define same? (fn (a b) (= (get a :elements) (get b :elements))))
|
||||
|
||||
;; base: a section "s" at root, with one child heading.
|
||||
(define
|
||||
base
|
||||
(crdt-tree-insert
|
||||
(crdt-tree-insert
|
||||
(crdt-empty)
|
||||
"s"
|
||||
"section"
|
||||
(crdt-pos 1 0)
|
||||
""
|
||||
(list)
|
||||
1
|
||||
0)
|
||||
"h"
|
||||
"heading"
|
||||
(crdt-pos 1 0)
|
||||
"s"
|
||||
(list (list "level" 2) (list "text" "Sub"))
|
||||
1
|
||||
0))
|
||||
|
||||
;; ── materialise rebuilds the tree ──
|
||||
(content-test "tree order root" (crdt-tree-order base) (list "s"))
|
||||
(content-test
|
||||
"tree materialize ids"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" base))
|
||||
(list "s" "h"))
|
||||
(content-test
|
||||
"tree render"
|
||||
(asHTML (crdt-tree-materialize "d" base))
|
||||
"<section><h2>Sub</h2></section>")
|
||||
|
||||
;; ── concurrent inserts into the SAME section converge + order by pos ──
|
||||
(define
|
||||
rA
|
||||
(crdt-tree-insert
|
||||
base
|
||||
"a"
|
||||
"text"
|
||||
(crdt-pos 5 1)
|
||||
"s"
|
||||
(list (list "text" "A"))
|
||||
2
|
||||
1))
|
||||
(define
|
||||
rB
|
||||
(crdt-tree-insert
|
||||
base
|
||||
"b"
|
||||
"text"
|
||||
(crdt-pos 5 2)
|
||||
"s"
|
||||
(list (list "text" "B"))
|
||||
2
|
||||
2))
|
||||
(content-test
|
||||
"same-parent merge commutes"
|
||||
(same? (crdt-tree-merge rA rB) (crdt-tree-merge rB rA))
|
||||
true)
|
||||
(content-test
|
||||
"same-parent order deterministic"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge rA rB)))
|
||||
(list "s" "h" "a" "b"))
|
||||
|
||||
;; ── concurrent inserts into DIFFERENT parents converge ──
|
||||
(define
|
||||
base2
|
||||
(crdt-tree-insert
|
||||
(crdt-tree-insert
|
||||
(crdt-empty)
|
||||
"s1"
|
||||
"section"
|
||||
(crdt-pos 1 0)
|
||||
""
|
||||
(list)
|
||||
1
|
||||
0)
|
||||
"s2"
|
||||
"section"
|
||||
(crdt-pos 2 0)
|
||||
""
|
||||
(list)
|
||||
1
|
||||
0))
|
||||
(define
|
||||
x
|
||||
(crdt-tree-insert
|
||||
base2
|
||||
"x"
|
||||
"text"
|
||||
(crdt-pos 1 0)
|
||||
"s1"
|
||||
(list (list "text" "X"))
|
||||
2
|
||||
1))
|
||||
(define
|
||||
y
|
||||
(crdt-tree-insert
|
||||
base2
|
||||
"y"
|
||||
"text"
|
||||
(crdt-pos 1 0)
|
||||
"s2"
|
||||
(list (list "text" "Y"))
|
||||
2
|
||||
2))
|
||||
(define m (crdt-tree-merge x y))
|
||||
(content-test
|
||||
"different-parent commutes"
|
||||
(same? m (crdt-tree-merge y x))
|
||||
true)
|
||||
(content-test
|
||||
"different-parent tree"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" m))
|
||||
(list "s1" "x" "s2" "y"))
|
||||
(content-test
|
||||
"different-parent render"
|
||||
(asHTML (crdt-tree-materialize "d" m))
|
||||
"<section><p>X</p></section><section><p>Y</p></section>")
|
||||
|
||||
;; ── nested sections (section inside section) ──
|
||||
(define
|
||||
nested
|
||||
(crdt-tree-apply-all
|
||||
(crdt-empty)
|
||||
(list
|
||||
(crdt-tree-op-insert
|
||||
"outer"
|
||||
"section"
|
||||
(crdt-pos 1 0)
|
||||
""
|
||||
(list)
|
||||
1
|
||||
0)
|
||||
(crdt-tree-op-insert
|
||||
"inner"
|
||||
"section"
|
||||
(crdt-pos 1 0)
|
||||
"outer"
|
||||
(list)
|
||||
1
|
||||
0)
|
||||
(crdt-tree-op-insert
|
||||
"leaf"
|
||||
"text"
|
||||
(crdt-pos 1 0)
|
||||
"inner"
|
||||
(list (list "text" "deep"))
|
||||
1
|
||||
0))))
|
||||
(content-test
|
||||
"nested tree ids"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" nested))
|
||||
(list "outer" "inner" "leaf"))
|
||||
(content-test
|
||||
"nested render"
|
||||
(asHTML (crdt-tree-materialize "d" nested))
|
||||
"<section><section><p>deep</p></section></section>")
|
||||
|
||||
;; ── ops in any order converge (commutative) ──
|
||||
(define
|
||||
opA
|
||||
(crdt-tree-op-insert
|
||||
"p"
|
||||
"text"
|
||||
(crdt-pos 6 0)
|
||||
"s"
|
||||
(list (list "text" "P"))
|
||||
3
|
||||
1))
|
||||
(define opB (crdt-tree-op-update "h" "text" "Edited" 5 1))
|
||||
(define opC (crdt-tree-op-delete "h"))
|
||||
(content-test
|
||||
"ops commute"
|
||||
(same?
|
||||
(crdt-tree-apply-all base (list opA opB opC))
|
||||
(crdt-tree-apply-all base (list opC opB opA)))
|
||||
true)
|
||||
(content-test
|
||||
"ops idempotent"
|
||||
(same?
|
||||
(crdt-tree-apply-all base (list opA opB))
|
||||
(crdt-tree-apply-all
|
||||
(crdt-tree-apply-all base (list opA opB))
|
||||
(list opA opB)))
|
||||
true)
|
||||
|
||||
;; ── update into a section + LWW ──
|
||||
(define u1 (crdt-tree-update base "h" "text" "v5" 5 1))
|
||||
(define u2 (crdt-tree-update base "h" "text" "v7" 7 2))
|
||||
(content-test
|
||||
"tree LWW higher ts"
|
||||
(str
|
||||
(blk-send
|
||||
(doc-deep-find (crdt-tree-materialize "d" (crdt-tree-merge u1 u2)) "h")
|
||||
"text"))
|
||||
"v7")
|
||||
|
||||
;; ── delete inside a section ──
|
||||
(content-test
|
||||
"delete in section"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-delete base "h")))
|
||||
(list "s"))
|
||||
|
||||
;; ── merge idempotence ──
|
||||
(content-test "merge idempotent self" (same? (crdt-tree-merge m m) m) true)
|
||||
|
||||
;; ── full convergence: two replicas, divergent edits in different sections ──
|
||||
(define
|
||||
repl1
|
||||
(crdt-tree-apply-all
|
||||
base2
|
||||
(list
|
||||
(crdt-tree-op-insert
|
||||
"p1"
|
||||
"text"
|
||||
(crdt-pos 1 0)
|
||||
"s1"
|
||||
(list (list "text" "from1"))
|
||||
5
|
||||
1))))
|
||||
(define
|
||||
repl2
|
||||
(crdt-tree-apply-all
|
||||
base2
|
||||
(list
|
||||
(crdt-tree-op-insert
|
||||
"p2"
|
||||
"text"
|
||||
(crdt-pos 1 0)
|
||||
"s2"
|
||||
(list (list "text" "from2"))
|
||||
6
|
||||
2))))
|
||||
(content-test
|
||||
"two-replica tree converges"
|
||||
(same? (crdt-tree-merge repl1 repl2) (crdt-tree-merge repl2 repl1))
|
||||
true)
|
||||
(content-test
|
||||
"two-replica tree ids"
|
||||
(doc-tree-ids (crdt-tree-materialize "d" (crdt-tree-merge repl1 repl2)))
|
||||
(list "s1" "p1" "s2" "p2"))
|
||||
Reference in New Issue
Block a user