gazagnaire.org
Git object storage and pack files for Eio
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
15let hash = Test_helpers.hash
16let with_temp_repo = Test_helpers.with_temp_repo
17let commit = Test_helpers.commit
18
19let test_list_main () =
20 with_temp_repo @@ fun fs tmp_dir ->
21 let repo = Git.Repository.init ~fs tmp_dir in
22 let wt = Git.Repository.worktree repo in
23 let worktrees =
24 Git.Worktree.list wt ~head:(Git.Repository.head repo)
25 ~current_branch:(Git.Repository.current_branch repo)
26 in
27 Alcotest.(check int) "one worktree" 1 (List.length worktrees);
28 let main = List.hd worktrees in
29 Alcotest.(check bool) "main path matches" true (Fpath.equal main.path tmp_dir)
30
31let test_add_basic () =
32 with_temp_repo @@ fun fs tmp_dir ->
33 let repo = Git.Repository.init ~fs tmp_dir in
34 let wt = Git.Repository.worktree repo in
35 let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
36 let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
37 Git.Repository.write_ref repo "refs/heads/main" c1;
38 let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
39 Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
40 let wt_path = Fpath.(tmp_dir / "worktrees" / "feature1") in
41 (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature1" with
42 | Ok () -> ()
43 | Error (`Msg msg) -> Alcotest.fail msg);
44 Alcotest.(check bool)
45 "worktree exists" true
46 (Git.Worktree.exists wt ~path:wt_path);
47 Alcotest.(check (option hash))
48 "branch created" (Some c1)
49 (Git.Repository.read_ref repo "refs/heads/feature1")
50
51let test_exists_false () =
52 with_temp_repo @@ fun fs tmp_dir ->
53 let repo = Git.Repository.init ~fs tmp_dir in
54 let wt = Git.Repository.worktree repo in
55 let nonexistent = Fpath.(tmp_dir / "nonexistent") in
56 Alcotest.(check bool)
57 "non-existent worktree" false
58 (Git.Worktree.exists wt ~path:nonexistent)
59
60let test_remove () =
61 with_temp_repo @@ fun fs tmp_dir ->
62 let repo = Git.Repository.init ~fs tmp_dir in
63 let wt = Git.Repository.worktree repo in
64 let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
65 let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
66 Git.Repository.write_ref repo "refs/heads/main" c1;
67 let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
68 Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
69 let wt_path = Fpath.(tmp_dir / "worktrees" / "feature2") in
70 (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature2" with
71 | Ok () -> ()
72 | Error (`Msg msg) -> Alcotest.fail msg);
73 Alcotest.(check bool)
74 "worktree exists before remove" true
75 (Git.Worktree.exists wt ~path:wt_path);
76 (match Git.Worktree.remove wt ~path:wt_path ~force:false with
77 | Ok () -> ()
78 | Error (`Msg msg) -> Alcotest.fail msg);
79 Alcotest.(check bool)
80 "worktree gone after remove" false
81 (Git.Worktree.exists wt ~path:wt_path)
82
83let test_remove_main_fails () =
84 with_temp_repo @@ fun fs tmp_dir ->
85 let repo = Git.Repository.init ~fs tmp_dir in
86 let wt = Git.Repository.worktree repo in
87 match Git.Worktree.remove wt ~path:tmp_dir ~force:false with
88 | Ok () -> Alcotest.fail "should not be able to remove main worktree"
89 | Error (`Msg _) -> ()
90
91let test_list_multiple () =
92 with_temp_repo @@ fun fs tmp_dir ->
93 let repo = Git.Repository.init ~fs tmp_dir in
94 let wt = Git.Repository.worktree repo in
95 let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
96 let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
97 Git.Repository.write_ref repo "refs/heads/main" c1;
98 let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
99 Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
100 let wt1 = Fpath.(tmp_dir / "worktrees" / "wt1") in
101 let wt2 = Fpath.(tmp_dir / "worktrees" / "wt2") in
102 let wt3 = Fpath.(tmp_dir / "worktrees" / "wt3") in
103 (match Git.Worktree.add wt ~head:c1 ~path:wt1 ~branch:"wt1" with
104 | Ok () -> ()
105 | Error (`Msg msg) -> Alcotest.fail msg);
106 (match Git.Worktree.add wt ~head:c1 ~path:wt2 ~branch:"wt2" with
107 | Ok () -> ()
108 | Error (`Msg msg) -> Alcotest.fail msg);
109 (match Git.Worktree.add wt ~head:c1 ~path:wt3 ~branch:"wt3" with
110 | Ok () -> ()
111 | Error (`Msg msg) -> Alcotest.fail msg);
112 let worktrees =
113 Git.Worktree.list wt ~head:(Git.Repository.head repo)
114 ~current_branch:(Git.Repository.current_branch repo)
115 in
116 Alcotest.(check int) "4 worktrees" 4 (List.length worktrees);
117 Alcotest.(check bool) "wt1 exists" true (Git.Worktree.exists wt ~path:wt1);
118 Alcotest.(check bool) "wt2 exists" true (Git.Worktree.exists wt ~path:wt2);
119 Alcotest.(check bool) "wt3 exists" true (Git.Worktree.exists wt ~path:wt3)
120
121let test_entry_branch () =
122 with_temp_repo @@ fun fs tmp_dir ->
123 let repo = Git.Repository.init ~fs tmp_dir in
124 let wt = Git.Repository.worktree repo in
125 let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
126 let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
127 Git.Repository.write_ref repo "refs/heads/main" c1;
128 let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
129 Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
130 let wt_path = Fpath.(tmp_dir / "worktrees" / "my-feature") in
131 (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"my-feature" with
132 | Ok () -> ()
133 | Error (`Msg msg) -> Alcotest.fail msg);
134 let worktrees =
135 Git.Worktree.list wt ~head:(Git.Repository.head repo)
136 ~current_branch:(Git.Repository.current_branch repo)
137 in
138 let wt_entry =
139 List.find_opt
140 (fun (e : Git.Worktree.entry) -> Fpath.equal e.path wt_path)
141 worktrees
142 in
143 match wt_entry with
144 | None -> Alcotest.fail "worktree not found in list"
145 | Some entry ->
146 Alcotest.(check (option string))
147 "branch name" (Some "my-feature") entry.branch
148
149let test_add_needs_head () =
150 with_temp_repo @@ fun fs tmp_dir ->
151 let repo = Git.Repository.init ~fs tmp_dir in
152 let wt = Git.Repository.worktree repo in
153 let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
154 let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
155 let wt_path = Fpath.(tmp_dir / "worktrees" / "feature") in
156 match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature" with
157 | Ok () -> Alcotest.(check bool) "worktree created" true true
158 | Error (`Msg msg) -> Alcotest.fail msg
159
160let tests =
161 [
162 Alcotest.test_case "list_main" `Quick test_list_main;
163 Alcotest.test_case "add_basic" `Quick test_add_basic;
164 Alcotest.test_case "exists_false" `Quick test_exists_false;
165 Alcotest.test_case "remove" `Quick test_remove;
166 Alcotest.test_case "remove_main_fails" `Quick test_remove_main_fails;
167 Alcotest.test_case "list_multiple" `Quick test_list_multiple;
168 Alcotest.test_case "entry_branch" `Quick test_entry_branch;
169 Alcotest.test_case "add_needs_head" `Quick test_add_needs_head;
170 ]
171
172let suite = ("worktree", tests)