Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
1(** Worktree tests: checkout, status, commit, and adversarial cases. *)
2
3module Hash = struct
4 type hash = string
5
6 let hash_equal = String.equal
7 let hash_string s = Digestif.SHA256.(to_hex (digest_string s))
8 let to_hex h = h
9 let of_hex h = h
10end
11
12module W = Irmin.Worktree.Make (Hash)
13
14module B :
15 Irmin.Heap.BACKEND
16 with type t = (string, string) Hashtbl.t
17 and type hash = string
18 and type block = string = struct
19 type t = (string, string) Hashtbl.t
20 type hash = string
21 type block = string
22
23 let find t h = Hashtbl.find_opt t h
24 let put t h d = Hashtbl.replace t h d
25 let mem t h = Hashtbl.mem t h
26 let batch t l = List.iter (fun (h, d) -> Hashtbl.replace t h d) l
27 let refs : (string, string) Hashtbl.t = Hashtbl.create 4
28 let ref _ name = Hashtbl.find_opt refs name
29 let set_ref _ name h = Hashtbl.replace refs name h
30 let del_ref _ _ = ()
31 let list_refs _ = Hashtbl.fold (fun k _ acc -> k :: acc) refs []
32 let cas_ref _ _ ~test:_ ~set:_ = false
33 let flush _ = ()
34 let close _ = ()
35end
36
37module H = Irmin.Heap.Make (B)
38
39let with_tmp_dir f =
40 Eio_main.run @@ fun env ->
41 let fs = Eio.Stdenv.fs env in
42 let name = Fmt.str "/tmp/irmin-test-wt-%d" (Random.int 1_000_000) in
43 let path = Eio.Path.(fs / name) in
44 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path;
45 Fun.protect
46 ~finally:(fun () -> try Eio.Path.rmtree path with Eio.Io _ -> ())
47 (fun () -> f fs (Fpath.v name))
48
49let status_empty_dir () =
50 with_tmp_dir @@ fun fs dir ->
51 let changes = W.status ~fs ~dir in
52 Alcotest.(check int) "empty dir = no changes" 0 (List.length changes)
53
54let commit_and_status () =
55 with_tmp_dir @@ fun fs dir ->
56 let store = Hashtbl.create 16 in
57 let heap = H.v store in
58 (* Create a file and commit it *)
59 let p = Eio.Path.(fs / Fpath.to_string dir / "hello.txt") in
60 Eio.Path.save ~create:(`Or_truncate 0o644) p "Hello, world!";
61 (* Write empty index so status sees the file as Added *)
62 W.write_index ~fs ~dir [];
63 let changes = W.status ~fs ~dir in
64 Alcotest.(check int) "1 added before commit" 1 (List.length changes);
65 (* Commit *)
66 (match
67 W.commit ~fs heap ~branch:"main" ~dir ~message:"init" ~author:"test"
68 with
69 | Ok _hash -> ()
70 | Error (`Msg e) -> Alcotest.failf "commit failed: %s" e);
71 (* Status should be clean after commit *)
72 let changes = W.status ~fs ~dir in
73 Alcotest.(check int) "clean after commit" 0 (List.length changes);
74 (* Modify the file *)
75 Eio.Path.save ~create:(`Or_truncate 0o644) p "Modified!";
76 let changes = W.status ~fs ~dir in
77 Alcotest.(check int) "1 modified" 1 (List.length changes);
78 match changes with
79 | [ W.Modified "hello.txt" ] -> ()
80 | _ -> Alcotest.fail "expected Modified hello.txt"
81
82let status_added () =
83 with_tmp_dir @@ fun fs dir ->
84 (* Write index with no files, then add one *)
85 W.write_index ~fs ~dir [];
86 let p = Eio.Path.(fs / Fpath.to_string dir / "new.txt") in
87 Eio.Path.save ~create:(`Or_truncate 0o644) p "new content";
88 let changes = W.status ~fs ~dir in
89 Alcotest.(check int) "1 added" 1 (List.length changes);
90 match changes with
91 | [ W.Added "new.txt" ] -> ()
92 | _ -> Alcotest.fail "expected Added new.txt"
93
94let status_deleted () =
95 with_tmp_dir @@ fun fs dir ->
96 (* Write an index entry for a file that doesn't exist on disk *)
97 let idx : W.index =
98 [
99 {
100 path = "gone.txt";
101 hash = Hash.hash_string "old content";
102 mtime = 0.0;
103 size = 11;
104 };
105 ]
106 in
107 W.write_index ~fs ~dir idx;
108 let changes = W.status ~fs ~dir in
109 Alcotest.(check int) "1 deleted" 1 (List.length changes);
110 match changes with
111 | [ W.Deleted "gone.txt" ] -> ()
112 | _ -> Alcotest.fail "expected Deleted gone.txt"
113
114let commit_nothing () =
115 with_tmp_dir @@ fun fs dir ->
116 let store = Hashtbl.create 16 in
117 let heap = H.v store in
118 W.write_index ~fs ~dir [];
119 match
120 W.commit ~fs heap ~branch:"main" ~dir ~message:"empty" ~author:"test"
121 with
122 | Error (`Msg _) -> ()
123 | Ok _ -> Alcotest.fail "should fail: nothing to commit"
124
125let suite =
126 ( "worktree",
127 [
128 Alcotest.test_case "status empty dir" `Quick status_empty_dir;
129 Alcotest.test_case "commit and status" `Quick commit_and_status;
130 Alcotest.test_case "status added" `Quick status_added;
131 Alcotest.test_case "status deleted" `Quick status_deleted;
132 Alcotest.test_case "commit nothing" `Quick commit_nothing;
133 ] )