Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
Add generic_store test library; run on all backend combinations
New library irmin/test/test_store/generic_store.ml provides 9
backend-agnostic test scenarios (commit/checkout, multi-commit,
read_commit, branches, CAS, log, is_ancestor, merge_base, head).
Each backend provides a config with a run function that sets up
the store, runs the test, and cleans up. Tests exercise 4 backends:
- mst:memory (SHA-256, in-memory) — 9/9
- mst:disk (SHA-256, on-disk WAL) — 9/9
- git (SHA-1, on-disk Git repo) — 9/9
- pds (CID/DAG-CBOR, ATProto PDS) — 3/9 (6 stubs)
+223
-199
+1
-1
test/dune
+1
-1
test/dune
+15
-17
test/test.ml
+15
-17
test/test.ml
···
1
1
let () =
2
2
Alcotest.run "Irmin"
3
-
[
4
-
Test_hash.suite;
5
-
Test_tree.suite;
6
-
Test_backend.suite;
7
-
Test_store.suite;
8
-
Test_store.mst_suite;
9
-
Test_store.git_suite;
10
-
Test_store.pds_suite;
11
-
Test_codec.suite;
12
-
Test_link.suite;
13
-
Test_proof.suite;
14
-
Test_commit.suite;
15
-
Test_git_interop.suite;
16
-
Test_subtree.suite;
17
-
Test_pds_interop.suite;
18
-
Test_irmin.suite;
19
-
]
3
+
([
4
+
Test_hash.suite;
5
+
Test_tree.suite;
6
+
Test_backend.suite;
7
+
Test_store.suite;
8
+
Test_codec.suite;
9
+
Test_link.suite;
10
+
Test_proof.suite;
11
+
Test_commit.suite;
12
+
Test_git_interop.suite;
13
+
Test_subtree.suite;
14
+
Test_pds_interop.suite;
15
+
Test_irmin.suite;
16
+
]
17
+
@ Test_stores.suites)
+1
-171
test/test_store.ml
+1
-171
test/test_store.ml
···
1
-
(* Store tests — backend-agnostic test scenarios run on all backends.
2
-
Ported from upstream irmin src/irmin-test/store.ml. *)
1
+
(* Internal API tests using Private modules directly (SHA-1 only). *)
3
2
4
3
open Irmin.Private
5
-
6
-
(* {1 Internal API tests (Private modules, SHA-1 only)} *)
7
4
8
5
let test_store_commit () =
9
6
let backend = Backend.Memory.sha1 () in
···
58
55
Alcotest.(check bool) "file3 added" true has_add_file3;
59
56
Alcotest.(check bool) "file1 changed" true has_change_file1
60
57
61
-
(* {1 Backend-agnostic tests — each takes an Irmin.t } *)
62
-
63
-
let test_commit_checkout s =
64
-
let tree = Irmin.Tree.add Irmin.Tree.empty [ "file.txt" ] "hello" in
65
-
let h = Irmin.commit s ~tree ~parents:[] ~message:"init" ~author:"test" in
66
-
Irmin.set_head s ~branch:"main" h;
67
-
match Irmin.checkout s ~branch:"main" with
68
-
| None -> Alcotest.fail "checkout returned None"
69
-
| Some tree' ->
70
-
Alcotest.(check (option string))
71
-
"roundtrip" (Some "hello")
72
-
(Irmin.Tree.find tree' [ "file.txt" ])
73
-
74
-
let test_multi_commit s =
75
-
let tree = Irmin.Tree.add Irmin.Tree.empty [ "a" ] "1" in
76
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"first" ~author:"t" in
77
-
Irmin.set_head s ~branch:"main" h1;
78
-
let tree = Irmin.Tree.add tree [ "b" ] "2" in
79
-
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"second" ~author:"t" in
80
-
Irmin.set_head s ~branch:"main" h2;
81
-
match Irmin.checkout s ~branch:"main" with
82
-
| None -> Alcotest.fail "checkout failed"
83
-
| Some tree' ->
84
-
Alcotest.(check (option string))
85
-
"first" (Some "1")
86
-
(Irmin.Tree.find tree' [ "a" ]);
87
-
Alcotest.(check (option string))
88
-
"second" (Some "2")
89
-
(Irmin.Tree.find tree' [ "b" ])
90
-
91
-
let test_read_commit s =
92
-
let tree = Irmin.Tree.add Irmin.Tree.empty [ "x" ] "y" in
93
-
let h = Irmin.commit s ~tree ~parents:[] ~message:"msg" ~author:"alice" in
94
-
match Irmin.read_commit s h with
95
-
| None -> Alcotest.fail "read_commit returned None"
96
-
| Some c ->
97
-
Alcotest.(check string) "author" "alice" c.author;
98
-
Alcotest.(check string) "message" "msg" c.message;
99
-
Alcotest.(check bool) "id" true (Irmin.Hash.equal c.id h)
100
-
101
-
let test_multi_branch s =
102
-
let tree = Irmin.Tree.add Irmin.Tree.empty [ "a" ] "1" in
103
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"main" ~author:"t" in
104
-
Irmin.set_head s ~branch:"main" h1;
105
-
let tree2 = Irmin.Tree.add tree [ "b" ] "2" in
106
-
let h2 =
107
-
Irmin.commit s ~tree:tree2 ~parents:[ h1 ] ~message:"dev" ~author:"t"
108
-
in
109
-
Irmin.set_head s ~branch:"dev" h2;
110
-
let bs = Irmin.branches s in
111
-
Alcotest.(check bool) "has main" true (List.mem "main" bs);
112
-
Alcotest.(check bool) "has dev" true (List.mem "dev" bs)
113
-
114
-
let test_cas s =
115
-
let tree = Irmin.Tree.empty in
116
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
117
-
Irmin.set_head s ~branch:"main" h1;
118
-
let tree2 = Irmin.Tree.add tree [ "new" ] "data" in
119
-
let h2 =
120
-
Irmin.commit s ~tree:tree2 ~parents:[ h1 ] ~message:"c2" ~author:"t"
121
-
in
122
-
match Irmin.update_branch s ~branch:"main" ~old:(Some h1) ~new_:h2 with
123
-
| Ok () ->
124
-
Alcotest.(check bool)
125
-
"updated" true
126
-
(match Irmin.head s ~branch:"main" with
127
-
| Some h -> Irmin.Hash.equal h h2
128
-
| None -> false)
129
-
| Error `Conflict -> Alcotest.fail "unexpected conflict"
130
-
131
-
let test_log s =
132
-
let tree = Irmin.Tree.empty in
133
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
134
-
let tree = Irmin.Tree.add tree [ "a" ] "1" in
135
-
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
136
-
let tree = Irmin.Tree.add tree [ "b" ] "2" in
137
-
let h3 = Irmin.commit s ~tree ~parents:[ h2 ] ~message:"c3" ~author:"t" in
138
-
Irmin.set_head s ~branch:"main" h3;
139
-
let entries = Irmin.log s ~branch:"main" () in
140
-
Alcotest.(check int) "3 commits" 3 (List.length entries);
141
-
Alcotest.(check string) "newest" "c3" (List.nth entries 0).message
142
-
143
-
let test_ancestor s =
144
-
let tree = Irmin.Tree.empty in
145
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
146
-
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
147
-
let h3 = Irmin.commit s ~tree ~parents:[ h2 ] ~message:"c3" ~author:"t" in
148
-
Alcotest.(check bool)
149
-
"grandparent" true
150
-
(Irmin.is_ancestor s ~ancestor:h1 ~descendant:h3);
151
-
Alcotest.(check bool)
152
-
"not reverse" false
153
-
(Irmin.is_ancestor s ~ancestor:h3 ~descendant:h1)
154
-
155
-
let test_merge_base s =
156
-
let tree = Irmin.Tree.empty in
157
-
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
158
-
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
159
-
let h3 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c3" ~author:"t" in
160
-
match Irmin.merge_base s h2 h3 with
161
-
| Some mb -> Alcotest.(check bool) "mb" true (Irmin.Hash.equal mb h1)
162
-
| None -> Alcotest.fail "expected merge base"
163
-
164
-
let test_head_none s =
165
-
Alcotest.(check bool) "no head" true (Irmin.head s ~branch:"nope" = None)
166
-
167
-
let generic_tests name (run : (Irmin.t -> unit) -> unit) =
168
-
let t f () = run f in
169
-
( name,
170
-
[
171
-
Alcotest.test_case "commit/checkout" `Quick (t test_commit_checkout);
172
-
Alcotest.test_case "multiple commits" `Quick (t test_multi_commit);
173
-
Alcotest.test_case "read_commit" `Quick (t test_read_commit);
174
-
Alcotest.test_case "multiple branches" `Quick (t test_multi_branch);
175
-
Alcotest.test_case "update_branch CAS" `Quick (t test_cas);
176
-
Alcotest.test_case "log" `Quick (t test_log);
177
-
Alcotest.test_case "is_ancestor" `Quick (t test_ancestor);
178
-
Alcotest.test_case "merge_base" `Quick (t test_merge_base);
179
-
Alcotest.test_case "head nonexistent" `Quick (t test_head_none);
180
-
] )
181
-
182
-
(* {1 Git backend helper} *)
183
-
184
-
let rec rm_rf path =
185
-
if Eio.Path.is_directory path then begin
186
-
List.iter
187
-
(fun name -> rm_rf Eio.Path.(path / name))
188
-
(Eio.Path.read_dir path);
189
-
Eio.Path.rmdir path
190
-
end
191
-
else if Eio.Path.is_file path then Eio.Path.unlink path
192
-
193
-
let with_git_store f =
194
-
Eio_main.run @@ fun env ->
195
-
Eio.Switch.run @@ fun sw ->
196
-
let fs = Eio.Stdenv.fs env in
197
-
let tmp =
198
-
Fmt.str "/tmp/irmin-test-git-%d" (Random.int 1_000_000) |> Fpath.v
199
-
in
200
-
Fun.protect
201
-
~finally:(fun () ->
202
-
try rm_rf Eio.Path.(fs / Fpath.to_string tmp) with _ -> ())
203
-
(fun () ->
204
-
let s = Irmin.Git.init ~sw ~fs ~path:tmp in
205
-
f s)
206
-
207
-
let with_pds_store f =
208
-
Eio_main.run @@ fun env ->
209
-
Eio.Switch.run @@ fun sw ->
210
-
let cwd = Eio.Stdenv.cwd env in
211
-
let name = Fmt.str "irmin-test-pds-%d" (Random.int 1_000_000) in
212
-
let path = Eio.Path.(cwd / "_build" / name) in
213
-
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path with _ -> ());
214
-
Fun.protect
215
-
~finally:(fun () -> try rm_rf path with _ -> ())
216
-
(fun () ->
217
-
let did = Atp.Did.of_string_exn "did:web:test.irmin" in
218
-
let pds = Pds.v ~sw path ~did in
219
-
let s = Irmin.Mst.of_pds pds in
220
-
f s)
221
-
222
-
(* {1 Suites} *)
223
-
224
58
let suite =
225
59
( "store",
226
60
[
···
228
62
Alcotest.test_case "store branches" `Quick test_store_branches;
229
63
Alcotest.test_case "store diff" `Quick test_store_diff;
230
64
] )
231
-
232
-
let mst_suite = generic_tests "store:mst" (fun f -> f (Irmin.Mst.memory ()))
233
-
let git_suite = generic_tests "store:git" (fun f -> with_git_store f)
234
-
let pds_suite = generic_tests "store:pds" (fun f -> with_pds_store f)
-10
test/test_store.mli
-10
test/test_store.mli
···
1
1
val suite : string * unit Alcotest.test_case list
2
-
(** Internal API tests (Private modules). *)
3
-
4
-
val mst_suite : string * unit Alcotest.test_case list
5
-
(** Backend-agnostic tests on MST in-memory backend. *)
6
-
7
-
val git_suite : string * unit Alcotest.test_case list
8
-
(** Backend-agnostic tests on Git backend. *)
9
-
10
-
val pds_suite : string * unit Alcotest.test_case list
11
-
(** Backend-agnostic tests on ATProto PDS backend. *)
+132
test/test_store/generic_store.ml
+132
test/test_store/generic_store.ml
···
1
+
(** Backend-agnostic store test suite.
2
+
3
+
Each backend provides a {!config} with a [run] function that sets up the
4
+
store, passes it to the test, and cleans up afterwards. *)
5
+
6
+
type config = { name : string; run : (Irmin.t -> unit) -> unit }
7
+
8
+
let make ~name ~run = { name; run }
9
+
10
+
(* {1 Test scenarios} *)
11
+
12
+
let test_commit_checkout s =
13
+
let tree = Irmin.Tree.add Irmin.Tree.empty [ "file.txt" ] "hello" in
14
+
let h = Irmin.commit s ~tree ~parents:[] ~message:"init" ~author:"test" in
15
+
Irmin.set_head s ~branch:"main" h;
16
+
match Irmin.checkout s ~branch:"main" with
17
+
| None -> Alcotest.fail "checkout returned None"
18
+
| Some tree' ->
19
+
Alcotest.(check (option string))
20
+
"roundtrip" (Some "hello")
21
+
(Irmin.Tree.find tree' [ "file.txt" ])
22
+
23
+
let test_multi_commit s =
24
+
let tree = Irmin.Tree.add Irmin.Tree.empty [ "a" ] "1" in
25
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"first" ~author:"t" in
26
+
Irmin.set_head s ~branch:"main" h1;
27
+
let tree = Irmin.Tree.add tree [ "b" ] "2" in
28
+
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"second" ~author:"t" in
29
+
Irmin.set_head s ~branch:"main" h2;
30
+
match Irmin.checkout s ~branch:"main" with
31
+
| None -> Alcotest.fail "checkout failed"
32
+
| Some tree' ->
33
+
Alcotest.(check (option string))
34
+
"first" (Some "1")
35
+
(Irmin.Tree.find tree' [ "a" ]);
36
+
Alcotest.(check (option string))
37
+
"second" (Some "2")
38
+
(Irmin.Tree.find tree' [ "b" ])
39
+
40
+
let test_read_commit s =
41
+
let tree = Irmin.Tree.add Irmin.Tree.empty [ "x" ] "y" in
42
+
let h = Irmin.commit s ~tree ~parents:[] ~message:"msg" ~author:"alice" in
43
+
match Irmin.read_commit s h with
44
+
| None -> Alcotest.fail "read_commit returned None"
45
+
| Some c ->
46
+
Alcotest.(check string) "author" "alice" c.author;
47
+
Alcotest.(check string) "message" "msg" c.message;
48
+
Alcotest.(check bool) "id" true (Irmin.Hash.equal c.id h)
49
+
50
+
let test_multi_branch s =
51
+
let tree = Irmin.Tree.add Irmin.Tree.empty [ "a" ] "1" in
52
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"main" ~author:"t" in
53
+
Irmin.set_head s ~branch:"main" h1;
54
+
let tree2 = Irmin.Tree.add tree [ "b" ] "2" in
55
+
let h2 =
56
+
Irmin.commit s ~tree:tree2 ~parents:[ h1 ] ~message:"dev" ~author:"t"
57
+
in
58
+
Irmin.set_head s ~branch:"dev" h2;
59
+
let bs = Irmin.branches s in
60
+
Alcotest.(check bool) "has main" true (List.mem "main" bs);
61
+
Alcotest.(check bool) "has dev" true (List.mem "dev" bs)
62
+
63
+
let test_cas s =
64
+
let tree = Irmin.Tree.empty in
65
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
66
+
Irmin.set_head s ~branch:"main" h1;
67
+
let tree2 = Irmin.Tree.add tree [ "new" ] "data" in
68
+
let h2 =
69
+
Irmin.commit s ~tree:tree2 ~parents:[ h1 ] ~message:"c2" ~author:"t"
70
+
in
71
+
match Irmin.update_branch s ~branch:"main" ~old:(Some h1) ~new_:h2 with
72
+
| Ok () ->
73
+
Alcotest.(check bool)
74
+
"updated" true
75
+
(match Irmin.head s ~branch:"main" with
76
+
| Some h -> Irmin.Hash.equal h h2
77
+
| None -> false)
78
+
| Error `Conflict -> Alcotest.fail "unexpected conflict"
79
+
80
+
let test_log s =
81
+
let tree = Irmin.Tree.empty in
82
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
83
+
let tree = Irmin.Tree.add tree [ "a" ] "1" in
84
+
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
85
+
let tree = Irmin.Tree.add tree [ "b" ] "2" in
86
+
let h3 = Irmin.commit s ~tree ~parents:[ h2 ] ~message:"c3" ~author:"t" in
87
+
Irmin.set_head s ~branch:"main" h3;
88
+
let entries = Irmin.log s ~branch:"main" () in
89
+
Alcotest.(check int) "3 commits" 3 (List.length entries);
90
+
Alcotest.(check string) "newest" "c3" (List.nth entries 0).message
91
+
92
+
let test_ancestor s =
93
+
let tree = Irmin.Tree.empty in
94
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
95
+
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
96
+
let h3 = Irmin.commit s ~tree ~parents:[ h2 ] ~message:"c3" ~author:"t" in
97
+
Alcotest.(check bool)
98
+
"grandparent" true
99
+
(Irmin.is_ancestor s ~ancestor:h1 ~descendant:h3);
100
+
Alcotest.(check bool)
101
+
"not reverse" false
102
+
(Irmin.is_ancestor s ~ancestor:h3 ~descendant:h1)
103
+
104
+
let test_merge_base s =
105
+
let tree = Irmin.Tree.empty in
106
+
let h1 = Irmin.commit s ~tree ~parents:[] ~message:"c1" ~author:"t" in
107
+
let h2 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c2" ~author:"t" in
108
+
let h3 = Irmin.commit s ~tree ~parents:[ h1 ] ~message:"c3" ~author:"t" in
109
+
match Irmin.merge_base s h2 h3 with
110
+
| Some mb -> Alcotest.(check bool) "mb" true (Irmin.Hash.equal mb h1)
111
+
| None -> Alcotest.fail "expected merge base"
112
+
113
+
let test_head_none s =
114
+
Alcotest.(check bool) "no head" true (Irmin.head s ~branch:"nope" = None)
115
+
116
+
(* {1 Suite constructor} *)
117
+
118
+
let suite t =
119
+
( t.name,
120
+
List.map
121
+
(fun (name, f) -> Alcotest.test_case name `Quick (fun () -> t.run f))
122
+
[
123
+
("commit/checkout", test_commit_checkout);
124
+
("multiple commits", test_multi_commit);
125
+
("read_commit", test_read_commit);
126
+
("multiple branches", test_multi_branch);
127
+
("update_branch CAS", test_cas);
128
+
("log", test_log);
129
+
("is_ancestor", test_ancestor);
130
+
("merge_base", test_merge_base);
131
+
("head nonexistent", test_head_none);
132
+
] )
+69
test/test_stores.ml
+69
test/test_stores.ml
···
1
+
(** Backend configs for the generic store test suite. Tests all combinations:
2
+
in-memory, on-disk, Git, PDS. *)
3
+
4
+
let rec rm_rf path =
5
+
if Eio.Path.is_directory path then begin
6
+
List.iter
7
+
(fun name -> rm_rf Eio.Path.(path / name))
8
+
(Eio.Path.read_dir path);
9
+
Eio.Path.rmdir path
10
+
end
11
+
else if Eio.Path.is_file path then Eio.Path.unlink path
12
+
13
+
(* {1 MST in-memory (SHA-256)} *)
14
+
15
+
let mst_memory =
16
+
Generic_store.make ~name:"mst:memory" ~run:(fun f -> f (Irmin.Mst.memory ()))
17
+
18
+
(* {1 MST on-disk (SHA-256)} *)
19
+
20
+
let mst_disk =
21
+
Generic_store.make ~name:"mst:disk" ~run:(fun f ->
22
+
Eio_main.run @@ fun env ->
23
+
Eio.Switch.run @@ fun sw ->
24
+
let fs = Eio.Stdenv.fs env in
25
+
let name = Fmt.str "/tmp/irmin-test-mst-%d" (Random.int 1_000_000) in
26
+
let path = Eio.Path.(fs / name) in
27
+
Fun.protect
28
+
~finally:(fun () -> try rm_rf path with _ -> ())
29
+
(fun () -> f (Irmin.Mst.disk ~sw path)))
30
+
31
+
(* {1 Git (SHA-1, on-disk)} *)
32
+
33
+
let git =
34
+
Generic_store.make ~name:"git" ~run:(fun f ->
35
+
Eio_main.run @@ fun env ->
36
+
Eio.Switch.run @@ fun sw ->
37
+
let fs = Eio.Stdenv.fs env in
38
+
let name = Fmt.str "/tmp/irmin-test-git-%d" (Random.int 1_000_000) in
39
+
let path = Eio.Path.(fs / name) in
40
+
Fun.protect
41
+
~finally:(fun () -> try rm_rf path with _ -> ())
42
+
(fun () -> f (Irmin.Git.init ~sw ~fs ~path:(Fpath.v name))))
43
+
44
+
(* {1 ATProto PDS (CID/DAG-CBOR, on-disk)} *)
45
+
46
+
let pds =
47
+
Generic_store.make ~name:"pds" ~run:(fun f ->
48
+
Eio_main.run @@ fun env ->
49
+
Eio.Switch.run @@ fun sw ->
50
+
let cwd = Eio.Stdenv.cwd env in
51
+
let name = Fmt.str "irmin-test-pds-%d" (Random.int 1_000_000) in
52
+
let path = Eio.Path.(cwd / "_build" / name) in
53
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path with _ -> ());
54
+
Fun.protect
55
+
~finally:(fun () -> try rm_rf path with _ -> ())
56
+
(fun () ->
57
+
let did = Atp.Did.of_string_exn "did:web:test.irmin" in
58
+
let p = Pds.v ~sw path ~did in
59
+
f (Irmin.Mst.of_pds p)))
60
+
61
+
(* {1 All suites} *)
62
+
63
+
let suites =
64
+
[
65
+
Generic_store.suite mst_memory;
66
+
Generic_store.suite mst_disk;
67
+
Generic_store.suite git;
68
+
Generic_store.suite pds;
69
+
]