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>

lib/git/conformance.sh

@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
   exit 1
 fi
 
-SUITES=(object ref dag worktree diff)
+SUITES=(object ref dag worktree diff merge)
 
 OUT_JSON="lib/git/scoreboard.json"
 OUT_MD="lib/git/scoreboard.md"
@@ -47,6 +47,7 @@ run_suite() {
 (load "lib/git/dag.sx")
 (load "lib/git/worktree.sx")
 (load "lib/git/diff.sx")
+(load "lib/git/merge.sx")
 (epoch 2)
 (eval "(define git-test-pass 0)")
 (eval "(define git-test-fail 0)")

lib/git/diff.sx

@@ -145,30 +145,33 @@
                     (nth r 2)))))))))))
 
 ; ---- edit script over two strings ----
+(define
+  git/diff-script-lines
+  (fn
+    (al bl)
+    (let
+      ((rt (git/myers-run (git/dvec al) (git/dvec bl) (len al) (len bl) (assoc {} "1" 0) 0 (list))))
+      (git/myers-back
+        (git/dvec al)
+        (git/dvec bl)
+        (first rt)
+        (nth rt 1)
+        (len al)
+        (len bl)
+        (list)))))
+
 (define
   git/diff-script
   (fn
     (a-data b-data)
-    (let
+    (git/diff-script-lines (git/diff-lines a-data) (git/diff-lines b-data))))
-      ((al (git/diff-lines a-data)) (bl (git/diff-lines b-data)))
-      (let
-        ((rt (git/myers-run (git/dvec al) (git/dvec bl) (len al) (len bl) (assoc {} "1" 0) 0 (list))))
-        (git/myers-back
-          (git/dvec al)
-          (git/dvec bl)
-          (first rt)
-          (nth rt 1)
-          (len al)
-          (len bl)
-          (list))))))
 
+; reconstruction invariants: old = eq+del lines, new = eq+add lines
 (define
   git/diff-changes
   (fn
     (script)
     (len (filter (fn (o) (not (equal? (get o :op) "eq"))) script))))
-
-; reconstruction invariants: old = eq+del lines, new = eq+add lines
 (define
   git/diff-old-lines
   (fn
@@ -176,6 +179,8 @@
     (map
       (fn (o) (get o :line))
       (filter (fn (o) (not (equal? (get o :op) "add"))) script))))
+
+; ---- unified rendering ----
 (define
   git/diff-new-lines
   (fn
@@ -184,7 +189,6 @@
       (fn (o) (get o :line))
       (filter (fn (o) (not (equal? (get o :op) "del"))) script))))
 
-; ---- unified rendering ----
 (define
   git/diff-annotate
   (fn
@@ -312,6 +316,7 @@
             ""
             ops))))))
 
+; ---- object-level diffs ----
 (define
   git/diff-unified
   (fn
@@ -328,7 +333,6 @@
         ""
         (git/diff-hunk-ranges ann 3)))))
 
-; ---- object-level diffs ----
 (define
   git/blob-diff
   (fn
@@ -343,6 +347,7 @@
     (repo t1 t2)
     (git/files-diff (git/tree-flatten repo t1) (git/tree-flatten repo t2))))
 
+; ---- whole-commit unified render: added, deleted, then modified paths ----
 (define
   git/commit-diff
   (fn
@@ -352,7 +357,6 @@
       (git/commit-tree (git/read repo c1))
       (git/commit-tree (git/read repo c2)))))
 
