sx-git Phase 6: merge — diff3 textual 3-way, tree merge, ff detection (TDD)
Textual diff3 built on the Myers scripts: non-eq regions clustered by strict base-interval overlap (same-point insert pairs cluster too); one-sided clusters apply, two-sided take shared result or emit <<<<<<</|||||||/=======/ >>>>>>> markers with base section. Per-path 3-way tree merge with blob-level auto-merge and delete/modify flagging; merge-commits handles up-to-date / fast-forward / merged / conflicts, unrelated histories merge over an empty base. (Content CvRDT not reused deliberately: its state-based LWW block semantics differ from base-anchored 3-way; the path-set merge here is the same idea applied natively.) 28/28, total 187/187. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
235
lib/git/tests/merge.sx
Normal file
235
lib/git/tests/merge.sx
Normal file
@@ -0,0 +1,235 @@
|
||||
; Phase 6 — merge: textual diff3 with conflict markers, per-path 3-way tree
|
||||
; merge with blob auto-merge, fast-forward/up-to-date detection.
|
||||
|
||||
(define gmg-db (persist/mem-backend))
|
||||
(define gmg (git/repo gmg-db))
|
||||
|
||||
(define
|
||||
gmg-commit!
|
||||
(fn
|
||||
(files parents msg)
|
||||
(git/write
|
||||
gmg
|
||||
(git/commit (git/tree-from-files gmg files) parents {:message msg}))))
|
||||
|
||||
; ---- textual 3-way ----
|
||||
(git-test "merge3: untouched" (git/merge3-text "x\n" "x\n" "x\n") {:clean true :text "x\n" :conflicts 0})
|
||||
(git-test
|
||||
"merge3: ours-only change wins"
|
||||
(get (git/merge3-text "a\nb\n" "a\nB\n" "a\nb\n") :text)
|
||||
"a\nB\n")
|
||||
(git-test
|
||||
"merge3: theirs-only change wins"
|
||||
(get (git/merge3-text "a\nb\n" "a\nb\n" "a\nB\n") :text)
|
||||
"a\nB\n")
|
||||
(git-test
|
||||
"merge3: identical change on both sides is clean"
|
||||
(git/merge3-text "a\nb\n" "a\nZ\n" "a\nZ\n")
|
||||
{:clean true :text "a\nZ\n" :conflicts 0})
|
||||
(git-test
|
||||
"merge3: non-overlapping changes both apply"
|
||||
(git/merge3-text "a\nb\nc\n" "A\nb\nc\n" "a\nb\nC\n")
|
||||
{:clean true :text "A\nb\nC\n" :conflicts 0})
|
||||
(git-test
|
||||
"merge3: adjacent line changes merge cleanly"
|
||||
(get (git/merge3-text "l1\nl2\nl3\nl4\n" "l1\nX\nl3\nl4\n" "l1\nl2\nY\nl4\n") :text)
|
||||
"l1\nX\nY\nl4\n")
|
||||
(git-test
|
||||
"merge3: append and prepend both apply"
|
||||
(get (git/merge3-text "m\n" "m\ne\n" "s\nm\n") :text)
|
||||
"s\nm\ne\n")
|
||||
(git-test
|
||||
"merge3: clean deletion"
|
||||
(get (git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nb\nc\n") :text)
|
||||
"a\nc\n")
|
||||
|
||||
(git-test
|
||||
"merge3: overlapping edits conflict with diff3 markers"
|
||||
(git/merge3-text "a\nb\nc\n" "a\nX\nc\n" "a\nY\nc\n")
|
||||
{:clean false :text "a\n<<<<<<< ours\nX\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
|
||||
(git-test
|
||||
"merge3: delete vs modify conflicts"
|
||||
(git/merge3-text "a\nb\nc\n" "a\nc\n" "a\nY\nc\n")
|
||||
{:clean false :text "a\n<<<<<<< ours\n||||||| base\nb\n=======\nY\n>>>>>>> theirs\nc\n" :conflicts 1})
|
||||
(git-test
|
||||
"merge3: same-point insertions with different content conflict"
|
||||
(git/merge3-text "" "A\n" "B\n")
|
||||
{:clean false :text "<<<<<<< ours\nA\n||||||| base\n=======\nB\n>>>>>>> theirs\n" :conflicts 1})
|
||||
(git-test
|
||||
"merge3: same-point insertions with the same content are clean"
|
||||
(git/merge3-text "a\n" "a\nx\n" "a\nx\n")
|
||||
{:clean true :text "a\nx\n" :conflicts 0})
|
||||
(git-test
|
||||
"merge3: two separated conflicts are counted"
|
||||
(get
|
||||
(git/merge3-text
|
||||
"a\nb\nc\nd\ne\nf\ng\nh\ni\n"
|
||||
"a\nX1\nc\nd\ne\nf\ng\nX2\ni\n"
|
||||
"a\nY1\nc\nd\ne\nf\ng\nY2\ni\n")
|
||||
:conflicts)
|
||||
2)
|
||||
|
||||
; ---- tree-from-cids ----
|
||||
(git-test
|
||||
"tree-from-cids equals tree-from-files"
|
||||
(equal?
|
||||
(git/tree-from-cids
|
||||
gmg
|
||||
(assoc
|
||||
(assoc {} "a.txt" (git/write-blob gmg "1\n"))
|
||||
"s/b.txt"
|
||||
(git/write-blob gmg "2\n")))
|
||||
(git/tree-from-files
|
||||
gmg
|
||||
(assoc (assoc {} "a.txt" "1\n") "s/b.txt" "2\n")))
|
||||
true)
|
||||
|
||||
; ---- tree merge ----
|
||||
(define
|
||||
gmg-base-files
|
||||
(assoc (assoc {} "f.txt" "a\nb\nc\n") "g.txt" "same\n"))
|
||||
(define gmg-base-tree (git/tree-from-files gmg gmg-base-files))
|
||||
|
||||
(git-test
|
||||
"merge-trees: disjoint paths merge clean"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (assoc gmg-base-files "ours.txt" "o\n")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "theirs.txt" "t\n"))))
|
||||
(let
|
||||
((m (git/merge-trees gmg gmg-base-tree ta tb)))
|
||||
(list
|
||||
(get m :conflicts)
|
||||
(=
|
||||
(git/tree-files gmg (git/tree-from-cids gmg (get m :files)))
|
||||
(assoc (assoc gmg-base-files "ours.txt" "o\n") "theirs.txt" "t\n")))))
|
||||
(list (list) true))
|
||||
(git-test
|
||||
"merge-trees: same file, non-overlapping lines auto-merge"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "A\nb\nc\n")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nb\nC\n"))))
|
||||
(let
|
||||
((m (git/merge-trees gmg gmg-base-tree ta tb)))
|
||||
(list
|
||||
(get m :conflicts)
|
||||
(git/blob-data (git/read gmg (get (get m :files) "f.txt"))))))
|
||||
(list (list) "A\nb\nC\n"))
|
||||
(git-test
|
||||
"merge-trees: overlapping edits flag the path"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nX\nc\n")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
|
||||
(let
|
||||
((m (git/merge-trees gmg gmg-base-tree ta tb)))
|
||||
(=
|
||||
(list
|
||||
(get m :conflicts)
|
||||
(contains?
|
||||
(git/blob-data (git/read gmg (get (get m :files) "f.txt")))
|
||||
"<<<<<<< ours"))
|
||||
(list (list "f.txt") true))))
|
||||
true)
|
||||
(git-test
|
||||
"merge-trees: both delete is clean"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
|
||||
(tb (git/tree-from-files gmg (dissoc gmg-base-files "f.txt"))))
|
||||
(let
|
||||
((m (git/merge-trees gmg gmg-base-tree ta tb)))
|
||||
(list (get m :conflicts) (has-key? (get m :files) "f.txt"))))
|
||||
(list (list) false))
|
||||
(git-test
|
||||
"merge-trees: delete vs modify keeps the modified side and flags it"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (dissoc gmg-base-files "f.txt")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "f.txt" "a\nY\nc\n"))))
|
||||
(let
|
||||
((m (git/merge-trees gmg gmg-base-tree ta tb)))
|
||||
(=
|
||||
(list
|
||||
(get m :conflicts)
|
||||
(git/blob-data (git/read gmg (get (get m :files) "f.txt"))))
|
||||
(list (list "f.txt") "a\nY\nc\n"))))
|
||||
true)
|
||||
(git-test
|
||||
"merge-trees: both add the same file identically"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "n\n"))))
|
||||
(get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts))
|
||||
(list))
|
||||
(git-test
|
||||
"merge-trees: both add the same file differently"
|
||||
(let
|
||||
((ta (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N1\n")))
|
||||
(tb (git/tree-from-files gmg (assoc gmg-base-files "n.txt" "N2\n"))))
|
||||
(=
|
||||
(get (git/merge-trees gmg gmg-base-tree ta tb) :conflicts)
|
||||
(list "n.txt")))
|
||||
true)
|
||||
|
||||
; ---- commit-level ----
|
||||
(define gmg-c0 (gmg-commit! gmg-base-files (list) "base"))
|
||||
(define
|
||||
gmg-ca
|
||||
(gmg-commit! (assoc gmg-base-files "f.txt" "A\nb\nc\n") (list gmg-c0) "ours"))
|
||||
(define
|
||||
gmg-cb
|
||||
(gmg-commit!
|
||||
(assoc gmg-base-files "f.txt" "a\nb\nC\n")
|
||||
(list gmg-c0)
|
||||
"theirs"))
|
||||
(define
|
||||
gmg-cx
|
||||
(gmg-commit! (assoc gmg-base-files "f.txt" "a\nX\nc\n") (list gmg-c0) "ox"))
|
||||
(define
|
||||
gmg-cy
|
||||
(gmg-commit! (assoc gmg-base-files "f.txt" "a\nY\nc\n") (list gmg-c0) "oy"))
|
||||
|
||||
(git-test "ff? when ours is behind" (git/ff? gmg gmg-c0 gmg-ca) true)
|
||||
(git-test "ff? false for diverged heads" (git/ff? gmg gmg-ca gmg-cb) false)
|
||||
(git-test
|
||||
"merge-commits: up-to-date when theirs is an ancestor"
|
||||
(git/merge-commits gmg gmg-ca gmg-c0)
|
||||
{:cid gmg-ca :result "up-to-date"})
|
||||
(git-test
|
||||
"merge-commits: fast-forward when ours is an ancestor"
|
||||
(git/merge-commits gmg gmg-c0 gmg-ca)
|
||||
{:cid gmg-ca :result "fast-forward"})
|
||||
(git-test
|
||||
"merge-commits: clean 3-way produces the merged tree"
|
||||
(let
|
||||
((m (git/merge-commits gmg gmg-ca gmg-cb)))
|
||||
(list
|
||||
(get m :result)
|
||||
(get m :conflicts)
|
||||
(=
|
||||
(git/tree-files gmg (get m :tree))
|
||||
(assoc gmg-base-files "f.txt" "A\nb\nC\n"))))
|
||||
(list "merged" (list) true))
|
||||
(git-test
|
||||
"merge-commits: conflicting 3-way reports paths and marker tree"
|
||||
(let
|
||||
((m (git/merge-commits gmg gmg-cx gmg-cy)))
|
||||
(=
|
||||
(list
|
||||
(get m :result)
|
||||
(get m :conflicts)
|
||||
(contains?
|
||||
(get (git/tree-files gmg (get m :tree)) "f.txt")
|
||||
">>>>>>> theirs"))
|
||||
(list "conflicts" (list "f.txt") true)))
|
||||
true)
|
||||
(git-test
|
||||
"merge-commits: unrelated histories merge over an empty base"
|
||||
(let
|
||||
((r1 (gmg-commit! (assoc {} "x.txt" "x\n") (list) "rx"))
|
||||
(r2 (gmg-commit! (assoc {} "y.txt" "y\n") (list) "ry")))
|
||||
(let
|
||||
((m (git/merge-commits gmg r1 r2)))
|
||||
(list
|
||||
(get m :result)
|
||||
(=
|
||||
(git/tree-files gmg (get m :tree))
|
||||
(assoc (assoc {} "x.txt" "x\n") "y.txt" "y\n")))))
|
||||
(list "merged" true))
|
||||
Reference in New Issue
Block a user