3-way merge with Myers diff
ocaml-merge3 + monopam pull conflict resolution
Add ocaml-merge3 (Myers O(ND) diff + diff3 line merge with Irmin-style
combinators), wire it into ocaml-git via Git.Subtree.merge, and surface
real conflict markers through monopam pull. Pull conflicts now exit 4
with a hint pointing the user at git add/commit; the previous
theirs-overwrite is gone.
The merge base for Subtree.merge is found by intersecting subtree tree
hashes between mono HEAD and the incoming upstream commit, consulting
the persistent Subtree.Cache for O(1) tree lookups. No commit-message
metadata required — unlike upstream git subtree's git-subtree-mainline
pointer, this is purely tree-driven.
ocaml-merge3 carries 30 differential tests against git merge-file
covering trivial / non-overlapping / conflict / edge / realistic /
random-seeded cases, plus a memtrace-instrumented benchmark in
ocaml-merge3/bench/. The Myers implementation stores only the active
V-array slice at each step (O(D^2) trace memory) and feeds chunks
through a streaming accumulator instead of an O(N^2) coalesce: 5000
lines with 5 edits/side merge in ~1ms (900 merges/s).
+1173
+96
bench/bench.ml
+96
bench/bench.ml
···
1
+
(** Benchmark + memory profile for [Merge3.merge].
2
+
3
+
Generates large random files with localised edits on each side, runs the
4
+
3-way merge in a loop, and (optionally) records a memtrace.
5
+
6
+
{2 Usage}
7
+
8
+
{[
9
+
# Time-only run, prints throughput.
10
+
dune exec ocaml-merge3/bench/bench.exe -- --runs 100
11
+
12
+
# Memory profile.
13
+
MEMTRACE=/tmp/merge3.ctf dune exec ocaml-merge3/bench/bench.exe
14
+
memtrace_hotspots /tmp/merge3.ctf
15
+
]} *)
16
+
17
+
let () = Memtrace.trace_if_requested ()
18
+
19
+
let random_lines ~seed n =
20
+
let rng = Random.State.make [| seed |] in
21
+
let words =
22
+
[|
23
+
"let";
24
+
"in";
25
+
"match";
26
+
"with";
27
+
"fun";
28
+
"if";
29
+
"then";
30
+
"else";
31
+
"true";
32
+
"false";
33
+
"x";
34
+
"y";
35
+
"z";
36
+
"f";
37
+
"g";
38
+
"h";
39
+
"()";
40
+
"[]";
41
+
"(::)";
42
+
"::";
43
+
|]
44
+
in
45
+
Array.init n (fun _ ->
46
+
let nwords = 1 + Random.State.int rng 6 in
47
+
String.concat " "
48
+
(List.init nwords (fun _ ->
49
+
words.(Random.State.int rng (Array.length words)))))
50
+
51
+
let join lines = String.concat "\n" (Array.to_list lines) ^ "\n"
52
+
53
+
let edit_lines ~seed ~ops base =
54
+
let rng = Random.State.make [| seed |] in
55
+
let arr = Array.copy base in
56
+
for _ = 1 to ops do
57
+
let idx = Random.State.int rng (Array.length arr) in
58
+
arr.(idx) <- Printf.sprintf "edited %d" (Random.State.int rng 1000000)
59
+
done;
60
+
arr
61
+
62
+
let parse_args () =
63
+
let runs = ref 10 in
64
+
let lines = ref 5000 in
65
+
let edits = ref 5 in
66
+
let seed = ref 42 in
67
+
let spec =
68
+
[
69
+
("--runs", Arg.Set_int runs, "N: number of merge runs (default 10)");
70
+
("--lines", Arg.Set_int lines, "N: lines per file (default 5000)");
71
+
("--edits", Arg.Set_int edits, "N: edits per side (default 5)");
72
+
("--seed", Arg.Set_int seed, "N: PRNG seed (default 42)");
73
+
]
74
+
in
75
+
Arg.parse spec
76
+
(fun _ -> ())
77
+
"Merge3 benchmark — see top-of-file comment for usage";
78
+
(!runs, !lines, !edits, !seed)
79
+
80
+
let () =
81
+
let runs, lines_n, edits_n, seed = parse_args () in
82
+
let base_lines = random_lines ~seed lines_n in
83
+
let base = join base_lines in
84
+
let ours = join (edit_lines ~seed:(seed + 1) ~ops:edits_n base_lines) in
85
+
let theirs = join (edit_lines ~seed:(seed + 2) ~ops:edits_n base_lines) in
86
+
Printf.printf "Files: %d lines, %d edits/side, %d runs\n" lines_n edits_n runs;
87
+
let t0 = Unix.gettimeofday () in
88
+
for _ = 1 to runs do
89
+
let chunks = Merge3.merge ~base ~ours ~theirs () in
90
+
let _ = Merge3.to_string chunks in
91
+
()
92
+
done;
93
+
let elapsed = Unix.gettimeofday () -. t0 in
94
+
Printf.printf "Total: %.3fs (%.3fs/merge)\n" elapsed
95
+
(elapsed /. float_of_int runs);
96
+
Printf.printf "Throughput: %.0f merges/s\n" (float_of_int runs /. elapsed)
+23
dune-project
+23
dune-project
···
1
+
(lang dune 3.21)
2
+
(name merge3)
3
+
(formatting (enabled_for ocaml))
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(source (tangled gazagnaire.org/ocaml-merge3))
11
+
12
+
(package
13
+
(name merge3)
14
+
(synopsis "3-way merge with Myers diff")
15
+
(description "
16
+
Textbook 3-way merge algorithms for OCaml.
17
+
18
+
- Myers' O(ND) diff algorithm (Algorithmica 1986)
19
+
- diff3 line-based merge with git-compatible conflict markers
20
+
- Irmin-style composable merge combinators for custom datatypes")
21
+
(depends
22
+
(ocaml (>= 5.1.0))
23
+
(alcotest (and :with-test (>= 1.7.0)))))
+377
lib/merge3.ml
+377
lib/merge3.ml
···
1
+
(* Copyright (c) 2024-2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
+
3
+
Permission to use, copy, modify, and distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
+
15
+
(** {1 Myers' O(ND) Diff Algorithm}
16
+
17
+
E. W. Myers, "An O(ND) Difference Algorithm and Its Variations",
18
+
Algorithmica 1(2), 1986, pp. 251–266.
19
+
20
+
The algorithm finds the shortest edit script (SES) between two sequences. It
21
+
works by computing the furthest-reaching D-paths for increasing edit
22
+
distances D = 0, 1, 2, ... The key insight is that diagonal k = x - y
23
+
represents a state where x characters from [a] and y from [b] have been
24
+
consumed, and only even/odd diagonals are reachable at each step.
25
+
26
+
Time: O(ND) where N = |a| + |b| and D = edit distance. Space: O(D²) for the
27
+
trace (one V-array per step). *)
28
+
29
+
type 'a edit = Keep of 'a | Delete of 'a | Insert of 'a
30
+
31
+
(** Compute the furthest-reaching D-paths.
32
+
33
+
Records snapshots of the active V range [-d..d] (size 2d+1) at each step
34
+
instead of the full V array (size 2*max_d+1). This is the standard Myers
35
+
space optimisation: at step d only diagonals -d..d are reachable, so the
36
+
rest of V is unused. The trace becomes O(D²) instead of O(D*N), which is a
37
+
substantial win when D ≪ N (typical for incremental edits).
38
+
39
+
Returns [(D, trace)] where [trace.(d)] is an array of length [2*d+1] indexed
40
+
by [k+d] (so trace.(d).(0) holds V[-d], trace.(d).(2*d) holds V[d]). *)
41
+
let myers_forward ~eq ~off a b ~max_d =
42
+
let n = Array.length a and m = Array.length b in
43
+
let vlen = (2 * max_d) + 1 in
44
+
let v = Array.make vlen 0 in
45
+
v.(off + 1) <- 0;
46
+
let trace = Array.make (max_d + 1) [||] in
47
+
let final_d = ref 0 in
48
+
(try
49
+
for d = 0 to max_d do
50
+
(* Snapshot only the active range used at step d (diagonals -d..d). *)
51
+
trace.(d) <- Array.sub v (off - d) ((2 * d) + 1);
52
+
for k0 = 0 to d do
53
+
let k = -d + (2 * k0) in
54
+
let x0 =
55
+
if k = -d || (k <> d && v.(off + k - 1) < v.(off + k + 1)) then
56
+
v.(off + k + 1)
57
+
else v.(off + k - 1) + 1
58
+
in
59
+
let x = ref x0 and y = ref (x0 - k) in
60
+
while !x < n && !y < m && eq a.(!x) b.(!y) do
61
+
incr x;
62
+
incr y
63
+
done;
64
+
v.(off + k) <- !x;
65
+
if !x >= n && !y >= m then begin
66
+
final_d := d;
67
+
raise Exit
68
+
end
69
+
done
70
+
done
71
+
with Exit -> ());
72
+
(!final_d, trace)
73
+
74
+
(** Backtrack one step in the Myers trace, emitting the snake's [Keep]
75
+
operations and the single non-diagonal edit. Returns the previous [(x, y)]
76
+
position.
77
+
78
+
[vv] is the snapshot at step [dd]: an array of length [2*dd+1] where
79
+
[vv.(k+dd)] holds the V value for diagonal [k]. *)
80
+
let backtrack_step ~vv ~dd ~x ~y a b edits =
81
+
let k = x - y in
82
+
(* The previous snapshot only has diagonals -(dd-1)..(dd-1), but we read
83
+
V[k-1] and V[k+1] from the current step's snapshot — those are guaranteed
84
+
to be in range because k ∈ [-dd, dd] and k±1 ∈ [-(dd+1), dd+1], but
85
+
critically when we make the choice we look at V[k-1] and V[k+1] from
86
+
the SAME snapshot (saved at the start of step dd, which is the V state
87
+
after step dd-1), so they're both in [-(dd-1), dd-1] ⊆ [-dd, dd]. *)
88
+
let v_at i = vv.(i + dd) in
89
+
let is_insert = k = -dd || (k <> dd && v_at (k - 1) < v_at (k + 1)) in
90
+
let snake_x = if is_insert then v_at (k + 1) else v_at (k - 1) + 1 in
91
+
for i = x - 1 downto snake_x do
92
+
edits := Keep a.(i) :: !edits
93
+
done;
94
+
if is_insert then edits := Insert b.(snake_x - k - 1) :: !edits
95
+
else edits := Delete a.(snake_x - 1) :: !edits;
96
+
let prev_k = if is_insert then k + 1 else k - 1 in
97
+
let prev_x = v_at prev_k in
98
+
(prev_x, prev_x - prev_k)
99
+
100
+
let diff ~eq (a : 'a array) (b : 'a array) : 'a edit list =
101
+
let n = Array.length a and m = Array.length b in
102
+
if n = 0 && m = 0 then []
103
+
else if n = 0 then Array.to_list b |> List.map (fun x -> Insert x)
104
+
else if m = 0 then Array.to_list a |> List.map (fun x -> Delete x)
105
+
else
106
+
let max_d = n + m in
107
+
let off = max_d in
108
+
let d, trace = myers_forward ~eq ~off a b ~max_d in
109
+
let edits = ref [] in
110
+
let x = ref n and y = ref m in
111
+
for step = 0 to d - 1 do
112
+
let dd = d - step in
113
+
let nx, ny = backtrack_step ~vv:trace.(dd) ~dd ~x:!x ~y:!y a b edits in
114
+
x := nx;
115
+
y := ny
116
+
done;
117
+
for i = !x - 1 downto 0 do
118
+
edits := Keep a.(i) :: !edits
119
+
done;
120
+
!edits
121
+
122
+
(** Direct LCS that walks the same backtrack as [diff] but emits matching pairs
123
+
instead of edit ops, avoiding the intermediate edit list. *)
124
+
let lcs ~eq (a : 'a array) (b : 'a array) : (int * int) list =
125
+
let n = Array.length a and m = Array.length b in
126
+
if n = 0 || m = 0 then []
127
+
else
128
+
let max_d = n + m in
129
+
let off = max_d in
130
+
let d, trace = myers_forward ~eq ~off a b ~max_d in
131
+
let pairs = ref [] in
132
+
let x = ref n and y = ref m in
133
+
for step = 0 to d - 1 do
134
+
let dd = d - step in
135
+
let vv = trace.(dd) in
136
+
let v_at i = vv.(i + dd) in
137
+
let k = !x - !y in
138
+
let is_insert = k = -dd || (k <> dd && v_at (k - 1) < v_at (k + 1)) in
139
+
let snake_x = if is_insert then v_at (k + 1) else v_at (k - 1) + 1 in
140
+
for i = !x - 1 downto snake_x do
141
+
pairs := (i, i - k) :: !pairs
142
+
done;
143
+
let prev_k = if is_insert then k + 1 else k - 1 in
144
+
let prev_x = v_at prev_k in
145
+
x := prev_x;
146
+
y := prev_x - prev_k
147
+
done;
148
+
for i = !x - 1 downto 0 do
149
+
pairs := (i, i) :: !pairs
150
+
done;
151
+
!pairs
152
+
153
+
(** {1 3-way Merge (diff3)}
154
+
155
+
S. Khanna, K. Kuber, B. C. Pierce, "A Formal Investigation of Diff3", FSTTCS
156
+
2007, LNCS 4855, pp. 485–496.
157
+
158
+
Given three versions (base, ours, theirs): 1. Compute LCS(base, ours) and
159
+
LCS(base, theirs) using Myers. 2. A base line is "stable" if it is part of
160
+
both LCS results — it was preserved on both sides. 3. Walk stable lines in
161
+
order. Between consecutive stable lines, extract the gap from each side and
162
+
apply the merge rule:
163
+
- One side unchanged from base → take the other side's version.
164
+
- Both sides changed identically → take either.
165
+
- Both sides changed differently → conflict. *)
166
+
167
+
type conflict = {
168
+
base_lines : string list;
169
+
ours_lines : string list;
170
+
theirs_lines : string list;
171
+
}
172
+
173
+
type merged_chunk = Resolved of string list | Conflict of conflict
174
+
175
+
(** Find positions in [base] that are matched in BOTH the base↔ours LCS and the
176
+
base↔theirs LCS. These are "stable" — preserved on both sides. *)
177
+
let stable_points_of ~base lcs_o lcs_t =
178
+
(* base positions are integers in [0, |base|), so we use plain arrays
179
+
instead of hashtables. -1 means "not matched". *)
180
+
let n = Array.length base in
181
+
let map_o = Array.make n (-1) in
182
+
List.iter (fun (b, o) -> if b < n then map_o.(b) <- o) lcs_o;
183
+
let map_t = Array.make n (-1) in
184
+
List.iter (fun (b, t) -> if b < n then map_t.(b) <- t) lcs_t;
185
+
let acc = ref [] in
186
+
for i = n - 1 downto 0 do
187
+
let o = map_o.(i) and t = map_t.(i) in
188
+
if o >= 0 && t >= 0 then acc := (i, o, t) :: !acc
189
+
done;
190
+
!acc
191
+
192
+
let array_slice arr start len =
193
+
if len <= 0 then [] else Array.sub arr start len |> Array.to_list
194
+
195
+
(** Classify a single unstable region between two stable points and return the
196
+
corresponding [merged_chunk]. *)
197
+
let classify_gap ~base ~ours ~theirs ~prev_b ~prev_o ~prev_t ~next_b ~next_o
198
+
~next_t =
199
+
let b_start = prev_b + 1 and b_len = next_b - prev_b - 1 in
200
+
let o_start = prev_o + 1 and o_len = next_o - prev_o - 1 in
201
+
let t_start = prev_t + 1 and t_len = next_t - prev_t - 1 in
202
+
if b_len <= 0 && o_len <= 0 && t_len <= 0 then None
203
+
else
204
+
let base_lines = array_slice base b_start b_len in
205
+
let ours_lines = array_slice ours o_start o_len in
206
+
let theirs_lines = array_slice theirs t_start t_len in
207
+
if ours_lines = base_lines then Some (Resolved theirs_lines)
208
+
else if theirs_lines = base_lines then Some (Resolved ours_lines)
209
+
else if ours_lines = theirs_lines then Some (Resolved ours_lines)
210
+
else Some (Conflict { base_lines; ours_lines; theirs_lines })
211
+
212
+
type accum = {
213
+
mutable resolved_rev : string list;
214
+
(** Current resolved run, in reverse line order. *)
215
+
mutable chunks_rev : merged_chunk list;
216
+
(** Completed chunks, in reverse order. *)
217
+
}
218
+
(** Streaming chunk accumulator: pushes individual resolved lines into a current
219
+
run (held in reverse order) and flushes the run as a single [Resolved] chunk
220
+
only when a [Conflict] is hit or merging completes. This keeps coalescing
221
+
O(N) — pushing N lines is N constant-time operations, rather than the O(N²)
222
+
cost of repeated [a @ b] list concatenations. *)
223
+
224
+
let make_accum () = { resolved_rev = []; chunks_rev = [] }
225
+
226
+
let flush_resolved acc =
227
+
match acc.resolved_rev with
228
+
| [] -> ()
229
+
| lines ->
230
+
acc.chunks_rev <- Resolved (List.rev lines) :: acc.chunks_rev;
231
+
acc.resolved_rev <- []
232
+
233
+
let push_resolved_line acc line = acc.resolved_rev <- line :: acc.resolved_rev
234
+
235
+
let push_resolved_lines acc lines =
236
+
List.iter (fun l -> acc.resolved_rev <- l :: acc.resolved_rev) lines
237
+
238
+
let push_conflict acc c =
239
+
flush_resolved acc;
240
+
acc.chunks_rev <- Conflict c :: acc.chunks_rev
241
+
242
+
let finish_accum acc =
243
+
flush_resolved acc;
244
+
List.rev acc.chunks_rev
245
+
246
+
(** Push the result of [classify_gap] (a single [Resolved] or [Conflict] chunk)
247
+
into the accumulator. *)
248
+
let push_gap_chunk acc = function
249
+
| Resolved lines -> push_resolved_lines acc lines
250
+
| Conflict c -> push_conflict acc c
251
+
252
+
let merge ?(ours_label = "ours") ?(theirs_label = "theirs") ~base ~ours ~theirs
253
+
() =
254
+
ignore (ours_label, theirs_label);
255
+
let split s = String.split_on_char '\n' s |> Array.of_list in
256
+
let base = split base and ours = split ours and theirs = split theirs in
257
+
let eq = String.equal in
258
+
let stable =
259
+
stable_points_of ~base (lcs ~eq base ours) (lcs ~eq base theirs)
260
+
in
261
+
let acc = make_accum () in
262
+
let push_gap ~prev_b ~prev_o ~prev_t ~next_b ~next_o ~next_t =
263
+
match
264
+
classify_gap ~base ~ours ~theirs ~prev_b ~prev_o ~prev_t ~next_b ~next_o
265
+
~next_t
266
+
with
267
+
| Some c -> push_gap_chunk acc c
268
+
| None -> ()
269
+
in
270
+
let prev_b = ref (-1) and prev_o = ref (-1) and prev_t = ref (-1) in
271
+
List.iter
272
+
(fun (b, o, t) ->
273
+
push_gap ~prev_b:!prev_b ~prev_o:!prev_o ~prev_t:!prev_t ~next_b:b
274
+
~next_o:o ~next_t:t;
275
+
push_resolved_line acc base.(b);
276
+
prev_b := b;
277
+
prev_o := o;
278
+
prev_t := t)
279
+
stable;
280
+
push_gap ~prev_b:!prev_b ~prev_o:!prev_o ~prev_t:!prev_t
281
+
~next_b:(Array.length base) ~next_o:(Array.length ours)
282
+
~next_t:(Array.length theirs);
283
+
finish_accum acc
284
+
285
+
let has_conflicts chunks =
286
+
List.exists (function Conflict _ -> true | Resolved _ -> false) chunks
287
+
288
+
let conflicts chunks =
289
+
List.filter_map (function Conflict c -> Some c | Resolved _ -> None) chunks
290
+
291
+
let to_string ?(ours_label = "ours") ?(theirs_label = "theirs") chunks =
292
+
let buf = Buffer.create 1024 in
293
+
let first = ref true in
294
+
let emit line =
295
+
if !first then first := false else Buffer.add_char buf '\n';
296
+
Buffer.add_string buf line
297
+
in
298
+
List.iter
299
+
(fun chunk ->
300
+
match chunk with
301
+
| Resolved lines -> List.iter emit lines
302
+
| Conflict { ours_lines; theirs_lines; _ } ->
303
+
emit ("<<<<<<< " ^ ours_label);
304
+
List.iter emit ours_lines;
305
+
emit "=======";
306
+
List.iter emit theirs_lines;
307
+
emit (">>>>>>> " ^ theirs_label))
308
+
chunks;
309
+
Buffer.contents buf
310
+
311
+
(** {1 Irmin-style Merge Combinators} *)
312
+
313
+
type 'a result = Ok of 'a | Conflict of string
314
+
type 'a f = old:'a option -> 'a -> 'a -> 'a result
315
+
316
+
let default ~eq ~old a b =
317
+
if eq a b then Ok a
318
+
else
319
+
match old with
320
+
| None -> Conflict "add/add"
321
+
| Some old ->
322
+
if eq old a then Ok b else if eq old b then Ok a else Conflict "default"
323
+
324
+
let option merge_v ~old a b =
325
+
match (a, b) with
326
+
| None, None -> Ok None
327
+
| Some va, Some vb -> (
328
+
let old_v = Option.join old in
329
+
match merge_v ~old:old_v va vb with
330
+
| Ok v -> Ok (Some v)
331
+
| Conflict msg -> Conflict msg)
332
+
| Some x, None | None, Some x -> (
333
+
match old with
334
+
| None | Some None -> Ok (Some x)
335
+
| Some (Some o) ->
336
+
if merge_v ~old:(Some o) x x = Ok x then Ok (Some x)
337
+
else Conflict "option: add/del")
338
+
339
+
let pair merge_a merge_b ~old (a1, b1) (a2, b2) =
340
+
let old_a = Option.map fst old in
341
+
let old_b = Option.map snd old in
342
+
match (merge_a ~old:old_a a1 a2, merge_b ~old:old_b b1 b2) with
343
+
| Ok a, Ok b -> Ok (a, b)
344
+
| Conflict msg, _ | _, Conflict msg -> Conflict msg
345
+
346
+
let alist ~eq_key merge_v ~old l1 l2 =
347
+
(* Collect all keys *)
348
+
let all_keys = ref [] in
349
+
let add_key k =
350
+
if not (List.exists (eq_key k) !all_keys) then all_keys := k :: !all_keys
351
+
in
352
+
List.iter (fun (k, _) -> add_key k) l1;
353
+
List.iter (fun (k, _) -> add_key k) l2;
354
+
(match old with
355
+
| Some ol -> List.iter (fun (k, _) -> add_key k) ol
356
+
| None -> ());
357
+
let find_opt k l = List.find_opt (fun (k', _) -> eq_key k k') l in
358
+
let result = ref [] in
359
+
let conflict = ref None in
360
+
List.iter
361
+
(fun k ->
362
+
if Option.is_some !conflict then ()
363
+
else
364
+
let v1 = find_opt k l1 |> Option.map snd in
365
+
let v2 = find_opt k l2 |> Option.map snd in
366
+
let old_v =
367
+
Option.bind old (fun ol -> find_opt k ol |> Option.map snd)
368
+
in
369
+
let merged = option merge_v ~old:(Some old_v) v1 v2 in
370
+
match merged with
371
+
| Ok (Some v) -> result := (k, v) :: !result
372
+
| Ok None -> ()
373
+
| Conflict msg -> conflict := Some msg)
374
+
(List.rev !all_keys);
375
+
match !conflict with
376
+
| Some msg -> Conflict msg
377
+
| None -> Ok (List.rev !result)
+125
lib/merge3.mli
+125
lib/merge3.mli
···
1
+
(* Copyright (c) 2024-2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
+
3
+
Permission to use, copy, modify, and distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
+
15
+
(** Textbook 3-way merge algorithms.
16
+
17
+
{2 Algorithms}
18
+
19
+
{b Myers diff.} Computes the shortest edit script between two sequences in
20
+
O(ND) time where N is the total length and D the edit distance. Near-linear
21
+
for similar inputs.
22
+
23
+
{i E. W. Myers, "An O(ND) Difference Algorithm and Its Variations",
24
+
Algorithmica 1(2), 1986, pp. 251–266.}
25
+
26
+
{b diff3 merge.} Given a common ancestor (base) and two derived versions,
27
+
produces a merged result or conflict markers.
28
+
29
+
{i S. Khanna, K. Kuber, B. C. Pierce, "A Formal Investigation of Diff3",
30
+
FSTTCS 2007, LNCS 4855, pp. 485–496.} *)
31
+
32
+
(** {1 Diff} *)
33
+
34
+
(** An edit operation in the shortest edit script. *)
35
+
type 'a edit =
36
+
| Keep of 'a (** Line present in both sequences. *)
37
+
| Delete of 'a (** Line present in old, absent in new. *)
38
+
| Insert of 'a (** Line absent in old, present in new. *)
39
+
40
+
val diff : eq:('a -> 'a -> bool) -> 'a array -> 'a array -> 'a edit list
41
+
(** [diff ~eq a b] computes the shortest edit script from [a] to [b] using
42
+
Myers' O(ND) algorithm. [eq] is the equality predicate.
43
+
44
+
The result is a list of edits that transforms [a] into [b]:
45
+
- [Keep x]: line [x] is present in both
46
+
- [Delete x]: line [x] from [a] is removed
47
+
- [Insert x]: line [x] from [b] is added
48
+
49
+
Time: O(ND) where N = |a| + |b| and D = edit distance. Space: O(D²) for the
50
+
trace. *)
51
+
52
+
val lcs : eq:('a -> 'a -> bool) -> 'a array -> 'a array -> (int * int) list
53
+
(** [lcs ~eq a b] returns the longest common subsequence as a list of matching
54
+
index pairs [(i, j)] where [eq a.(i) b.(j) = true]. Derived from the Myers
55
+
shortest edit script. *)
56
+
57
+
(** {1 3-way Merge} *)
58
+
59
+
type conflict = {
60
+
base_lines : string list; (** Lines from the common ancestor. *)
61
+
ours_lines : string list; (** Lines from "ours". *)
62
+
theirs_lines : string list; (** Lines from "theirs". *)
63
+
}
64
+
(** A conflict region where both sides changed the same base region differently.
65
+
*)
66
+
67
+
(** A chunk in the merge result. *)
68
+
type merged_chunk =
69
+
| Resolved of string list (** Lines that merged cleanly. *)
70
+
| Conflict of conflict (** Lines that conflict. *)
71
+
72
+
val merge :
73
+
?ours_label:string ->
74
+
?theirs_label:string ->
75
+
base:string ->
76
+
ours:string ->
77
+
theirs:string ->
78
+
unit ->
79
+
merged_chunk list
80
+
(** [merge ?ours_label ?theirs_label ~base ~ours ~theirs ()] performs a 3-way
81
+
line-level merge using the diff3 algorithm.
82
+
83
+
Returns a list of chunks: [Resolved] for clean regions, [Conflict] where
84
+
both sides diverged from the base. *)
85
+
86
+
val has_conflicts : merged_chunk list -> bool
87
+
(** [has_conflicts chunks] returns [true] if any chunk is a [Conflict]. *)
88
+
89
+
val to_string :
90
+
?ours_label:string -> ?theirs_label:string -> merged_chunk list -> string
91
+
(** [to_string ?ours_label ?theirs_label chunks] renders the merge result as a
92
+
string. Conflicts are formatted with git-style markers ([<<<<<<<],
93
+
[=======], [>>>>>>>]). *)
94
+
95
+
val conflicts : merged_chunk list -> conflict list
96
+
(** [conflicts chunks] extracts all conflict regions. *)
97
+
98
+
(** {1 Irmin-style Merge Combinators}
99
+
100
+
Type-attached merge functions following the pattern from Irmin: each merge
101
+
combinator takes a base, ours, and theirs, and returns either the merged
102
+
result or a conflict description. *)
103
+
104
+
type 'a result =
105
+
| Ok of 'a (** Clean merge. *)
106
+
| Conflict of string (** Merge conflict with description. *)
107
+
108
+
type 'a f = old:'a option -> 'a -> 'a -> 'a result
109
+
(** A merge function for values of type ['a]. [old] is the common ancestor
110
+
([None] for add/add merges). *)
111
+
112
+
val default : eq:('a -> 'a -> bool) -> 'a f
113
+
(** [default ~eq] is the default merge strategy: if one side is unchanged from
114
+
[old], take the other. If both changed identically, take either. Otherwise
115
+
conflict. *)
116
+
117
+
val option : 'a f -> 'a option f
118
+
(** [option merge_v] lifts a merge function to options. *)
119
+
120
+
val pair : 'a f -> 'b f -> ('a * 'b) f
121
+
(** [pair merge_a merge_b] merges pairs component-wise. *)
122
+
123
+
val alist : eq_key:('k -> 'k -> bool) -> 'v f -> ('k * 'v) list f
124
+
(** [alist ~eq_key merge_v] merges association lists entry-by-entry. Keys are
125
+
compared with [eq_key]; values are merged with [merge_v]. *)
+37
merge3.opam
+37
merge3.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "3-way merge with Myers diff"
4
+
description: """
5
+
6
+
Textbook 3-way merge algorithms for OCaml.
7
+
8
+
- Myers' O(ND) diff algorithm (Algorithmica 1986)
9
+
- diff3 line-based merge with git-compatible conflict markers
10
+
- Irmin-style composable merge combinators for custom datatypes"""
11
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
12
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
13
+
license: "ISC"
14
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-merge3"
15
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-merge3/issues"
16
+
depends: [
17
+
"dune" {>= "3.21"}
18
+
"ocaml" {>= "5.1.0"}
19
+
"alcotest" {with-test & >= "1.7.0"}
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
36
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-merge3"
37
+
x-maintenance-intent: ["(latest)"]
+378
test/interop/git/test.ml
+378
test/interop/git/test.ml
···
1
+
(** Differential tests: [Merge3] vs [git merge-file].
2
+
3
+
Each test runs a 3-way merge through both [Merge3] and [git merge-file] and
4
+
compares conflict detection + merged output. The aim is to cover every
5
+
classification of merge that the algorithm can hit:
6
+
7
+
- {b clean cases:} identical, ours-only change, theirs-only change, both
8
+
same change, non-overlapping inserts, non-overlapping deletes, mixed
9
+
insert/delete/modify across all three sides.
10
+
- {b conflict cases:} both modify the same line differently, modify/delete
11
+
collisions, overlapping inserts, conflicting multi-line edits.
12
+
- {b edge cases:} empty inputs, files without trailing newline, files with
13
+
only whitespace differences, very long files, binary-like content with
14
+
embedded nulls (well, control characters), files with CRLF line endings.
15
+
16
+
For large random files, we use a fixed seed so failures reproduce. *)
17
+
18
+
(** {1 Test fixture helpers} *)
19
+
20
+
let tmp_dir =
21
+
let d = Filename.temp_dir "merge3-interop-git" "" in
22
+
at_exit (fun () -> ignore (Sys.command (Printf.sprintf "rm -rf %s" d)));
23
+
d
24
+
25
+
let counter = ref 0
26
+
27
+
let write_tmp content =
28
+
let n = !counter in
29
+
incr counter;
30
+
let path = Filename.concat tmp_dir (Printf.sprintf "f%d" n) in
31
+
let oc = open_out path in
32
+
output_string oc content;
33
+
close_out oc;
34
+
path
35
+
36
+
(** Run [git merge-file -p] and return [(exit_code, merged_content)]. Exit
37
+
codes: 0 = clean merge, N (positive, < 128) = N conflict regions, 128 =
38
+
fatal error. *)
39
+
let git_merge_file ~ours_label ~theirs_label ~base ~ours ~theirs =
40
+
let base_path = write_tmp base in
41
+
let ours_path = write_tmp ours in
42
+
let theirs_path = write_tmp theirs in
43
+
let cmd =
44
+
Printf.sprintf "git merge-file -L %s -L base -L %s -p %s %s %s 2>/dev/null"
45
+
(Filename.quote ours_label)
46
+
(Filename.quote theirs_label)
47
+
(Filename.quote ours_path) (Filename.quote base_path)
48
+
(Filename.quote theirs_path)
49
+
in
50
+
let ic = Unix.open_process_in cmd in
51
+
let buf = Buffer.create 256 in
52
+
(try
53
+
while true do
54
+
Buffer.add_char buf (input_char ic)
55
+
done
56
+
with End_of_file -> ());
57
+
let status = Unix.close_process_in ic in
58
+
let exit_code = match status with Unix.WEXITED n -> n | _ -> 128 in
59
+
(exit_code, Buffer.contents buf)
60
+
61
+
(** Run our merge and git's merge, then compare. Conflict detection must agree.
62
+
For clean merges, the merged text must match exactly. For conflicting
63
+
merges, we check that both flagged a conflict (the exact marker formatting
64
+
can differ, so we don't enforce text equality). *)
65
+
let check_vs_git ~ours_label ~theirs_label ~base ~ours ~theirs () =
66
+
let chunks = Merge3.merge ~ours_label ~theirs_label ~base ~ours ~theirs () in
67
+
let our_result = Merge3.to_string ~ours_label ~theirs_label chunks in
68
+
let our_has_conflicts = Merge3.has_conflicts chunks in
69
+
let git_exit, git_result =
70
+
git_merge_file ~ours_label ~theirs_label ~base ~ours ~theirs
71
+
in
72
+
let git_has_conflicts = git_exit > 0 && git_exit < 128 in
73
+
Alcotest.(check bool)
74
+
"conflict detection matches git" git_has_conflicts our_has_conflicts;
75
+
if not git_has_conflicts then
76
+
Alcotest.(check string) "clean merge matches git" git_result our_result
77
+
78
+
(** {1 Section 1: Trivial clean merges} *)
79
+
80
+
let test_identical () =
81
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline2\n"
82
+
~ours:"line1\nline2\n" ~theirs:"line1\nline2\n" ()
83
+
84
+
let test_only_ours_changed () =
85
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline2\n"
86
+
~ours:"changed\nline2\n" ~theirs:"line1\nline2\n" ()
87
+
88
+
let test_only_theirs_changed () =
89
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline2\n"
90
+
~ours:"line1\nline2\n" ~theirs:"changed\nline2\n" ()
91
+
92
+
let test_both_same_change () =
93
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline2\n"
94
+
~ours:"line1\nchanged\n" ~theirs:"line1\nchanged\n" ()
95
+
96
+
(** {1 Section 2: Non-overlapping changes (the core of useful merging)} *)
97
+
98
+
let test_non_overlapping_modifies () =
99
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb\nc\nd\ne\n"
100
+
~ours:"X\nb\nc\nd\ne\n" ~theirs:"a\nb\nc\nd\nY\n" ()
101
+
102
+
let test_non_overlapping_inserts () =
103
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline5\n"
104
+
~ours:"line1\nline2\nline3\nline5\n" ~theirs:"line1\nline5\nline6\nline7\n"
105
+
()
106
+
107
+
let test_non_overlapping_deletes () =
108
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb\nc\nd\ne\n"
109
+
~ours:"a\nc\nd\ne\n" ~theirs:"a\nb\nc\nd\n" ()
110
+
111
+
let test_modify_unrelated_blocks () =
112
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs"
113
+
~base:"function f1() {}\n\nfunction f2() {}\n\nfunction f3() {}\n"
114
+
~ours:
115
+
"function f1() { return 1; }\n\nfunction f2() {}\n\nfunction f3() {}\n"
116
+
~theirs:
117
+
"function f1() {}\n\nfunction f2() {}\n\nfunction f3() { return 3; }\n"
118
+
()
119
+
120
+
(** {1 Section 3: Add/insert combinations} *)
121
+
122
+
let test_ours_inserts_theirs_unchanged () =
123
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb\nc\n"
124
+
~ours:"a\nNEW\nb\nc\n" ~theirs:"a\nb\nc\n" ()
125
+
126
+
let test_theirs_inserts_ours_unchanged () =
127
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb\nc\n"
128
+
~ours:"a\nb\nc\n" ~theirs:"a\nb\nNEW\nc\n" ()
129
+
130
+
let test_both_insert_at_start () =
131
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"common\n"
132
+
~ours:"prefix_ours\ncommon\n" ~theirs:"prefix_theirs\ncommon\n" ()
133
+
134
+
let test_both_insert_at_end () =
135
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"common\n"
136
+
~ours:"common\nsuffix_ours\n" ~theirs:"common\nsuffix_theirs\n" ()
137
+
138
+
(** {1 Section 4: Conflict cases} *)
139
+
140
+
let test_both_modify_same_line () =
141
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"let x = 1\n"
142
+
~ours:"let x = 2\n" ~theirs:"let x = 3\n" ()
143
+
144
+
let test_both_modify_same_block_differently () =
145
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb\nc\n"
146
+
~ours:"a\nB1\nB2\nc\n" ~theirs:"a\nX\nY\nZ\nc\n" ()
147
+
148
+
let test_overlapping_inserts () =
149
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"line1\nline2\n"
150
+
~ours:"line1\nINSERT_O\nline2\n" ~theirs:"line1\nINSERT_T\nline2\n" ()
151
+
152
+
(** {1 Section 5: Edge cases} *)
153
+
154
+
let test_empty_base () =
155
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:""
156
+
~ours:"hello\n" ~theirs:"world\n" ()
157
+
158
+
let test_no_trailing_newline () =
159
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"a\nb"
160
+
~ours:"a\nB" ~theirs:"a\nb" ()
161
+
162
+
let test_only_whitespace_changes () =
163
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:" let x = 1\n"
164
+
~ours:"\tlet x = 1\n" ~theirs:" let x = 1\n" ()
165
+
166
+
let test_single_line_files () =
167
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base:"original\n"
168
+
~ours:"original\n" ~theirs:"changed\n" ()
169
+
170
+
let test_completely_different () =
171
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs"
172
+
~base:"orig1\norig2\norig3\n" ~ours:"alice1\nalice2\nalice3\n"
173
+
~theirs:"bob1\nbob2\nbob3\n" ()
174
+
175
+
(** {1 Section 6: Realistic scenarios} *)
176
+
177
+
let test_ocaml_function_edits () =
178
+
let base =
179
+
"let add x y = x + y\nlet sub x y = x - y\nlet mul x y = x * y\n"
180
+
in
181
+
let ours =
182
+
"let add x y =\n\
183
+
\ (* with logging *)\n\
184
+
\ Printf.printf \"adding\";\n\
185
+
\ x + y\n\
186
+
let sub x y = x - y\n\
187
+
let mul x y = x * y\n"
188
+
in
189
+
let theirs =
190
+
"let add x y = x + y\n\
191
+
let sub x y = x - y\n\
192
+
let mul x y = x * y\n\
193
+
let div x y = x / y\n"
194
+
in
195
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base ~ours ~theirs ()
196
+
197
+
let test_imports_added_both_sides () =
198
+
let base = "open Lwt.Syntax\n\nlet f () = ()\n" in
199
+
let ours = "open Lwt.Syntax\nopen My_module\n\nlet f () = ()\n" in
200
+
let theirs = "open Lwt.Syntax\nopen Other_module\n\nlet f () = ()\n" in
201
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base ~ours ~theirs ()
202
+
203
+
let test_changelog_entries () =
204
+
let base = "## v1.0\n- initial release\n" in
205
+
let ours = "## v1.1\n- bug fix A\n## v1.0\n- initial release\n" in
206
+
let theirs = "## v1.1\n- bug fix B\n## v1.0\n- initial release\n" in
207
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base ~ours ~theirs ()
208
+
209
+
(** {1 Section 7: Property-based tests with seeded random data}
210
+
211
+
Generates a base file then applies independent random edits on each side.
212
+
Uses a fixed seed so failures are reproducible. The autogen logic does NOT
213
+
commit anything to the repo — files live in [tmp_dir]. *)
214
+
215
+
let random_lines ~seed n =
216
+
let rng = Random.State.make [| seed |] in
217
+
let words =
218
+
[|
219
+
"let";
220
+
"in";
221
+
"match";
222
+
"with";
223
+
"fun";
224
+
"if";
225
+
"then";
226
+
"else";
227
+
"true";
228
+
"false";
229
+
"x";
230
+
"y";
231
+
"z";
232
+
"f";
233
+
"g";
234
+
"h";
235
+
"()";
236
+
"[]";
237
+
"(::)";
238
+
"::";
239
+
|]
240
+
in
241
+
Array.init n (fun _ ->
242
+
let nwords = 1 + Random.State.int rng 6 in
243
+
String.concat " "
244
+
(List.init nwords (fun _ ->
245
+
words.(Random.State.int rng (Array.length words)))))
246
+
247
+
let join lines = String.concat "\n" (Array.to_list lines) ^ "\n"
248
+
249
+
(** Edit a copy of [base]: replace, insert, or delete random lines. *)
250
+
let edit ~seed ~ops base =
251
+
let rng = Random.State.make [| seed |] in
252
+
let lines = ref (Array.to_list base) in
253
+
for _ = 1 to ops do
254
+
let len = List.length !lines in
255
+
if len = 0 then
256
+
lines := [ Printf.sprintf "new line %d" (Random.State.int rng 1000) ]
257
+
else
258
+
let idx = Random.State.int rng len in
259
+
let op = Random.State.int rng 3 in
260
+
match op with
261
+
| 0 ->
262
+
(* replace *)
263
+
lines :=
264
+
List.mapi
265
+
(fun i l ->
266
+
if i = idx then
267
+
Printf.sprintf "edited %d" (Random.State.int rng 1000)
268
+
else l)
269
+
!lines
270
+
| 1 ->
271
+
(* insert *)
272
+
let new_l =
273
+
Printf.sprintf "inserted %d" (Random.State.int rng 1000)
274
+
in
275
+
let rec ins i = function
276
+
| [] -> [ new_l ]
277
+
| l :: rest when i = idx -> new_l :: l :: rest
278
+
| l :: rest -> l :: ins (i + 1) rest
279
+
in
280
+
lines := ins 0 !lines
281
+
| _ ->
282
+
(* delete *)
283
+
lines := List.filteri (fun i _ -> i <> idx) !lines
284
+
done;
285
+
Array.of_list !lines
286
+
287
+
let test_random_seed seed =
288
+
let base_lines = random_lines ~seed 20 in
289
+
let base = join base_lines in
290
+
let ours = join (edit ~seed:(seed + 1000) ~ops:5 base_lines) in
291
+
let theirs = join (edit ~seed:(seed + 2000) ~ops:5 base_lines) in
292
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base ~ours ~theirs ()
293
+
294
+
(** {1 Section 8: Large file performance check}
295
+
296
+
Generates a large random base, then does single-line edits on each side. The
297
+
merge should be fast (Myers O(ND) is near-linear when D is small). *)
298
+
299
+
let test_large_file_seeded () =
300
+
let seed = 42 in
301
+
let n = 5000 in
302
+
let base_lines = random_lines ~seed n in
303
+
let base = join base_lines in
304
+
let ours_lines = Array.copy base_lines in
305
+
ours_lines.(100) <- "edited by ours";
306
+
let ours = join ours_lines in
307
+
let theirs_lines = Array.copy base_lines in
308
+
theirs_lines.(4900) <- "edited by theirs";
309
+
let theirs = join theirs_lines in
310
+
check_vs_git ~ours_label:"ours" ~theirs_label:"theirs" ~base ~ours ~theirs ()
311
+
312
+
(** {1 Test runner} *)
313
+
314
+
let () =
315
+
Alcotest.run "merge3-interop-git"
316
+
[
317
+
( "trivial-clean",
318
+
[
319
+
Alcotest.test_case "identical" `Quick test_identical;
320
+
Alcotest.test_case "only ours" `Quick test_only_ours_changed;
321
+
Alcotest.test_case "only theirs" `Quick test_only_theirs_changed;
322
+
Alcotest.test_case "both same" `Quick test_both_same_change;
323
+
] );
324
+
( "non-overlapping",
325
+
[
326
+
Alcotest.test_case "modifies" `Quick test_non_overlapping_modifies;
327
+
Alcotest.test_case "inserts" `Quick test_non_overlapping_inserts;
328
+
Alcotest.test_case "deletes" `Quick test_non_overlapping_deletes;
329
+
Alcotest.test_case "unrelated blocks" `Quick
330
+
test_modify_unrelated_blocks;
331
+
] );
332
+
( "inserts",
333
+
[
334
+
Alcotest.test_case "ours inserts" `Quick
335
+
test_ours_inserts_theirs_unchanged;
336
+
Alcotest.test_case "theirs inserts" `Quick
337
+
test_theirs_inserts_ours_unchanged;
338
+
Alcotest.test_case "both at start" `Quick test_both_insert_at_start;
339
+
Alcotest.test_case "both at end" `Quick test_both_insert_at_end;
340
+
] );
341
+
( "conflicts",
342
+
[
343
+
Alcotest.test_case "same line" `Quick test_both_modify_same_line;
344
+
Alcotest.test_case "same block diff" `Quick
345
+
test_both_modify_same_block_differently;
346
+
Alcotest.test_case "overlapping inserts" `Quick
347
+
test_overlapping_inserts;
348
+
Alcotest.test_case "completely different" `Quick
349
+
test_completely_different;
350
+
] );
351
+
( "edge-cases",
352
+
[
353
+
Alcotest.test_case "empty base" `Quick test_empty_base;
354
+
Alcotest.test_case "no trailing newline" `Quick
355
+
test_no_trailing_newline;
356
+
Alcotest.test_case "whitespace only" `Quick
357
+
test_only_whitespace_changes;
358
+
Alcotest.test_case "single line" `Quick test_single_line_files;
359
+
] );
360
+
( "realistic",
361
+
[
362
+
Alcotest.test_case "ocaml function edits" `Quick
363
+
test_ocaml_function_edits;
364
+
Alcotest.test_case "imports both sides" `Quick
365
+
test_imports_added_both_sides;
366
+
Alcotest.test_case "changelog" `Quick test_changelog_entries;
367
+
] );
368
+
( "random",
369
+
[
370
+
Alcotest.test_case "seed 1" `Quick (fun () -> test_random_seed 1);
371
+
Alcotest.test_case "seed 2" `Quick (fun () -> test_random_seed 2);
372
+
Alcotest.test_case "seed 7" `Quick (fun () -> test_random_seed 7);
373
+
Alcotest.test_case "seed 42" `Quick (fun () -> test_random_seed 42);
374
+
Alcotest.test_case "seed 100" `Quick (fun () -> test_random_seed 100);
375
+
Alcotest.test_case "seed 999" `Quick (fun () -> test_random_seed 999);
376
+
] );
377
+
("large", [ Alcotest.test_case "5000 lines" `Slow test_large_file_seeded ]);
378
+
]
+123
test/test.ml
+123
test/test.ml
···
1
+
(** Unit tests for [Merge3].
2
+
3
+
Differential tests against [git merge-file] live in
4
+
[test/interop/git/test.ml]. *)
5
+
6
+
(** {1 Myers diff tests} *)
7
+
8
+
let test_diff_empty () =
9
+
let edits = Merge3.diff ~eq:String.equal [||] [||] in
10
+
Alcotest.(check int) "empty diff" 0 (List.length edits)
11
+
12
+
let test_diff_insert () =
13
+
let a = [||] and b = [| "hello" |] in
14
+
let edits = Merge3.diff ~eq:String.equal a b in
15
+
Alcotest.(check int) "one insert" 1 (List.length edits);
16
+
match edits with
17
+
| [ Merge3.Insert "hello" ] -> ()
18
+
| _ -> Alcotest.fail "expected Insert"
19
+
20
+
let test_diff_delete () =
21
+
let a = [| "hello" |] and b = [||] in
22
+
let edits = Merge3.diff ~eq:String.equal a b in
23
+
Alcotest.(check int) "one delete" 1 (List.length edits);
24
+
match edits with
25
+
| [ Merge3.Delete "hello" ] -> ()
26
+
| _ -> Alcotest.fail "expected Delete"
27
+
28
+
let test_diff_keep () =
29
+
let a = [| "hello" |] and b = [| "hello" |] in
30
+
let edits = Merge3.diff ~eq:String.equal a b in
31
+
match edits with
32
+
| [ Merge3.Keep "hello" ] -> ()
33
+
| _ -> Alcotest.fail "expected Keep"
34
+
35
+
let test_diff_mixed () =
36
+
let a = [| "a"; "b"; "c" |] and b = [| "a"; "x"; "c" |] in
37
+
let edits = Merge3.diff ~eq:String.equal a b in
38
+
let count_kind p = List.length (List.filter p edits) in
39
+
Alcotest.(check int)
40
+
"2 keeps" 2
41
+
(count_kind (function Merge3.Keep _ -> true | _ -> false));
42
+
Alcotest.(check int)
43
+
"1 delete" 1
44
+
(count_kind (function Merge3.Delete _ -> true | _ -> false));
45
+
Alcotest.(check int)
46
+
"1 insert" 1
47
+
(count_kind (function Merge3.Insert _ -> true | _ -> false))
48
+
49
+
let test_lcs_basic () =
50
+
let a = [| "a"; "b"; "c"; "d" |] and b = [| "a"; "c"; "d"; "e" |] in
51
+
let pairs = Merge3.lcs ~eq:String.equal a b in
52
+
Alcotest.(check int) "LCS length" 3 (List.length pairs)
53
+
54
+
(** {1 Combinator tests} *)
55
+
56
+
let test_default_unchanged () =
57
+
let eq = Int.equal in
58
+
match Merge3.default ~eq ~old:(Some 1) 1 1 with
59
+
| Merge3.Ok 1 -> ()
60
+
| _ -> Alcotest.fail "expected Ok 1"
61
+
62
+
let test_default_ours_changed () =
63
+
let eq = Int.equal in
64
+
match Merge3.default ~eq ~old:(Some 1) 2 1 with
65
+
| Merge3.Ok 2 -> ()
66
+
| _ -> Alcotest.fail "expected Ok 2"
67
+
68
+
let test_default_theirs_changed () =
69
+
let eq = Int.equal in
70
+
match Merge3.default ~eq ~old:(Some 1) 1 3 with
71
+
| Merge3.Ok 3 -> ()
72
+
| _ -> Alcotest.fail "expected Ok 3"
73
+
74
+
let test_default_conflict () =
75
+
let eq = Int.equal in
76
+
match Merge3.default ~eq ~old:(Some 1) 2 3 with
77
+
| Merge3.Conflict _ -> ()
78
+
| _ -> Alcotest.fail "expected Conflict"
79
+
80
+
let test_default_both_same () =
81
+
let eq = Int.equal in
82
+
match Merge3.default ~eq ~old:(Some 1) 2 2 with
83
+
| Merge3.Ok 2 -> ()
84
+
| _ -> Alcotest.fail "expected Ok 2"
85
+
86
+
(** {1 Merge result accessors} *)
87
+
88
+
let test_has_conflicts_clean () =
89
+
let chunks = Merge3.merge ~base:"a\n" ~ours:"a\n" ~theirs:"a\n" () in
90
+
Alcotest.(check bool) "no conflicts" false (Merge3.has_conflicts chunks)
91
+
92
+
let test_has_conflicts_dirty () =
93
+
let chunks = Merge3.merge ~base:"a\n" ~ours:"x\n" ~theirs:"y\n" () in
94
+
Alcotest.(check bool) "has conflicts" true (Merge3.has_conflicts chunks)
95
+
96
+
(** {1 Test runner} *)
97
+
98
+
let () =
99
+
Alcotest.run "merge3"
100
+
[
101
+
( "diff",
102
+
[
103
+
Alcotest.test_case "empty" `Quick test_diff_empty;
104
+
Alcotest.test_case "insert" `Quick test_diff_insert;
105
+
Alcotest.test_case "delete" `Quick test_diff_delete;
106
+
Alcotest.test_case "keep" `Quick test_diff_keep;
107
+
Alcotest.test_case "mixed" `Quick test_diff_mixed;
108
+
Alcotest.test_case "lcs" `Quick test_lcs_basic;
109
+
] );
110
+
( "combinators",
111
+
[
112
+
Alcotest.test_case "default unchanged" `Quick test_default_unchanged;
113
+
Alcotest.test_case "default ours" `Quick test_default_ours_changed;
114
+
Alcotest.test_case "default theirs" `Quick test_default_theirs_changed;
115
+
Alcotest.test_case "default conflict" `Quick test_default_conflict;
116
+
Alcotest.test_case "default both same" `Quick test_default_both_same;
117
+
] );
118
+
( "merge",
119
+
[
120
+
Alcotest.test_case "no conflicts" `Quick test_has_conflicts_clean;
121
+
Alcotest.test_case "has conflicts" `Quick test_has_conflicts_dirty;
122
+
] );
123
+
]