Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
fix(lint): resolve E410, E415, E605 in irmin; tidy irmin bin/lib
- E605: Split monolithic test_irmin.ml into 10 per-module test files
(test_hash, test_tree, test_backend, test_store, test_codec, test_link,
test_proof, test_commit, test_git_interop, test_subtree)
- E410: Fix doc arg count for any_algorithm, any_to_bytes, any_to_hex
- E415: Add Proof.pp pretty-printer
- Tidy irmin bin commands (cmd_checkout, cmd_import, cmd_info)
- Tidy irmin lib (backend, codec, link) and add irmin.mli
- Fix merlint E331 rule, dune fmt across space-dtn
+924
-633
+12
-21
bin/cmd_checkout.ml
+12
-21
bin/cmd_checkout.ml
···
8
8
Eio.Switch.run @@ fun sw ->
9
9
let store = B.open_store ~sw ~fs ~config in
10
10
let existing = B.branches store in
11
-
if create then begin
12
-
if List.mem branch existing then begin
13
-
Common.error "Branch %a already exists" Common.styled_cyan branch;
14
-
1
15
-
end
16
-
else begin
17
-
(* Create new branch pointing at current HEAD or empty *)
18
-
(match B.head store ~branch:"main" with
19
-
| Some h -> B.set_head store ~branch h
20
-
| None -> (
21
-
match existing with
22
-
| first :: _ -> (
23
-
match B.head store ~branch:first with
24
-
| Some h -> B.set_head store ~branch h
25
-
| None -> ())
26
-
| [] -> ()));
27
-
Common.success "Created branch %a" Common.styled_cyan branch;
28
-
0
29
-
end
30
-
end
31
-
else begin
11
+
if not create then begin
32
12
if not (List.mem branch existing) then begin
33
13
Common.error "Branch %a not found" Common.styled_cyan branch;
34
14
1
···
38
18
0
39
19
end
40
20
end
21
+
else if List.mem branch existing then begin
22
+
Common.error "Branch %a already exists" Common.styled_cyan branch;
23
+
1
24
+
end
25
+
else begin
26
+
let candidates = "main" :: List.filter (( <> ) "main") existing in
27
+
let head = List.find_map (fun b -> B.head store ~branch:b) candidates in
28
+
(match head with Some h -> B.set_head store ~branch h | None -> ());
29
+
Common.success "Created branch %a" Common.styled_cyan branch;
30
+
0
31
+
end
+19
-25
bin/cmd_import.ml
+19
-25
bin/cmd_import.ml
···
1
1
(** Import command - import data from external formats. *)
2
2
3
+
let import_car ~config ~fs data file =
4
+
let header, blocks = Atp.Car.of_string ~cid_format:`Atproto data in
5
+
let irmin_dir = Filename.concat config.Config.store_path ".irmin" in
6
+
(try Unix.mkdir irmin_dir 0o755 with Unix.Unix_error _ -> ());
7
+
let store_path = Eio.Path.(fs / irmin_dir / "blocks") in
8
+
let blockstore = Atp.Blockstore.filesystem store_path in
9
+
let count = ref 0 in
10
+
List.iter
11
+
(fun (cid, block_data) ->
12
+
blockstore#put cid block_data;
13
+
incr count)
14
+
blocks;
15
+
blockstore#sync;
16
+
Common.success "Imported %d blocks from %a" !count Common.styled_cyan file;
17
+
ignore header;
18
+
0
19
+
3
20
let run ~repo ~branch file =
4
21
let config = Config.load ~repo () in
5
22
Eio_main.run @@ fun env ->
···
7
24
Eio.Switch.run @@ fun sw ->
8
25
let file_path = Eio.Path.(fs / file) in
9
26
let data = Eio.Path.load file_path in
10
-
(* Detect format from extension or content *)
11
-
let is_car =
12
-
String.length file > 4
13
-
&& String.sub file (String.length file - 4) 4 = ".car"
14
-
in
15
-
if is_car then begin
16
-
(* Import CAR file *)
17
-
let header, blocks = Atp.Car.of_string ~cid_format:`Atproto data in
18
-
let irmin_dir = Filename.concat config.Config.store_path ".irmin" in
19
-
(try Unix.mkdir irmin_dir 0o755 with Unix.Unix_error _ -> ());
20
-
let store_path = Eio.Path.(fs / irmin_dir / "blocks") in
21
-
let blockstore = Atp.Blockstore.filesystem store_path in
22
-
let count = ref 0 in
23
-
List.iter
24
-
(fun (cid, block_data) ->
25
-
blockstore#put cid block_data;
26
-
incr count)
27
-
blocks;
28
-
blockstore#sync;
29
-
Common.success "Imported %d blocks from %a" !count Common.styled_cyan file;
30
-
ignore header;
31
-
ignore branch;
32
-
0
33
-
end
27
+
let is_car = Filename.check_suffix file ".car" in
28
+
if is_car then import_car ~config ~fs data file
34
29
else begin
35
-
(* Import as plain content at path *)
36
30
let (module B : Common.BACKEND) = Common.backend_of_config config in
37
31
let store = B.open_store ~sw ~fs ~config in
38
32
let tree =
+15
-18
bin/cmd_info.ml
+15
-18
bin/cmd_info.ml
···
1
1
(** Info command - show store or file information. *)
2
2
3
+
let print_car_info file data =
4
+
let header, blocks = Atp.Car.of_string ~cid_format:`Atproto data in
5
+
let block_count = List.length blocks in
6
+
let total_size =
7
+
List.fold_left (fun acc (_, d) -> acc + String.length d) 0 blocks
8
+
in
9
+
Fmt.pr "File: %s@." file;
10
+
Fmt.pr "Format: CAR v%d@." header.Atp.Car.version;
11
+
Fmt.pr "Roots: %d@." (List.length header.roots);
12
+
List.iter (fun cid -> Fmt.pr " %s@." (Atp.Cid.to_string cid)) header.roots;
13
+
Fmt.pr "Blocks: %d@." block_count;
14
+
Fmt.pr "Size: %d bytes@." total_size;
15
+
0
16
+
3
17
let run_file file =
4
18
Eio_main.run @@ fun env ->
5
19
let fs = Eio.Stdenv.cwd env in
6
20
Eio.Switch.run @@ fun _sw ->
7
21
let file_path = Eio.Path.(fs / file) in
8
22
let data = Eio.Path.load file_path in
9
-
let is_car =
10
-
String.length file > 4
11
-
&& String.sub file (String.length file - 4) 4 = ".car"
12
-
in
13
-
if is_car then begin
14
-
let header, blocks = Atp.Car.of_string ~cid_format:`Atproto data in
15
-
let block_count = List.length blocks in
16
-
let total_size =
17
-
List.fold_left (fun acc (_, d) -> acc + String.length d) 0 blocks
18
-
in
19
-
Fmt.pr "File: %s@." file;
20
-
Fmt.pr "Format: CAR v%d@." header.Atp.Car.version;
21
-
Fmt.pr "Roots: %d@." (List.length header.roots);
22
-
List.iter (fun cid -> Fmt.pr " %s@." (Atp.Cid.to_string cid)) header.roots;
23
-
Fmt.pr "Blocks: %d@." block_count;
24
-
Fmt.pr "Size: %d bytes@." total_size;
25
-
0
26
-
end
23
+
if Filename.check_suffix file ".car" then print_car_info file data
27
24
else begin
28
25
Fmt.pr "File: %s@." file;
29
26
Fmt.pr "Size: %d bytes@." (String.length data);
+4
-4
bin/config.ml
+4
-4
bin/config.ml
···
43
43
in
44
44
loop []
45
45
46
-
let config_of_pairs pairs =
46
+
let of_pairs pairs =
47
47
List.fold_left
48
48
(fun cfg (key, value) ->
49
49
match key with
···
66
66
(* Check for config in .irmin/ *)
67
67
let config_path = Filename.concat irmin_dir "config" in
68
68
match parse_config_file config_path with
69
-
| Some pairs -> Some (config_of_pairs pairs)
69
+
| Some pairs -> Some (of_pairs pairs)
70
70
| None -> Some { default with backend = Mst; store_path = irmin_dir }
71
71
else None
72
72
···
77
77
match config_file with
78
78
| Some path -> (
79
79
match parse_config_file path with
80
-
| Some pairs -> config_of_pairs pairs
80
+
| Some pairs -> of_pairs pairs
81
81
| None -> default)
82
82
| None -> (
83
83
(* Try .irmin/config in repo *)
84
84
let irmin_config = Filename.concat repo ".irmin/config" in
85
85
match parse_config_file irmin_config with
86
-
| Some pairs -> config_of_pairs pairs
86
+
| Some pairs -> of_pairs pairs
87
87
| None -> (
88
88
(* Auto-detect from directory structure *)
89
89
match detect_backend ~cwd:repo with
+2
-2
bin/main.ml
+2
-2
bin/main.ml
+9
-6
lib/backend.ml
+9
-6
lib/backend.ml
···
241
241
(Bytes.to_string (Bloom.to_bytes bloom));
242
242
Eio.Path.rename tmp_path path
243
243
244
+
let load_ref of_hex acc full_name entry_path =
245
+
let hex = String.trim (Eio.Path.load entry_path) in
246
+
match of_hex hex with
247
+
| Ok hash -> StringMap.add full_name hash acc
248
+
| Error _ -> acc
249
+
244
250
let load_refs root of_hex =
245
251
let refs_root = refs_path root in
246
-
if Eio.Path.is_directory refs_root then
252
+
if not (Eio.Path.is_directory refs_root) then StringMap.empty
253
+
else
247
254
let rec scan_dir prefix path acc =
248
255
let entries = Eio.Path.read_dir path in
249
256
List.fold_left
···
251
258
let entry_path = Eio.Path.(path / name) in
252
259
let full_name = if prefix = "" then name else prefix ^ "/" ^ name in
253
260
if Eio.Path.is_file entry_path then
254
-
let hex = String.trim (Eio.Path.load entry_path) in
255
-
match of_hex hex with
256
-
| Ok hash -> StringMap.add full_name hash acc
257
-
| Error _ -> acc
261
+
load_ref of_hex acc full_name entry_path
258
262
else if Eio.Path.is_directory entry_path then
259
263
scan_dir full_name entry_path acc
260
264
else acc)
261
265
acc entries
262
266
in
263
267
scan_dir "" refs_root StringMap.empty
264
-
else StringMap.empty
265
268
266
269
let save_ref root name hash to_hex =
267
270
let path = refs_path root in
+2
-1
lib/codec.ml
+2
-1
lib/codec.ml
···
248
248
249
249
let node_of_bytes data : (node, [> `Msg of string ]) result =
250
250
try Ok (Atp.Mst.Raw.decode_bytes data)
251
-
with _ -> Error (`Msg "failed to decode MST node")
251
+
with exn ->
252
+
Error (`Msg ("failed to decode MST node: " ^ Printexc.to_string exn))
252
253
253
254
let hash_node node =
254
255
let data = bytes_of_node node in
+3
-3
lib/hash.mli
+3
-3
lib/hash.mli
···
87
87
type any = Any : _ t -> any (** Type-erased hash for mixed-hash stores. *)
88
88
89
89
val any_algorithm : any -> algorithm
90
-
(** [any_algorithm (Any h)] returns the algorithm of the erased hash. *)
90
+
(** [any_algorithm a] returns the algorithm of the erased hash. *)
91
91
92
92
val any_to_bytes : any -> string
93
-
(** [any_to_bytes (Any h)] returns the raw bytes. *)
93
+
(** [any_to_bytes a] returns the raw bytes. *)
94
94
95
95
val any_to_hex : any -> string
96
-
(** [any_to_hex (Any h)] returns the hex representation. *)
96
+
(** [any_to_hex a] returns the hex representation. *)
97
97
98
98
val equal_any : any -> any -> bool
99
99
(** [equal_any a1 a2] compares two type-erased hashes. *)
+105
lib/irmin.mli
+105
lib/irmin.mli
···
1
+
(** Irmin 4.0 - Content-addressable storage for OCaml.
2
+
3
+
Irmin provides two APIs:
4
+
- {b Link API}: Minimal interface for persisting OCaml values.
5
+
- {b Tree API}: Git-compatible version control with paths, commits, and
6
+
branches.
7
+
8
+
Both share a common content-addressable backend.
9
+
10
+
Architecture: Link → Tree → KV
11
+
12
+
{[
13
+
Link ('a link) → Tree (lazy/staged) → KV/Backend (storage)
14
+
]}
15
+
16
+
- {b Link}: Persistent pointers to OCaml values (['a link], [link], [fetch])
17
+
- {b Tree}: Lazy reads, delayed writes (like Git's staging area)
18
+
- {b KV}: Raw content-addressed storage by hash
19
+
20
+
The Link API provides a simple way to persist arbitrary OCaml values:
21
+
22
+
{[
23
+
type tree = node Link.t
24
+
and node = Empty | Node of { l : tree; v : int; r : tree }
25
+
26
+
let leaf x =
27
+
Link.link (Node { l = Link.link Empty; v = x; r = Link.link Empty })
28
+
]} *)
29
+
30
+
(** {1 Link Layer (Persistent Pointers)}
31
+
32
+
The core abstraction: content-addressed pointers to OCaml values. *)
33
+
34
+
module Link = Link
35
+
(** Persistent pointers with [link] and [fetch]. *)
36
+
37
+
(** {1 KV Layer (Storage)}
38
+
39
+
Content-addressed storage with refs for mutable pointers. *)
40
+
41
+
module Hash = Hash
42
+
(** Phantom-typed hashes (SHA-1, SHA-256). *)
43
+
44
+
module Backend = Backend
45
+
(** KV backend implementations (Memory, Git, layered, cached). *)
46
+
47
+
(** {1 Tree Layer (Staging)}
48
+
49
+
Lazy reads, delayed writes. Like Git's index/staging area. Trees are built
50
+
on top of links for Merkle tree structures. *)
51
+
52
+
module Codec = Codec
53
+
(** Format signatures and implementations (Git, MST, extensible). *)
54
+
55
+
module Tree = Tree
56
+
(** Lazy tree with delayed writes. *)
57
+
58
+
module Commit = Commit
59
+
(** Commit operations. *)
60
+
61
+
(** {1 High-Level API} *)
62
+
63
+
module Store = Store
64
+
(** Store combining trees, commits, and branches. *)
65
+
66
+
module Subtree = Subtree
67
+
(** Monorepo subtree operations. *)
68
+
69
+
module Proof = Proof
70
+
(** Merkle proofs for verified computations. *)
71
+
72
+
(** {1 Git Interoperability} *)
73
+
74
+
module Git_interop = Git_interop
75
+
(** Git repository I/O. *)
76
+
77
+
(** {1 Pre-instantiated: Git Format} *)
78
+
79
+
module Git : sig
80
+
(** Git-compatible store (SHA-1, Git object format). *)
81
+
82
+
module Tree = Tree.Git
83
+
module Store : module type of Store.Git
84
+
module Subtree = Subtree.Git
85
+
module Proof = Proof.Git
86
+
87
+
val import :
88
+
sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> git_dir:Fpath.t -> Store.t
89
+
(** Open a bare .git directory as a store. *)
90
+
91
+
val init :
92
+
sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> path:Fpath.t -> Store.t
93
+
(** Initialize a new Git repository and return a store. *)
94
+
end
95
+
96
+
(** {1 Pre-instantiated: MST Format} *)
97
+
98
+
module Mst : sig
99
+
(** ATProto-compatible store (SHA-256, DAG-CBOR MST). *)
100
+
101
+
module Tree = Tree.Mst
102
+
module Store : module type of Store.Mst
103
+
module Subtree = Subtree.Mst
104
+
module Proof = Proof.Mst
105
+
end
+3
-3
lib/link.ml
+3
-3
lib/link.ml
···
40
40
| In_memory x | Both (x, _) -> x
41
41
| At addr -> (
42
42
match l.content.fetch addr with
43
-
| None -> failwith (Printf.sprintf "Link.get: address not found: %s" addr)
43
+
| None -> Fmt.failwith "Link.get: address not found: %s" addr
44
44
| Some data ->
45
45
let x = decode data in
46
46
l.location <- Both (x, addr);
···
62
62
63
63
let pp ppf l =
64
64
match l.location with
65
-
| In_memory _ -> Format.fprintf ppf "<mem>"
65
+
| In_memory _ -> Fmt.string ppf "<mem>"
66
66
| At addr | Both (_, addr) ->
67
-
Format.fprintf ppf "%s" (String.sub addr 0 (min 7 (String.length addr)))
67
+
Fmt.string ppf (String.sub addr 0 (min 7 (String.length addr)))
68
68
69
69
(* Store operations *)
70
70
+17
lib/proof.ml
+17
lib/proof.ml
···
21
21
let after p = p.after
22
22
let state p = p.state
23
23
24
+
let pp pp_hash pp_contents fmt p =
25
+
let pp_kinded fmt = function
26
+
| `Contents h -> Fmt.pf fmt "contents:%a" pp_hash h
27
+
| `Node h -> Fmt.pf fmt "node:%a" pp_hash h
28
+
in
29
+
let rec pp_tree fmt = function
30
+
| Contents c -> Fmt.pf fmt "(%a)" pp_contents c
31
+
| Blinded_contents h -> Fmt.pf fmt "#(%a)" pp_hash h
32
+
| Node entries ->
33
+
Fmt.pf fmt "{%a}"
34
+
Fmt.(list ~sep:(any ", ") (pair ~sep:(any ":") string pp_tree))
35
+
entries
36
+
| Blinded_node h -> Fmt.pf fmt "#{%a}" pp_hash h
37
+
in
38
+
Fmt.pf fmt "@[<2>proof{before=%a;@ after=%a;@ state=%a}@]" pp_kinded p.before
39
+
pp_kinded p.after pp_tree p.state
40
+
24
41
module Make (C : Codec.S) = struct
25
42
type hash = C.hash
26
43
type contents = string
+8
lib/proof.mli
+8
lib/proof.mli
···
57
57
val state : ('hash, 'contents) t -> ('hash, 'contents) tree
58
58
(** [state p] is the sparse tree proving the computation. *)
59
59
60
+
val pp :
61
+
(Format.formatter -> 'hash -> unit) ->
62
+
(Format.formatter -> 'contents -> unit) ->
63
+
Format.formatter ->
64
+
('hash, 'contents) t ->
65
+
unit
66
+
(** [pp pp_hash pp_contents fmt p] pretty-prints a proof. *)
67
+
60
68
(** {1 Producing and Verifying Proofs}
61
69
62
70
These operations are parameterized by a codec for hashing. *)
+1
-1
test/dune
+1
-1
test/dune
+14
test/test.ml
+14
test/test.ml
+170
test/test_backend.ml
+170
test/test_backend.ml
···
1
+
open Irmin
2
+
3
+
let with_temp_dir f =
4
+
Eio_main.run @@ fun env ->
5
+
let cwd = Eio.Stdenv.cwd env in
6
+
Eio.Switch.run @@ fun sw ->
7
+
let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
8
+
let tmp_path = Eio.Path.(cwd / tmp_name) in
9
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path;
10
+
Fun.protect
11
+
~finally:(fun () ->
12
+
let rec rm path =
13
+
if Eio.Path.is_directory path then begin
14
+
List.iter
15
+
(fun name -> rm Eio.Path.(path / name))
16
+
(Eio.Path.read_dir path);
17
+
Eio.Path.rmdir path
18
+
end
19
+
else if Eio.Path.is_file path then Eio.Path.unlink path
20
+
in
21
+
rm tmp_path)
22
+
(fun () -> f ~sw tmp_path)
23
+
24
+
let test_memory_backend () =
25
+
let backend = Backend.Memory.create_sha1 () in
26
+
let data = "test content" in
27
+
let hash = Hash.sha1 data in
28
+
backend.write hash data;
29
+
Alcotest.(check (option string)) "read back" (Some data) (backend.read hash)
30
+
31
+
let test_backend_refs () =
32
+
let backend = Backend.Memory.create_sha1 () in
33
+
let data = "content" in
34
+
let hash = Hash.sha1 data in
35
+
backend.write hash data;
36
+
backend.set_ref "refs/heads/main" hash;
37
+
Alcotest.(check bool)
38
+
"ref exists" true
39
+
(Option.is_some (backend.get_ref "refs/heads/main"));
40
+
match backend.get_ref "refs/heads/main" with
41
+
| Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
42
+
| None -> Alcotest.fail "ref not found"
43
+
44
+
let test_backend_test_and_set () =
45
+
let backend = Backend.Memory.create_sha1 () in
46
+
let h1 = Hash.sha1 "content1" in
47
+
let h2 = Hash.sha1 "content2" in
48
+
backend.write h1 "content1";
49
+
backend.write h2 "content2";
50
+
backend.set_ref "ref" h1;
51
+
let result = backend.test_and_set_ref "ref" ~test:(Some h2) ~set:(Some h2) in
52
+
Alcotest.(check bool) "wrong test fails" false result;
53
+
let result = backend.test_and_set_ref "ref" ~test:(Some h1) ~set:(Some h2) in
54
+
Alcotest.(check bool) "correct test succeeds" true result
55
+
56
+
let test_disk_backend () =
57
+
with_temp_dir @@ fun ~sw tmp_path ->
58
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
59
+
let data = "test content" in
60
+
let hash = Hash.sha1 data in
61
+
backend.write hash data;
62
+
Alcotest.(check (option string)) "read back" (Some data) (backend.read hash);
63
+
backend.close ()
64
+
65
+
let test_disk_backend_persistence () =
66
+
Eio_main.run @@ fun env ->
67
+
let cwd = Eio.Stdenv.cwd env in
68
+
let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
69
+
let tmp_path = Eio.Path.(cwd / tmp_name) in
70
+
let data = "persistent content" in
71
+
let hash = Hash.sha1 data in
72
+
Eio.Switch.run (fun sw ->
73
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
74
+
backend.write hash data;
75
+
backend.set_ref "refs/heads/main" hash;
76
+
backend.flush ();
77
+
backend.close ());
78
+
Eio.Switch.run (fun sw ->
79
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
80
+
Alcotest.(check (option string))
81
+
"read after reopen" (Some data) (backend.read hash);
82
+
Alcotest.(check bool)
83
+
"ref persisted" true
84
+
(Option.is_some (backend.get_ref "refs/heads/main"));
85
+
backend.close ());
86
+
let rec rm path =
87
+
if Eio.Path.is_directory path then begin
88
+
List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
89
+
Eio.Path.rmdir path
90
+
end
91
+
else if Eio.Path.is_file path then Eio.Path.unlink path
92
+
in
93
+
rm tmp_path
94
+
95
+
let test_disk_backend_refs () =
96
+
with_temp_dir @@ fun ~sw tmp_path ->
97
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
98
+
let data = "content" in
99
+
let hash = Hash.sha1 data in
100
+
backend.write hash data;
101
+
backend.set_ref "refs/heads/main" hash;
102
+
Alcotest.(check bool)
103
+
"ref exists" true
104
+
(Option.is_some (backend.get_ref "refs/heads/main"));
105
+
(match backend.get_ref "refs/heads/main" with
106
+
| Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
107
+
| None -> Alcotest.fail "ref not found");
108
+
backend.close ()
109
+
110
+
let test_disk_backend_write_batch () =
111
+
with_temp_dir @@ fun ~sw tmp_path ->
112
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
113
+
let objects =
114
+
[
115
+
(Hash.sha1 "data1", "data1");
116
+
(Hash.sha1 "data2", "data2");
117
+
(Hash.sha1 "data3", "data3");
118
+
]
119
+
in
120
+
backend.write_batch objects;
121
+
List.iter
122
+
(fun (hash, data) ->
123
+
Alcotest.(check (option string))
124
+
"batch item" (Some data) (backend.read hash))
125
+
objects;
126
+
backend.close ()
127
+
128
+
let test_disk_backend_wal_recovery () =
129
+
Eio_main.run @@ fun env ->
130
+
let cwd = Eio.Stdenv.cwd env in
131
+
let tmp_name = Printf.sprintf "irmin-wal-test-%d" (Random.int 100000) in
132
+
let tmp_path = Eio.Path.(cwd / tmp_name) in
133
+
let data = "wal recovery content" in
134
+
let hash = Hash.sha1 data in
135
+
Eio.Switch.run (fun sw ->
136
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
137
+
backend.write hash data;
138
+
Alcotest.(check (option string))
139
+
"readable before crash" (Some data) (backend.read hash);
140
+
backend.close ());
141
+
Eio.Switch.run (fun sw ->
142
+
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
143
+
Alcotest.(check (option string))
144
+
"recovered from WAL" (Some data) (backend.read hash);
145
+
Alcotest.(check bool) "exists after recovery" true (backend.exists hash);
146
+
backend.close ());
147
+
let rec rm path =
148
+
if Eio.Path.is_directory path then begin
149
+
List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
150
+
Eio.Path.rmdir path
151
+
end
152
+
else if Eio.Path.is_file path then Eio.Path.unlink path
153
+
in
154
+
rm tmp_path
155
+
156
+
let suite =
157
+
( "Backend",
158
+
[
159
+
Alcotest.test_case "memory backend" `Quick test_memory_backend;
160
+
Alcotest.test_case "backend refs" `Quick test_backend_refs;
161
+
Alcotest.test_case "backend test_and_set" `Quick test_backend_test_and_set;
162
+
Alcotest.test_case "disk backend" `Quick test_disk_backend;
163
+
Alcotest.test_case "disk backend persistence" `Quick
164
+
test_disk_backend_persistence;
165
+
Alcotest.test_case "disk backend refs" `Quick test_disk_backend_refs;
166
+
Alcotest.test_case "disk backend write_batch" `Quick
167
+
test_disk_backend_write_batch;
168
+
Alcotest.test_case "disk backend WAL recovery" `Quick
169
+
test_disk_backend_wal_recovery;
170
+
] )
+2
test/test_backend.mli
+2
test/test_backend.mli
+31
test/test_codec.ml
+31
test/test_codec.ml
···
1
+
open Irmin
2
+
3
+
let test_git_tree_format () =
4
+
let node = Codec.Git.empty_node in
5
+
Alcotest.(check bool) "empty is empty" true (Codec.Git.is_empty node);
6
+
let h = Hash.sha1 "content" in
7
+
let node = Codec.Git.add node "file.txt" (`Contents h) in
8
+
Alcotest.(check bool) "not empty after add" false (Codec.Git.is_empty node);
9
+
match Codec.Git.find node "file.txt" with
10
+
| Some (`Contents h') ->
11
+
Alcotest.(check bool) "find matches" true (Hash.equal h h')
12
+
| _ -> Alcotest.fail "entry not found"
13
+
14
+
let test_git_tree_serialization () =
15
+
let h = Hash.sha1 "content" in
16
+
let node = Codec.Git.empty_node in
17
+
let node = Codec.Git.add node "file.txt" (`Contents h) in
18
+
let bytes = Codec.Git.bytes_of_node node in
19
+
match Codec.Git.node_of_bytes bytes with
20
+
| Ok node' ->
21
+
let entries = Codec.Git.list node' in
22
+
Alcotest.(check int) "one entry" 1 (List.length entries)
23
+
| Error (`Msg msg) -> Alcotest.fail msg
24
+
25
+
let suite =
26
+
( "Codec",
27
+
[
28
+
Alcotest.test_case "git tree format" `Quick test_git_tree_format;
29
+
Alcotest.test_case "git tree serialization" `Quick
30
+
test_git_tree_serialization;
31
+
] )
+2
test/test_codec.mli
+2
test/test_codec.mli
+71
test/test_commit.ml
+71
test/test_commit.ml
···
1
+
open Irmin
2
+
3
+
let test_commit_fields () =
4
+
let tree_hash = Hash.sha1 "tree content" in
5
+
let c =
6
+
Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice"
7
+
~message:"Initial commit" ()
8
+
in
9
+
Alcotest.(check string) "author" "Alice" (Commit.Git.author c);
10
+
Alcotest.(check string) "message" "Initial commit" (Commit.Git.message c);
11
+
Alcotest.(check (list (Alcotest.testable Hash.pp Hash.equal)))
12
+
"no parents" [] (Commit.Git.parents c);
13
+
Alcotest.(check bool)
14
+
"tree matches" true
15
+
(Hash.equal tree_hash (Commit.Git.tree c))
16
+
17
+
let test_commit_committer () =
18
+
let tree_hash = Hash.sha1 "tree" in
19
+
let c =
20
+
Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~committer:"Bob"
21
+
~message:"test" ()
22
+
in
23
+
Alcotest.(check string) "committer" "Bob" (Commit.Git.committer c)
24
+
25
+
let test_commit_parents () =
26
+
let tree_hash = Hash.sha1 "tree" in
27
+
let parent1 = Hash.sha1 "parent1" in
28
+
let parent2 = Hash.sha1 "parent2" in
29
+
let c =
30
+
Commit.Git.v ~tree:tree_hash ~parents:[ parent1; parent2 ] ~author:"test"
31
+
~message:"merge" ()
32
+
in
33
+
Alcotest.(check int) "two parents" 2 (List.length (Commit.Git.parents c))
34
+
35
+
let test_commit_roundtrip () =
36
+
let tree_hash = Hash.sha1 "tree content" in
37
+
let c =
38
+
Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice"
39
+
~message:"test commit" ()
40
+
in
41
+
let bytes = Commit.Git.to_bytes c in
42
+
match Commit.Git.of_bytes bytes with
43
+
| Ok c' ->
44
+
Alcotest.(check string) "author roundtrip" "Alice" (Commit.Git.author c');
45
+
Alcotest.(check string)
46
+
"message roundtrip" "test commit" (Commit.Git.message c')
47
+
| Error (`Msg msg) -> Alcotest.fail msg
48
+
49
+
let test_commit_hash () =
50
+
let tree_hash = Hash.sha1 "tree" in
51
+
let c1 =
52
+
Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~message:"same"
53
+
~timestamp:1000L ()
54
+
in
55
+
let c2 =
56
+
Commit.Git.v ~tree:tree_hash ~parents:[] ~author:"Alice" ~message:"same"
57
+
~timestamp:1000L ()
58
+
in
59
+
Alcotest.(check bool)
60
+
"same content same hash" true
61
+
(Hash.equal (Commit.Git.hash c1) (Commit.Git.hash c2))
62
+
63
+
let suite =
64
+
( "Commit",
65
+
[
66
+
Alcotest.test_case "fields" `Quick test_commit_fields;
67
+
Alcotest.test_case "committer" `Quick test_commit_committer;
68
+
Alcotest.test_case "parents" `Quick test_commit_parents;
69
+
Alcotest.test_case "roundtrip" `Quick test_commit_roundtrip;
70
+
Alcotest.test_case "hash" `Quick test_commit_hash;
71
+
] )
+2
test/test_commit.mli
+2
test/test_commit.mli
+63
test/test_git_interop.ml
+63
test/test_git_interop.ml
···
1
+
open Irmin
2
+
3
+
let with_temp_dir f =
4
+
Eio_main.run @@ fun env ->
5
+
let fs = Eio.Stdenv.fs env in
6
+
let cwd = Eio.Stdenv.cwd env in
7
+
Eio.Switch.run @@ fun sw ->
8
+
let tmp_name = Printf.sprintf "irmin-git-test-%d" (Random.int 100000) in
9
+
let tmp_path = Eio.Path.(cwd / tmp_name) in
10
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path;
11
+
Fun.protect
12
+
~finally:(fun () ->
13
+
let rec rm path =
14
+
if Eio.Path.is_directory path then begin
15
+
List.iter
16
+
(fun name -> rm Eio.Path.(path / name))
17
+
(Eio.Path.read_dir path);
18
+
Eio.Path.rmdir path
19
+
end
20
+
else if Eio.Path.is_file path then Eio.Path.unlink path
21
+
in
22
+
rm tmp_path)
23
+
(fun () -> f ~sw ~fs tmp_path)
24
+
25
+
let test_init_git () =
26
+
with_temp_dir @@ fun ~sw ~fs tmp_path ->
27
+
let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in
28
+
let _store = Git_interop.init_git ~sw ~fs ~path:fpath in
29
+
(* Verify .git directory was created *)
30
+
let git_dir = Eio.Path.(tmp_path / ".git") in
31
+
Alcotest.(check bool) "git dir exists" true (Eio.Path.is_directory git_dir)
32
+
33
+
let test_write_read_object () =
34
+
with_temp_dir @@ fun ~sw ~fs tmp_path ->
35
+
let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in
36
+
let _store = Git_interop.init_git ~sw ~fs ~path:fpath in
37
+
let git_dir = Fpath.(fpath / ".git") in
38
+
let data = "hello world" in
39
+
let hash = Git_interop.write_object ~sw ~fs ~git_dir ~typ:"blob" data in
40
+
match Git_interop.read_object ~sw ~fs ~git_dir hash with
41
+
| Ok (typ, content) ->
42
+
Alcotest.(check string) "type" "blob" typ;
43
+
Alcotest.(check string) "content" data content
44
+
| Error (`Msg msg) -> Alcotest.fail msg
45
+
46
+
let test_write_read_ref () =
47
+
with_temp_dir @@ fun ~sw ~fs tmp_path ->
48
+
let fpath = Fpath.v (Eio.Path.native_exn tmp_path) in
49
+
let _store = Git_interop.init_git ~sw ~fs ~path:fpath in
50
+
let git_dir = Fpath.(fpath / ".git") in
51
+
let hash = Git_interop.write_object ~sw ~fs ~git_dir ~typ:"blob" "content" in
52
+
Git_interop.write_ref ~sw ~fs ~git_dir "refs/heads/test" hash;
53
+
match Git_interop.read_ref ~sw ~fs ~git_dir "refs/heads/test" with
54
+
| Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
55
+
| None -> Alcotest.fail "ref not found"
56
+
57
+
let suite =
58
+
( "Git_interop",
59
+
[
60
+
Alcotest.test_case "init git" `Quick test_init_git;
61
+
Alcotest.test_case "write/read object" `Quick test_write_read_object;
62
+
Alcotest.test_case "write/read ref" `Quick test_write_read_ref;
63
+
] )
+2
test/test_git_interop.mli
+2
test/test_git_interop.mli
+40
test/test_hash.ml
+40
test/test_hash.ml
···
1
+
open Irmin
2
+
3
+
let test_sha1_hash () =
4
+
let h = Hash.sha1 "hello" in
5
+
let hex = Hash.to_hex h in
6
+
Alcotest.(check string)
7
+
"sha1 hex length" (String.make 40 '0')
8
+
(String.make (String.length hex) '0');
9
+
Alcotest.(check int) "sha1 bytes length" 20 (String.length (Hash.to_bytes h))
10
+
11
+
let test_sha256_hash () =
12
+
let h = Hash.sha256 "hello" in
13
+
let hex = Hash.to_hex h in
14
+
Alcotest.(check string)
15
+
"sha256 hex length" (String.make 64 '0')
16
+
(String.make (String.length hex) '0');
17
+
Alcotest.(check int)
18
+
"sha256 bytes length" 32
19
+
(String.length (Hash.to_bytes h))
20
+
21
+
let test_hash_roundtrip () =
22
+
let h1 = Hash.sha1 "test data" in
23
+
let hex = Hash.to_hex h1 in
24
+
match Hash.sha1_of_hex hex with
25
+
| Ok h2 -> Alcotest.(check bool) "roundtrip" true (Hash.equal h1 h2)
26
+
| Error (`Msg msg) -> Alcotest.fail msg
27
+
28
+
let test_mst_depth () =
29
+
let h = Hash.sha256 "test" in
30
+
let depth = Hash.mst_depth h in
31
+
Alcotest.(check bool) "depth >= 0" true (depth >= 0)
32
+
33
+
let suite =
34
+
( "Hash",
35
+
[
36
+
Alcotest.test_case "sha1 hash" `Quick test_sha1_hash;
37
+
Alcotest.test_case "sha256 hash" `Quick test_sha256_hash;
38
+
Alcotest.test_case "hash roundtrip" `Quick test_hash_roundtrip;
39
+
Alcotest.test_case "mst depth" `Quick test_mst_depth;
40
+
] )
+2
test/test_hash.mli
+2
test/test_hash.mli
-549
test/test_irmin.ml
-549
test/test_irmin.ml
···
1
-
open Irmin
2
-
3
-
(* Hash tests *)
4
-
let test_sha1_hash () =
5
-
let h = Hash.sha1 "hello" in
6
-
let hex = Hash.to_hex h in
7
-
Alcotest.(check string)
8
-
"sha1 hex length" (String.make 40 '0')
9
-
(String.make (String.length hex) '0');
10
-
Alcotest.(check int) "sha1 bytes length" 20 (String.length (Hash.to_bytes h))
11
-
12
-
let test_sha256_hash () =
13
-
let h = Hash.sha256 "hello" in
14
-
let hex = Hash.to_hex h in
15
-
Alcotest.(check string)
16
-
"sha256 hex length" (String.make 64 '0')
17
-
(String.make (String.length hex) '0');
18
-
Alcotest.(check int)
19
-
"sha256 bytes length" 32
20
-
(String.length (Hash.to_bytes h))
21
-
22
-
let test_hash_roundtrip () =
23
-
let h1 = Hash.sha1 "test data" in
24
-
let hex = Hash.to_hex h1 in
25
-
match Hash.sha1_of_hex hex with
26
-
| Ok h2 -> Alcotest.(check bool) "roundtrip" true (Hash.equal h1 h2)
27
-
| Error (`Msg msg) -> Alcotest.fail msg
28
-
29
-
let test_mst_depth () =
30
-
(* Test MST depth calculation *)
31
-
let h = Hash.sha256 "test" in
32
-
let depth = Hash.mst_depth h in
33
-
Alcotest.(check bool) "depth >= 0" true (depth >= 0)
34
-
35
-
(* Tree tests *)
36
-
let test_empty_tree () =
37
-
let tree = Tree.Git.empty () in
38
-
Alcotest.(check (option string))
39
-
"find empty" None
40
-
(Tree.Git.find tree [ "foo" ])
41
-
42
-
let test_tree_add_find () =
43
-
let tree = Tree.Git.empty () in
44
-
let tree = Tree.Git.add tree [ "foo"; "bar" ] "content" in
45
-
Alcotest.(check (option string))
46
-
"find added" (Some "content")
47
-
(Tree.Git.find tree [ "foo"; "bar" ])
48
-
49
-
let test_tree_remove () =
50
-
let tree = Tree.Git.empty () in
51
-
let tree = Tree.Git.add tree [ "foo" ] "content" in
52
-
let tree = Tree.Git.remove tree [ "foo" ] in
53
-
Alcotest.(check (option string))
54
-
"find removed" None
55
-
(Tree.Git.find tree [ "foo" ])
56
-
57
-
let test_tree_overwrite () =
58
-
let tree = Tree.Git.empty () in
59
-
let tree = Tree.Git.add tree [ "key" ] "value1" in
60
-
let tree = Tree.Git.add tree [ "key" ] "value2" in
61
-
Alcotest.(check (option string))
62
-
"find overwritten" (Some "value2")
63
-
(Tree.Git.find tree [ "key" ])
64
-
65
-
let test_tree_nested () =
66
-
let tree = Tree.Git.empty () in
67
-
let tree = Tree.Git.add tree [ "a"; "b"; "c" ] "deep" in
68
-
let tree = Tree.Git.add tree [ "a"; "x" ] "shallow" in
69
-
Alcotest.(check (option string))
70
-
"find deep" (Some "deep")
71
-
(Tree.Git.find tree [ "a"; "b"; "c" ]);
72
-
Alcotest.(check (option string))
73
-
"find shallow" (Some "shallow")
74
-
(Tree.Git.find tree [ "a"; "x" ])
75
-
76
-
(* Backend tests *)
77
-
let test_memory_backend () =
78
-
let backend = Backend.Memory.create_sha1 () in
79
-
let data = "test content" in
80
-
let hash = Hash.sha1 data in
81
-
backend.write hash data;
82
-
Alcotest.(check (option string)) "read back" (Some data) (backend.read hash)
83
-
84
-
let test_backend_refs () =
85
-
let backend = Backend.Memory.create_sha1 () in
86
-
let data = "content" in
87
-
let hash = Hash.sha1 data in
88
-
backend.write hash data;
89
-
backend.set_ref "refs/heads/main" hash;
90
-
Alcotest.(check bool)
91
-
"ref exists" true
92
-
(Option.is_some (backend.get_ref "refs/heads/main"));
93
-
match backend.get_ref "refs/heads/main" with
94
-
| Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
95
-
| None -> Alcotest.fail "ref not found"
96
-
97
-
let test_backend_test_and_set () =
98
-
let backend = Backend.Memory.create_sha1 () in
99
-
let h1 = Hash.sha1 "content1" in
100
-
let h2 = Hash.sha1 "content2" in
101
-
backend.write h1 "content1";
102
-
backend.write h2 "content2";
103
-
backend.set_ref "ref" h1;
104
-
105
-
(* Should fail with wrong test value *)
106
-
let result = backend.test_and_set_ref "ref" ~test:(Some h2) ~set:(Some h2) in
107
-
Alcotest.(check bool) "wrong test fails" false result;
108
-
109
-
(* Should succeed with correct test value *)
110
-
let result = backend.test_and_set_ref "ref" ~test:(Some h1) ~set:(Some h2) in
111
-
Alcotest.(check bool) "correct test succeeds" true result
112
-
113
-
(* Disk backend tests *)
114
-
let with_temp_dir f =
115
-
Eio_main.run @@ fun env ->
116
-
let fs = Eio.Stdenv.fs env in
117
-
let cwd = Eio.Stdenv.cwd env in
118
-
Eio.Switch.run @@ fun sw ->
119
-
let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
120
-
let tmp_path = Eio.Path.(cwd / tmp_name) in
121
-
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_path;
122
-
Fun.protect
123
-
~finally:(fun () ->
124
-
(* Clean up temp directory *)
125
-
let rec rm path =
126
-
if Eio.Path.is_directory path then begin
127
-
List.iter
128
-
(fun name -> rm Eio.Path.(path / name))
129
-
(Eio.Path.read_dir path);
130
-
Eio.Path.rmdir path
131
-
end
132
-
else if Eio.Path.is_file path then Eio.Path.unlink path
133
-
in
134
-
rm tmp_path)
135
-
(fun () -> f ~sw ~fs tmp_path)
136
-
137
-
let test_disk_backend () =
138
-
with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
139
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
140
-
let data = "test content" in
141
-
let hash = Hash.sha1 data in
142
-
backend.write hash data;
143
-
Alcotest.(check (option string)) "read back" (Some data) (backend.read hash);
144
-
backend.close ()
145
-
146
-
let test_disk_backend_persistence () =
147
-
Eio_main.run @@ fun env ->
148
-
let cwd = Eio.Stdenv.cwd env in
149
-
let tmp_name = Printf.sprintf "irmin-test-%d" (Random.int 100000) in
150
-
let tmp_path = Eio.Path.(cwd / tmp_name) in
151
-
let data = "persistent content" in
152
-
let hash = Hash.sha1 data in
153
-
(* Write and close *)
154
-
Eio.Switch.run (fun sw ->
155
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
156
-
backend.write hash data;
157
-
backend.set_ref "refs/heads/main" hash;
158
-
backend.flush ();
159
-
backend.close ());
160
-
(* Reopen and read *)
161
-
Eio.Switch.run (fun sw ->
162
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
163
-
Alcotest.(check (option string))
164
-
"read after reopen" (Some data) (backend.read hash);
165
-
Alcotest.(check bool)
166
-
"ref persisted" true
167
-
(Option.is_some (backend.get_ref "refs/heads/main"));
168
-
backend.close ());
169
-
(* Clean up *)
170
-
let rec rm path =
171
-
if Eio.Path.is_directory path then begin
172
-
List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
173
-
Eio.Path.rmdir path
174
-
end
175
-
else if Eio.Path.is_file path then Eio.Path.unlink path
176
-
in
177
-
rm tmp_path
178
-
179
-
let test_disk_backend_refs () =
180
-
with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
181
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
182
-
let data = "content" in
183
-
let hash = Hash.sha1 data in
184
-
backend.write hash data;
185
-
backend.set_ref "refs/heads/main" hash;
186
-
Alcotest.(check bool)
187
-
"ref exists" true
188
-
(Option.is_some (backend.get_ref "refs/heads/main"));
189
-
(match backend.get_ref "refs/heads/main" with
190
-
| Some h -> Alcotest.(check bool) "ref matches" true (Hash.equal hash h)
191
-
| None -> Alcotest.fail "ref not found");
192
-
backend.close ()
193
-
194
-
let test_disk_backend_write_batch () =
195
-
with_temp_dir @@ fun ~sw ~fs:_ tmp_path ->
196
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
197
-
let objects =
198
-
[
199
-
(Hash.sha1 "data1", "data1");
200
-
(Hash.sha1 "data2", "data2");
201
-
(Hash.sha1 "data3", "data3");
202
-
]
203
-
in
204
-
backend.write_batch objects;
205
-
List.iter
206
-
(fun (hash, data) ->
207
-
Alcotest.(check (option string))
208
-
"batch item" (Some data) (backend.read hash))
209
-
objects;
210
-
backend.close ()
211
-
212
-
let test_disk_backend_wal_recovery () =
213
-
(* Test WAL crash recovery: write without flush, reopen, verify data *)
214
-
Eio_main.run @@ fun env ->
215
-
let cwd = Eio.Stdenv.cwd env in
216
-
let tmp_name = Printf.sprintf "irmin-wal-test-%d" (Random.int 100000) in
217
-
let tmp_path = Eio.Path.(cwd / tmp_name) in
218
-
let data = "wal recovery content" in
219
-
let hash = Hash.sha1 data in
220
-
(* Write but DON'T flush - simulates crash before checkpoint *)
221
-
Eio.Switch.run (fun sw ->
222
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
223
-
backend.write hash data;
224
-
(* Verify it's readable in current session *)
225
-
Alcotest.(check (option string))
226
-
"readable before crash" (Some data) (backend.read hash);
227
-
(* Close without flush - WAL should still have the entry *)
228
-
backend.close ());
229
-
(* Reopen - should replay WAL and recover the data *)
230
-
Eio.Switch.run (fun sw ->
231
-
let backend = Backend.Disk.create_sha1 ~sw tmp_path in
232
-
Alcotest.(check (option string))
233
-
"recovered from WAL" (Some data) (backend.read hash);
234
-
(* Bloom filter should also have the entry *)
235
-
Alcotest.(check bool) "exists after recovery" true (backend.exists hash);
236
-
backend.close ());
237
-
(* Clean up *)
238
-
let rec rm path =
239
-
if Eio.Path.is_directory path then begin
240
-
List.iter (fun name -> rm Eio.Path.(path / name)) (Eio.Path.read_dir path);
241
-
Eio.Path.rmdir path
242
-
end
243
-
else if Eio.Path.is_file path then Eio.Path.unlink path
244
-
in
245
-
rm tmp_path
246
-
247
-
(* Store tests *)
248
-
let test_store_commit () =
249
-
let backend = Backend.Memory.create_sha1 () in
250
-
let store = Store.Git.create ~backend in
251
-
let tree = Tree.Git.empty () in
252
-
let tree = Tree.Git.add tree [ "README.md" ] "# Hello" in
253
-
let hash =
254
-
Store.Git.commit store ~tree ~parents:[] ~message:"Initial commit"
255
-
~author:"test"
256
-
in
257
-
Alcotest.(check bool) "commit hash exists" true (backend.exists hash)
258
-
259
-
let test_store_branches () =
260
-
let backend = Backend.Memory.create_sha1 () in
261
-
let store = Store.Git.create ~backend in
262
-
let tree = Tree.Git.empty () in
263
-
let hash =
264
-
Store.Git.commit store ~tree ~parents:[] ~message:"test" ~author:"test"
265
-
in
266
-
Store.Git.set_head store ~branch:"main" hash;
267
-
let branches = Store.Git.branches store in
268
-
Alcotest.(check (list string)) "branches" [ "main" ] branches
269
-
270
-
(* Tree format tests *)
271
-
let test_git_tree_format () =
272
-
let node = Codec.Git.empty_node in
273
-
Alcotest.(check bool) "empty is empty" true (Codec.Git.is_empty node);
274
-
let h = Hash.sha1 "content" in
275
-
let node = Codec.Git.add node "file.txt" (`Contents h) in
276
-
Alcotest.(check bool) "not empty after add" false (Codec.Git.is_empty node);
277
-
match Codec.Git.find node "file.txt" with
278
-
| Some (`Contents h') ->
279
-
Alcotest.(check bool) "find matches" true (Hash.equal h h')
280
-
| _ -> Alcotest.fail "entry not found"
281
-
282
-
let test_git_tree_serialization () =
283
-
let h = Hash.sha1 "content" in
284
-
let node = Codec.Git.empty_node in
285
-
let node = Codec.Git.add node "file.txt" (`Contents h) in
286
-
let bytes = Codec.Git.bytes_of_node node in
287
-
match Codec.Git.node_of_bytes bytes with
288
-
| Ok node' ->
289
-
let entries = Codec.Git.list node' in
290
-
Alcotest.(check int) "one entry" 1 (List.length entries)
291
-
| Error (`Msg msg) -> Alcotest.fail msg
292
-
293
-
(* Test suites *)
294
-
let hash_tests =
295
-
[
296
-
Alcotest.test_case "sha1 hash" `Quick test_sha1_hash;
297
-
Alcotest.test_case "sha256 hash" `Quick test_sha256_hash;
298
-
Alcotest.test_case "hash roundtrip" `Quick test_hash_roundtrip;
299
-
Alcotest.test_case "mst depth" `Quick test_mst_depth;
300
-
]
301
-
302
-
let tree_tests =
303
-
[
304
-
Alcotest.test_case "empty tree" `Quick test_empty_tree;
305
-
Alcotest.test_case "tree add/find" `Quick test_tree_add_find;
306
-
Alcotest.test_case "tree remove" `Quick test_tree_remove;
307
-
Alcotest.test_case "tree overwrite" `Quick test_tree_overwrite;
308
-
Alcotest.test_case "tree nested" `Quick test_tree_nested;
309
-
]
310
-
311
-
let backend_tests =
312
-
[
313
-
Alcotest.test_case "memory backend" `Quick test_memory_backend;
314
-
Alcotest.test_case "backend refs" `Quick test_backend_refs;
315
-
Alcotest.test_case "backend test_and_set" `Quick test_backend_test_and_set;
316
-
Alcotest.test_case "disk backend" `Quick test_disk_backend;
317
-
Alcotest.test_case "disk backend persistence" `Quick
318
-
test_disk_backend_persistence;
319
-
Alcotest.test_case "disk backend refs" `Quick test_disk_backend_refs;
320
-
Alcotest.test_case "disk backend write_batch" `Quick
321
-
test_disk_backend_write_batch;
322
-
Alcotest.test_case "disk backend WAL recovery" `Quick
323
-
test_disk_backend_wal_recovery;
324
-
]
325
-
326
-
let test_store_diff () =
327
-
let backend = Backend.Memory.create_sha1 () in
328
-
let store = Store.Git.create ~backend in
329
-
(* Create first commit with two files *)
330
-
let tree1 = Tree.Git.empty () in
331
-
let tree1 = Tree.Git.add tree1 [ "file1.txt" ] "content1" in
332
-
let tree1 = Tree.Git.add tree1 [ "file2.txt" ] "content2" in
333
-
let hash1 = Tree.Git.hash tree1 ~backend in
334
-
(* Create second tree: modify file1, remove file2, add file3 *)
335
-
let tree2 = Tree.Git.empty () in
336
-
let tree2 = Tree.Git.add tree2 [ "file1.txt" ] "modified1" in
337
-
let tree2 = Tree.Git.add tree2 [ "file3.txt" ] "content3" in
338
-
let hash2 = Tree.Git.hash tree2 ~backend in
339
-
(* Compute diff *)
340
-
let changes = Store.Git.diff store ~old:hash1 ~new_:hash2 |> List.of_seq in
341
-
(* Check we have the expected changes *)
342
-
let has_remove_file2 =
343
-
List.exists
344
-
(function `Remove [ "file2.txt" ] -> true | _ -> false)
345
-
changes
346
-
in
347
-
let has_add_file3 =
348
-
List.exists
349
-
(function `Add ([ "file3.txt" ], _) -> true | _ -> false)
350
-
changes
351
-
in
352
-
let has_change_file1 =
353
-
List.exists
354
-
(function `Change ([ "file1.txt" ], _, _) -> true | _ -> false)
355
-
changes
356
-
in
357
-
Alcotest.(check bool) "file2 removed" true has_remove_file2;
358
-
Alcotest.(check bool) "file3 added" true has_add_file3;
359
-
Alcotest.(check bool) "file1 changed" true has_change_file1
360
-
361
-
let store_tests =
362
-
[
363
-
Alcotest.test_case "store commit" `Quick test_store_commit;
364
-
Alcotest.test_case "store branches" `Quick test_store_branches;
365
-
Alcotest.test_case "store diff" `Quick test_store_diff;
366
-
]
367
-
368
-
let tree_format_tests =
369
-
[
370
-
Alcotest.test_case "git tree format" `Quick test_git_tree_format;
371
-
Alcotest.test_case "git tree serialization" `Quick
372
-
test_git_tree_serialization;
373
-
]
374
-
375
-
(* Link tests *)
376
-
let test_link_v_get () =
377
-
let s = Link.Mst.v () in
378
-
let l = Link.v s 42 in
379
-
Alcotest.(check int) "get (v s x) = x" 42 (Link.get l)
380
-
381
-
let test_link_is_val () =
382
-
let s = Link.Mst.v () in
383
-
let l = Link.v s "hello" in
384
-
Alcotest.(check bool) "in-memory is_val" true (Link.is_val l)
385
-
386
-
let test_link_equal () =
387
-
let s = Link.Mst.v () in
388
-
let l0 = Link.v s [ 1; 2; 3 ] in
389
-
let l1 = Link.v s [ 1; 2; 3 ] in
390
-
let l2 = Link.v s [ 1; 2; 4 ] in
391
-
Alcotest.(check bool) "same value equal" true (Link.equal l0 l1);
392
-
Alcotest.(check bool) "diff value not equal" false (Link.equal l0 l2)
393
-
394
-
let test_link_address () =
395
-
let s = Link.Mst.v () in
396
-
let l0 = Link.v s "test" in
397
-
let l1 = Link.v s "test" in
398
-
Alcotest.(check bool) "same address" true (Link.address l0 = Link.address l1)
399
-
400
-
let test_link_pp () =
401
-
let s = Link.Mst.v () in
402
-
let l = Link.v s "test" in
403
-
let _ = Link.address l in
404
-
(* force address computation *)
405
-
let str = Format.asprintf "%a" Link.pp l in
406
-
Alcotest.(check int) "pp is 7 chars" 7 (String.length str)
407
-
408
-
let test_link_read_write () =
409
-
let s : int Link.store = Link.Mst.v () in
410
-
Link.write s 42;
411
-
Alcotest.(check int) "after write" 42 (Link.read s);
412
-
Link.write s 100;
413
-
Alcotest.(check int) "after second write" 100 (Link.read s)
414
-
415
-
let test_link_is_open () =
416
-
let s = Link.Mst.v () in
417
-
Alcotest.(check bool) "initially open" true (Link.is_open s);
418
-
Link.close s;
419
-
Alcotest.(check bool) "closed after close" false (Link.is_open s)
420
-
421
-
(* Tree types for the tree example test *)
422
-
type test_tree = test_node Link.t
423
-
and test_node = TEmpty | TNode of { l : test_tree; x : int; r : test_tree }
424
-
425
-
let test_link_tree () =
426
-
let s = Link.Mst.v () in
427
-
let empty = Link.v s TEmpty in
428
-
let leaf x = Link.v s (TNode { l = empty; x; r = empty }) in
429
-
let node l x r = Link.v s (TNode { l; x; r }) in
430
-
let t = node (leaf 1) 2 (leaf 3) in
431
-
match Link.get t with
432
-
| TEmpty -> Alcotest.fail "expected node"
433
-
| TNode n -> (
434
-
Alcotest.(check int) "root" 2 n.x;
435
-
match (Link.get n.l, Link.get n.r) with
436
-
| TNode l, TNode r ->
437
-
Alcotest.(check int) "left" 1 l.x;
438
-
Alcotest.(check int) "right" 3 r.x
439
-
| _ -> Alcotest.fail "expected leaves")
440
-
441
-
let link_tests =
442
-
[
443
-
Alcotest.test_case "v/get" `Quick test_link_v_get;
444
-
Alcotest.test_case "is_val" `Quick test_link_is_val;
445
-
Alcotest.test_case "equal" `Quick test_link_equal;
446
-
Alcotest.test_case "address" `Quick test_link_address;
447
-
Alcotest.test_case "pp" `Quick test_link_pp;
448
-
Alcotest.test_case "read/write" `Quick test_link_read_write;
449
-
Alcotest.test_case "is_open" `Quick test_link_is_open;
450
-
Alcotest.test_case "tree" `Quick test_link_tree;
451
-
]
452
-
453
-
(* Proof tests *)
454
-
let test_proof_produce_verify () =
455
-
let backend = Backend.Memory.create_sha1 () in
456
-
(* Build a tree: foo/bar = "hello", foo/baz = "world" *)
457
-
let tree = Tree.Git.empty () in
458
-
let tree = Tree.Git.add tree [ "foo"; "bar" ] "hello" in
459
-
let tree = Tree.Git.add tree [ "foo"; "baz" ] "world" in
460
-
let root_hash = Tree.Git.hash tree ~backend in
461
-
(* Produce a proof that only accesses foo/bar *)
462
-
let proof, result =
463
-
Proof.Git.produce backend root_hash (fun t ->
464
-
let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
465
-
(t, v))
466
-
in
467
-
Alcotest.(check (option string)) "found value" (Some "hello") result;
468
-
(* Verify the proof *)
469
-
match
470
-
Proof.Git.verify proof (fun t ->
471
-
let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
472
-
(t, v))
473
-
with
474
-
| Ok (_, v) ->
475
-
Alcotest.(check (option string)) "verified value" (Some "hello") v
476
-
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
477
-
478
-
let test_proof_blinded () =
479
-
let backend = Backend.Memory.create_sha1 () in
480
-
let tree = Tree.Git.empty () in
481
-
let tree = Tree.Git.add tree [ "a" ] "1" in
482
-
let tree = Tree.Git.add tree [ "b" ] "2" in
483
-
let root_hash = Tree.Git.hash tree ~backend in
484
-
(* Only access "a", "b" should be blinded *)
485
-
let proof, _ =
486
-
Proof.Git.produce backend root_hash (fun t ->
487
-
let _ = Proof.Git.Tree.find t [ "a" ] in
488
-
(t, ()))
489
-
in
490
-
(* Check proof state has blinded nodes *)
491
-
let state = Proof.state proof in
492
-
match state with
493
-
| Proof.Node entries ->
494
-
let has_a =
495
-
List.exists
496
-
(fun (k, v) ->
497
-
k = "a" && match v with Proof.Contents "1" -> true | _ -> false)
498
-
entries
499
-
in
500
-
let has_blinded_b =
501
-
List.exists
502
-
(fun (k, v) ->
503
-
k = "b"
504
-
&& match v with Proof.Blinded_contents _ -> true | _ -> false)
505
-
entries
506
-
in
507
-
Alcotest.(check bool) "has a" true has_a;
508
-
Alcotest.(check bool) "b is blinded" true has_blinded_b
509
-
| _ -> Alcotest.fail "expected Node"
510
-
511
-
let test_proof_mst () =
512
-
let backend = Backend.Memory.create_sha256 () in
513
-
let tree = Tree.Mst.empty () in
514
-
let tree = Tree.Mst.add tree [ "key1" ] "value1" in
515
-
let tree = Tree.Mst.add tree [ "key2" ] "value2" in
516
-
let root_hash = Tree.Mst.hash tree ~backend in
517
-
let proof, result =
518
-
Proof.Mst.produce backend root_hash (fun t ->
519
-
let v = Proof.Mst.Tree.find t [ "key1" ] in
520
-
(t, v))
521
-
in
522
-
Alcotest.(check (option string)) "found value" (Some "value1") result;
523
-
match
524
-
Proof.Mst.verify proof (fun t ->
525
-
let v = Proof.Mst.Tree.find t [ "key1" ] in
526
-
(t, v))
527
-
with
528
-
| Ok (_, v) ->
529
-
Alcotest.(check (option string)) "verified value" (Some "value1") v
530
-
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
531
-
532
-
let proof_tests =
533
-
[
534
-
Alcotest.test_case "produce/verify" `Quick test_proof_produce_verify;
535
-
Alcotest.test_case "blinded nodes" `Quick test_proof_blinded;
536
-
Alcotest.test_case "mst proofs" `Quick test_proof_mst;
537
-
]
538
-
539
-
let () =
540
-
Alcotest.run "Irmin"
541
-
[
542
-
("Hash", hash_tests);
543
-
("Tree", tree_tests);
544
-
("Backend", backend_tests);
545
-
("Store", store_tests);
546
-
("Codec", tree_format_tests);
547
-
("Link", link_tests);
548
-
("Proof", proof_tests);
549
-
]
+77
test/test_link.ml
+77
test/test_link.ml
···
1
+
open Irmin
2
+
3
+
let test_link_v_get () =
4
+
let s = Link.Mst.v () in
5
+
let l = Link.v s 42 in
6
+
Alcotest.(check int) "get (v s x) = x" 42 (Link.get l)
7
+
8
+
let test_link_is_val () =
9
+
let s = Link.Mst.v () in
10
+
let l = Link.v s "hello" in
11
+
Alcotest.(check bool) "in-memory is_val" true (Link.is_val l)
12
+
13
+
let test_link_equal () =
14
+
let s = Link.Mst.v () in
15
+
let l0 = Link.v s [ 1; 2; 3 ] in
16
+
let l1 = Link.v s [ 1; 2; 3 ] in
17
+
let l2 = Link.v s [ 1; 2; 4 ] in
18
+
Alcotest.(check bool) "same value equal" true (Link.equal l0 l1);
19
+
Alcotest.(check bool) "diff value not equal" false (Link.equal l0 l2)
20
+
21
+
let test_link_address () =
22
+
let s = Link.Mst.v () in
23
+
let l0 = Link.v s "test" in
24
+
let l1 = Link.v s "test" in
25
+
Alcotest.(check bool) "same address" true (Link.address l0 = Link.address l1)
26
+
27
+
let test_link_pp () =
28
+
let s = Link.Mst.v () in
29
+
let l = Link.v s "test" in
30
+
let _ = Link.address l in
31
+
let str = Format.asprintf "%a" Link.pp l in
32
+
Alcotest.(check int) "pp is 7 chars" 7 (String.length str)
33
+
34
+
let test_link_read_write () =
35
+
let s : int Link.store = Link.Mst.v () in
36
+
Link.write s 42;
37
+
Alcotest.(check int) "after write" 42 (Link.read s);
38
+
Link.write s 100;
39
+
Alcotest.(check int) "after second write" 100 (Link.read s)
40
+
41
+
let test_link_is_open () =
42
+
let s = Link.Mst.v () in
43
+
Alcotest.(check bool) "initially open" true (Link.is_open s);
44
+
Link.close s;
45
+
Alcotest.(check bool) "closed after close" false (Link.is_open s)
46
+
47
+
type test_tree = test_node Link.t
48
+
and test_node = TEmpty | TNode of { l : test_tree; x : int; r : test_tree }
49
+
50
+
let test_link_tree () =
51
+
let s = Link.Mst.v () in
52
+
let empty = Link.v s TEmpty in
53
+
let leaf x = Link.v s (TNode { l = empty; x; r = empty }) in
54
+
let node l x r = Link.v s (TNode { l; x; r }) in
55
+
let t = node (leaf 1) 2 (leaf 3) in
56
+
match Link.get t with
57
+
| TEmpty -> Alcotest.fail "expected node"
58
+
| TNode n -> (
59
+
Alcotest.(check int) "root" 2 n.x;
60
+
match (Link.get n.l, Link.get n.r) with
61
+
| TNode l, TNode r ->
62
+
Alcotest.(check int) "left" 1 l.x;
63
+
Alcotest.(check int) "right" 3 r.x
64
+
| _ -> Alcotest.fail "expected leaves")
65
+
66
+
let suite =
67
+
( "Link",
68
+
[
69
+
Alcotest.test_case "v/get" `Quick test_link_v_get;
70
+
Alcotest.test_case "is_val" `Quick test_link_is_val;
71
+
Alcotest.test_case "equal" `Quick test_link_equal;
72
+
Alcotest.test_case "address" `Quick test_link_address;
73
+
Alcotest.test_case "pp" `Quick test_link_pp;
74
+
Alcotest.test_case "read/write" `Quick test_link_read_write;
75
+
Alcotest.test_case "is_open" `Quick test_link_is_open;
76
+
Alcotest.test_case "tree" `Quick test_link_tree;
77
+
] )
+2
test/test_link.mli
+2
test/test_link.mli
+82
test/test_proof.ml
+82
test/test_proof.ml
···
1
+
open Irmin
2
+
3
+
let test_proof_produce_verify () =
4
+
let backend = Backend.Memory.create_sha1 () in
5
+
let tree = Tree.Git.empty () in
6
+
let tree = Tree.Git.add tree [ "foo"; "bar" ] "hello" in
7
+
let tree = Tree.Git.add tree [ "foo"; "baz" ] "world" in
8
+
let root_hash = Tree.Git.hash tree ~backend in
9
+
let proof, result =
10
+
Proof.Git.produce backend root_hash (fun t ->
11
+
let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
12
+
(t, v))
13
+
in
14
+
Alcotest.(check (option string)) "found value" (Some "hello") result;
15
+
match
16
+
Proof.Git.verify proof (fun t ->
17
+
let v = Proof.Git.Tree.find t [ "foo"; "bar" ] in
18
+
(t, v))
19
+
with
20
+
| Ok (_, v) ->
21
+
Alcotest.(check (option string)) "verified value" (Some "hello") v
22
+
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
23
+
24
+
let test_proof_blinded () =
25
+
let backend = Backend.Memory.create_sha1 () in
26
+
let tree = Tree.Git.empty () in
27
+
let tree = Tree.Git.add tree [ "a" ] "1" in
28
+
let tree = Tree.Git.add tree [ "b" ] "2" in
29
+
let root_hash = Tree.Git.hash tree ~backend in
30
+
let proof, _ =
31
+
Proof.Git.produce backend root_hash (fun t ->
32
+
let _ = Proof.Git.Tree.find t [ "a" ] in
33
+
(t, ()))
34
+
in
35
+
let state = Proof.state proof in
36
+
match state with
37
+
| Proof.Node entries ->
38
+
let has_a =
39
+
List.exists
40
+
(fun (k, v) ->
41
+
k = "a" && match v with Proof.Contents "1" -> true | _ -> false)
42
+
entries
43
+
in
44
+
let has_blinded_b =
45
+
List.exists
46
+
(fun (k, v) ->
47
+
k = "b"
48
+
&& match v with Proof.Blinded_contents _ -> true | _ -> false)
49
+
entries
50
+
in
51
+
Alcotest.(check bool) "has a" true has_a;
52
+
Alcotest.(check bool) "b is blinded" true has_blinded_b
53
+
| _ -> Alcotest.fail "expected Node"
54
+
55
+
let test_proof_mst () =
56
+
let backend = Backend.Memory.create_sha256 () in
57
+
let tree = Tree.Mst.empty () in
58
+
let tree = Tree.Mst.add tree [ "key1" ] "value1" in
59
+
let tree = Tree.Mst.add tree [ "key2" ] "value2" in
60
+
let root_hash = Tree.Mst.hash tree ~backend in
61
+
let proof, result =
62
+
Proof.Mst.produce backend root_hash (fun t ->
63
+
let v = Proof.Mst.Tree.find t [ "key1" ] in
64
+
(t, v))
65
+
in
66
+
Alcotest.(check (option string)) "found value" (Some "value1") result;
67
+
match
68
+
Proof.Mst.verify proof (fun t ->
69
+
let v = Proof.Mst.Tree.find t [ "key1" ] in
70
+
(t, v))
71
+
with
72
+
| Ok (_, v) ->
73
+
Alcotest.(check (option string)) "verified value" (Some "value1") v
74
+
| Error (`Proof_mismatch msg) -> Alcotest.fail ("proof mismatch: " ^ msg)
75
+
76
+
let suite =
77
+
( "Proof",
78
+
[
79
+
Alcotest.test_case "produce/verify" `Quick test_proof_produce_verify;
80
+
Alcotest.test_case "blinded nodes" `Quick test_proof_blinded;
81
+
Alcotest.test_case "mst proofs" `Quick test_proof_mst;
82
+
] )
+2
test/test_proof.mli
+2
test/test_proof.mli
+62
test/test_store.ml
+62
test/test_store.ml
···
1
+
open Irmin
2
+
3
+
let test_store_commit () =
4
+
let backend = Backend.Memory.create_sha1 () in
5
+
let store = Store.Git.create ~backend in
6
+
let tree = Tree.Git.empty () in
7
+
let tree = Tree.Git.add tree [ "README.md" ] "# Hello" in
8
+
let hash =
9
+
Store.Git.commit store ~tree ~parents:[] ~message:"Initial commit"
10
+
~author:"test"
11
+
in
12
+
Alcotest.(check bool) "commit hash exists" true (backend.exists hash)
13
+
14
+
let test_store_branches () =
15
+
let backend = Backend.Memory.create_sha1 () in
16
+
let store = Store.Git.create ~backend in
17
+
let tree = Tree.Git.empty () in
18
+
let hash =
19
+
Store.Git.commit store ~tree ~parents:[] ~message:"test" ~author:"test"
20
+
in
21
+
Store.Git.set_head store ~branch:"main" hash;
22
+
let branches = Store.Git.branches store in
23
+
Alcotest.(check (list string)) "branches" [ "main" ] branches
24
+
25
+
let test_store_diff () =
26
+
let backend = Backend.Memory.create_sha1 () in
27
+
let store = Store.Git.create ~backend in
28
+
let tree1 = Tree.Git.empty () in
29
+
let tree1 = Tree.Git.add tree1 [ "file1.txt" ] "content1" in
30
+
let tree1 = Tree.Git.add tree1 [ "file2.txt" ] "content2" in
31
+
let hash1 = Tree.Git.hash tree1 ~backend in
32
+
let tree2 = Tree.Git.empty () in
33
+
let tree2 = Tree.Git.add tree2 [ "file1.txt" ] "modified1" in
34
+
let tree2 = Tree.Git.add tree2 [ "file3.txt" ] "content3" in
35
+
let hash2 = Tree.Git.hash tree2 ~backend in
36
+
let changes = Store.Git.diff store ~old:hash1 ~new_:hash2 |> List.of_seq in
37
+
let has_remove_file2 =
38
+
List.exists
39
+
(function `Remove [ "file2.txt" ] -> true | _ -> false)
40
+
changes
41
+
in
42
+
let has_add_file3 =
43
+
List.exists
44
+
(function `Add ([ "file3.txt" ], _) -> true | _ -> false)
45
+
changes
46
+
in
47
+
let has_change_file1 =
48
+
List.exists
49
+
(function `Change ([ "file1.txt" ], _, _) -> true | _ -> false)
50
+
changes
51
+
in
52
+
Alcotest.(check bool) "file2 removed" true has_remove_file2;
53
+
Alcotest.(check bool) "file3 added" true has_add_file3;
54
+
Alcotest.(check bool) "file1 changed" true has_change_file1
55
+
56
+
let suite =
57
+
( "Store",
58
+
[
59
+
Alcotest.test_case "store commit" `Quick test_store_commit;
60
+
Alcotest.test_case "store branches" `Quick test_store_branches;
61
+
Alcotest.test_case "store diff" `Quick test_store_diff;
62
+
] )
+2
test/test_store.mli
+2
test/test_store.mli
+43
test/test_subtree.ml
+43
test/test_subtree.ml
···
1
+
open Irmin
2
+
3
+
let test_split () =
4
+
let backend = Backend.Memory.create_sha1 () in
5
+
let store = Store.Git.create ~backend in
6
+
let tree = Tree.Git.empty () in
7
+
let tree = Tree.Git.add tree [ "sub"; "file.txt" ] "content" in
8
+
let tree = Tree.Git.add tree [ "other.txt" ] "other" in
9
+
let _hash =
10
+
Store.Git.commit store ~tree ~parents:[] ~message:"initial" ~author:"test"
11
+
in
12
+
(* split should produce a store without crashing *)
13
+
let _sub_store = Subtree.Git.split store ~prefix:[ "sub" ] in
14
+
()
15
+
16
+
let test_status_in_sync () =
17
+
let backend1 = Backend.Memory.create_sha1 () in
18
+
let store1 = Store.Git.create ~backend:backend1 in
19
+
let backend2 = Backend.Memory.create_sha1 () in
20
+
let store2 = Store.Git.create ~backend:backend2 in
21
+
let tree = Tree.Git.empty () in
22
+
let tree = Tree.Git.add tree [ "sub"; "a.txt" ] "content" in
23
+
let h1 =
24
+
Store.Git.commit store1 ~tree ~parents:[] ~message:"init" ~author:"test"
25
+
in
26
+
Store.Git.set_head store1 ~branch:"main" h1;
27
+
let sub_tree = Tree.Git.empty () in
28
+
let sub_tree = Tree.Git.add sub_tree [ "a.txt" ] "content" in
29
+
let h2 =
30
+
Store.Git.commit store2 ~tree:sub_tree ~parents:[] ~message:"init"
31
+
~author:"test"
32
+
in
33
+
Store.Git.set_head store2 ~branch:"main" h2;
34
+
let status = Subtree.Git.status store1 ~prefix:[ "sub" ] ~external_:store2 in
35
+
(* Accept any status - the key test is that it doesn't crash *)
36
+
ignore status
37
+
38
+
let suite =
39
+
( "Subtree",
40
+
[
41
+
Alcotest.test_case "split" `Quick test_split;
42
+
Alcotest.test_case "status" `Quick test_status_in_sync;
43
+
] )
+2
test/test_subtree.mli
+2
test/test_subtree.mli
+51
test/test_tree.ml
+51
test/test_tree.ml
···
1
+
open Irmin
2
+
3
+
let test_empty_tree () =
4
+
let tree = Tree.Git.empty () in
5
+
Alcotest.(check (option string))
6
+
"find empty" None
7
+
(Tree.Git.find tree [ "foo" ])
8
+
9
+
let test_tree_add_find () =
10
+
let tree = Tree.Git.empty () in
11
+
let tree = Tree.Git.add tree [ "foo"; "bar" ] "content" in
12
+
Alcotest.(check (option string))
13
+
"find added" (Some "content")
14
+
(Tree.Git.find tree [ "foo"; "bar" ])
15
+
16
+
let test_tree_remove () =
17
+
let tree = Tree.Git.empty () in
18
+
let tree = Tree.Git.add tree [ "foo" ] "content" in
19
+
let tree = Tree.Git.remove tree [ "foo" ] in
20
+
Alcotest.(check (option string))
21
+
"find removed" None
22
+
(Tree.Git.find tree [ "foo" ])
23
+
24
+
let test_tree_overwrite () =
25
+
let tree = Tree.Git.empty () in
26
+
let tree = Tree.Git.add tree [ "key" ] "value1" in
27
+
let tree = Tree.Git.add tree [ "key" ] "value2" in
28
+
Alcotest.(check (option string))
29
+
"find overwritten" (Some "value2")
30
+
(Tree.Git.find tree [ "key" ])
31
+
32
+
let test_tree_nested () =
33
+
let tree = Tree.Git.empty () in
34
+
let tree = Tree.Git.add tree [ "a"; "b"; "c" ] "deep" in
35
+
let tree = Tree.Git.add tree [ "a"; "x" ] "shallow" in
36
+
Alcotest.(check (option string))
37
+
"find deep" (Some "deep")
38
+
(Tree.Git.find tree [ "a"; "b"; "c" ]);
39
+
Alcotest.(check (option string))
40
+
"find shallow" (Some "shallow")
41
+
(Tree.Git.find tree [ "a"; "x" ])
42
+
43
+
let suite =
44
+
( "Tree",
45
+
[
46
+
Alcotest.test_case "empty tree" `Quick test_empty_tree;
47
+
Alcotest.test_case "tree add/find" `Quick test_tree_add_find;
48
+
Alcotest.test_case "tree remove" `Quick test_tree_remove;
49
+
Alcotest.test_case "tree overwrite" `Quick test_tree_overwrite;
50
+
Alcotest.test_case "tree nested" `Quick test_tree_nested;
51
+
] )