-; ---- whole-commit unified render: added, deleted, then modified paths ----
 (define
   git/diff-path-data
   (fn

lib/git/merge.sx

@@ -0,0 +1,224 @@
+; lib/git/merge.sx — sx-git Phase 6: 3-way merge.
+; Textual diff3: regions (non-eq runs of the Myers script base->side) are
+; clustered by strict base-interval overlap (same-point insertions from both
+; sides also cluster); one-sided clusters apply cleanly, two-sided clusters
+; take the shared result or emit diff3 conflict markers with the base section.
+; Tree merge: per-path 3-way over flattened trees with blob-level textual
+; auto-merge; delete/modify keeps the surviving side and flags the path.
+; Commit merge: up-to-date / fast-forward detection, else merge via merge-base
+; (empty base for unrelated histories).
+; Requires: lib/git/object.sx, dag.sx, worktree.sx, diff.sx.
+
+(define
+  git/m3-concat
+  (fn (ls) (reduce (fn (acc l) (append acc l)) (list) ls)))
+
+; ---- regions: non-eq runs as {:s :e :repl} over base indices ----
+(define
+  git/m3-regions
+  (fn
+    (script)
+    (let
+      ((st (reduce (fn (acc o) (let ((op (get o :op))) (cond ((equal? op "eq") (if (get acc :open) {:repl (list) :s 0 :open false :out (append (get acc :out) (list {:repl (get acc :repl) :e (get acc :bi) :s (get acc :s)})) :bi (+ (get acc :bi) 1)} (assoc acc :bi (+ (get acc :bi) 1)))) ((equal? op "del") (if (get acc :open) (assoc acc :bi (+ (get acc :bi) 1)) (merge acc {:s (get acc :bi) :open true :bi (+ (get acc :bi) 1)}))) (else (if (get acc :open) (assoc acc :repl (append (get acc :repl) (list (get o :line)))) (merge acc {:repl (list (get o :line)) :s (get acc :bi) :open true})))))) {:repl (list) :s 0 :open false :out (list) :bi 0} script)))
+      (if
+        (get st :open)
+        (append (get st :out) (list {:repl (get st :repl) :e (get st :bi) :s (get st :s)}))
+        (get st :out)))))
+
+; ---- stable sort by :s (insert after equals: a-side stays before b-side) ----
+(define
+  git/m3-ins
+  (fn
+    (sorted r)
+    (cond
+      ((empty? sorted) (list r))
+      ((< (get r :s) (get (first sorted) :s)) (cons r sorted))
+      (else (cons (first sorted) (git/m3-ins (rest sorted) r))))))
+
+(define
+  git/m3-sort
+  (fn (rs) (reduce (fn (acc r) (git/m3-ins acc r)) (list) rs)))
+
+; ---- clustering ----
+(define
+  git/m3-has-insert-at?
+  (fn
+    (ms p)
+    (reduce
+      (fn (acc m) (or acc (and (= (get m :s) p) (= (get m :e) p))))
+      false
+      ms)))
+
+(define
+  git/m3-cluster-overlap?
+  (fn
+    (cur r)
+    (or
+      (< (get r :s) (get cur :ce))
+      (and
+        (= (get r :s) (get r :e))
+        (= (get r :s) (get cur :ce))
+        (git/m3-has-insert-at? (get cur :members) (get r :s))))))
+
+(define
+  git/m3-clusters
+  (fn
+    (regions)
+    (let
+      ((res (reduce (fn (acc r) (let ((cur (nth acc 1))) (if (equal? cur nil) (list (first acc) {:ce (get r :e) :members (list r) :cs (get r :s)}) (if (git/m3-cluster-overlap? cur r) (list (first acc) {:ce (max (get cur :ce) (get r :e)) :members (append (get cur :members) (list r)) :cs (get cur :cs)}) (list (append (first acc) (list cur)) {:ce (get r :e) :members (list r) :cs (get r :s)}))))) (list (list) nil) regions)))
+      (if
+        (equal? (nth res 1) nil)
+        (first res)
+        (append (first res) (list (nth res 1)))))))
+
+; ---- apply one side's regions across a base span ----
+(define
+  git/m3-bslice
+  (fn
+    (bv from to)
+    (if
+      (>= from to)
+      (list)
+      (cons (git/dget bv from) (git/m3-bslice bv (+ from 1) to)))))
+
+(define
+  git/m3-apply-side
+  (fn
+    (bv members side cs ce)
+    (let
+      ((res (reduce (fn (acc m) (list (get m :e) (append (nth acc 1) (append (git/m3-bslice bv (first acc) (get m :s)) (get m :repl))))) (list cs (list)) (filter (fn (m) (equal? (get m :side) side)) members))))
+      (append (nth res 1) (git/m3-bslice bv (first res) ce)))))
+
+; ---- evaluate a cluster: clean lines or a conflict block ----
+(define
+  git/m3-eval-cluster
+  (fn
+    (bv cl)
+    (let
+      ((ms (get cl :members)))
+      (let
+        ((has-a (reduce (fn (acc m) (or acc (equal? (get m :side) "a"))) false ms))
+          (has-b
+            (reduce
+              (fn (acc m) (or acc (equal? (get m :side) "b")))
+              false
+              ms))
+          (aout (git/m3-apply-side bv ms "a" (get cl :cs) (get cl :ce)))
+          (bout (git/m3-apply-side bv ms "b" (get cl :cs) (get cl :ce))))
+        (cond
+          ((and has-a has-b (not (= aout bout))) {:conflict true :lines (git/m3-concat (list (list "<<<<<<< ours") aout (list "||||||| base") (git/m3-bslice bv (get cl :cs) (get cl :ce)) (list "=======") bout (list ">>>>>>> theirs")))})
+          (has-a {:conflict false :lines aout})
+          (else {:conflict false :lines bout}))))))
+
+; ---- diff3 over line lists ----
+(define
+  git/merge3-lines
+  (fn
+    (base-lines a-lines b-lines)
+    (let
+      ((bv (git/dvec base-lines)))
+      (let
+        ((all (git/m3-sort (append (map (fn (r) (assoc r :side "a")) (git/m3-regions (git/diff-script-lines base-lines a-lines))) (map (fn (r) (assoc r :side "b")) (git/m3-regions (git/diff-script-lines base-lines b-lines)))))))
+        (let
+          ((res (reduce (fn (acc cl) (let ((ev (git/m3-eval-cluster bv cl))) (list (get cl :ce) (append (nth acc 1) (append (git/m3-bslice bv (first acc) (get cl :cs)) (get ev :lines))) (+ (nth acc 2) (if (get ev :conflict) 1 0))))) (list 0 (list) 0) (git/m3-clusters all))))
+          {:clean (= (nth res 2) 0) :conflicts (nth res 2) :lines (append (nth res 1) (git/m3-bslice bv (first res) (len base-lines)))})))))
+
+(define
+  git/m3-unlines
+  (fn
+    (ls)
+    (if
+      (empty? ls)
+      ""
+      (str
+        (reduce (fn (acc l) (str acc "\n" l)) (first ls) (rest ls))
+        "\n"))))
+
+; textual 3-way over strings: {:clean :conflicts :text}
+(define
+  git/merge3-text
+  (fn
+    (base ours theirs)
+    (let
+      ((r (git/merge3-lines (git/diff-lines base) (git/diff-lines ours) (git/diff-lines theirs))))
+      {:clean (get r :clean) :text (git/m3-unlines (get r :lines)) :conflicts (get r :conflicts)})))
+
+; ---- tree building from path -> blob cid (no data reread) ----
+(define
+  git/tree-from-cids
+  (fn
+    (repo files)
+    (let
+      ((g (git/wt-group files)))
+      (let
+        ((with-blobs (reduce (fn (acc name) (assoc acc name (git/tree-entry "blob" (get (get g :files) name)))) {} (keys (get g :files)))))
+        (let
+          ((entries (reduce (fn (acc dir) (assoc acc dir (git/tree-entry "tree" (git/tree-from-cids repo (get (get g :dirs) dir))))) with-blobs (keys (get g :dirs)))))
+          (git/write repo (git/tree entries)))))))
+
+; ---- per-path 3-way tree merge: {:files path->cid :conflicts (paths)} ----
+(define
+  git/m3-union-paths
+  (fn (fa fb fc) (artdag/sort-strings (keys (merge (merge fa fb) fc)))))
+
+(define
+  git/merge-trees
+  (fn
+    (repo base-t a-t b-t)
+    (let
+      ((fb (if (equal? base-t nil) {} (git/tree-flatten repo base-t)))
+        (fa (git/tree-flatten repo a-t))
+        (ft (git/tree-flatten repo b-t)))
+      (reduce
+        (fn
+          (acc path)
+          (let
+            ((bc (get fb path)) (ac (get fa path)) (tc (get ft path)))
+            (cond
+              ((equal? ac tc)
+                (if
+                  (equal? ac nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path ac))))
+              ((equal? bc ac)
+                (if
+                  (equal? tc nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path tc))))
+              ((equal? bc tc)
+                (if
+                  (equal? ac nil)
+                  acc
+                  (assoc acc :files (assoc (get acc :files) path ac))))
+              ((or (equal? ac nil) (equal? tc nil)) (merge acc {:conflicts (append (get acc :conflicts) (list path)) :files (assoc (get acc :files) path (if (equal? ac nil) tc ac))}))
+              (else
+                (let
+                  ((m (git/merge3-text (if (equal? bc nil) "" (git/blob-data (git/read repo bc))) (git/blob-data (git/read repo ac)) (git/blob-data (git/read repo tc)))))
+                  (let
+                    ((cid (git/write-blob repo (get m :text))))
+                    (if
+                      (get m :clean)
+                      (assoc acc :files (assoc (get acc :files) path cid))
+                      (merge acc {:conflicts (append (get acc :conflicts) (list path)) :files (assoc (get acc :files) path cid)}))))))))
+        {:conflicts (list) :files {}}
+        (git/m3-union-paths fb fa ft)))))
+
+; ---- commit-level merge ----
+; can merging `theirs` into `ours` fast-forward?
+(define git/ff? (fn (repo ours theirs) (git/is-ancestor? repo ours theirs)))
+
+(define
+  git/merge-commits
+  (fn
+    (repo ours theirs)
+    (cond
+      ((git/is-ancestor? repo theirs ours) {:cid ours :result "up-to-date"})
+      ((git/is-ancestor? repo ours theirs) {:cid theirs :result "fast-forward"})
+      (else
+        (let
+          ((mb (git/merge-base repo ours theirs)))
+          (let
+            ((mt (git/merge-trees repo (if (equal? mb nil) nil (git/commit-tree (git/read repo mb))) (git/commit-tree (git/read repo ours)) (git/commit-tree (git/read repo theirs)))))
+            (let
+              ((tc (git/tree-from-cids repo (get mt :files))))
+              (if (empty? (get mt :conflicts)) {:conflicts (list) :tree tc :result "merged"} {:conflicts (get mt :conflicts) :tree tc :result "conflicts"}))))))))

lib/git/scoreboard.json

@@ -4,9 +4,10 @@
     "ref": {"pass": 38, "fail": 0},
     "dag": {"pass": 30, "fail": 0},
     "worktree": {"pass": 26, "fail": 0},
-    "diff": {"pass": 27, "fail": 0}
+    "diff": {"pass": 27, "fail": 0},
+    "merge": {"pass": 28, "fail": 0}
   },
-  "total_pass": 159,
+  "total_pass": 187,
   "total_fail": 0,
-  "total": 159
+  "total": 187
 }

lib/git/scoreboard.md

@@ -9,4 +9,5 @@ _Generated by `lib/git/conformance.sh`_
 | dag | 30 | 0 | 30 |
 | worktree | 26 | 0 | 26 |
 | diff | 27 | 0 | 27 |
-| **Total** | **159** | **0** | **159** |
+| merge | 28 | 0 | 28 |
+| **Total** | **187** | **0** | **187** |

lib/git/tests/merge.sx

@@ -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))