forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
fix(lint): resolve E010, E320 in memtrace, merlint, monopam
E320: Rename identifiers with too many underscores in test files.
E010: Extract helper functions to reduce nesting depth in hotspots.ml,
check_test_integrity.ml, generate_examples_ml.ml, docs.ml, dune.ml,
cmd_remove.ml, cmd_verse.ml, and clean.ml.
+138
-153
+56
-59
bin/cmd_remove.ml
+56
-59
bin/cmd_remove.ml
···
39
39
let doc = "Show what would be removed without making changes." in
40
40
Arg.(value & flag & info [ "dry-run"; "n" ] ~doc)
41
41
in
42
+
let check_uncommitted ~proc ~cwd dir =
43
+
let buf = Buffer.create 256 in
44
+
Eio.Switch.run @@ fun sw ->
45
+
let child =
46
+
Eio.Process.spawn proc ~sw ~cwd ~stdout:(Eio.Flow.buffer_sink buf)
47
+
[ "git"; "status"; "--porcelain"; "--"; dir ]
48
+
in
49
+
match Eio.Process.await child with
50
+
| `Exited 0 ->
51
+
let output = Buffer.contents buf in
52
+
if String.trim output <> "" then begin
53
+
Fmt.epr
54
+
"Error: %s has uncommitted changes. Use --force to remove anyway.@."
55
+
dir;
56
+
Fmt.epr "Changes:@.%s@." output;
57
+
exit 1
58
+
end
59
+
| _ -> ()
60
+
in
61
+
let remove_dir ~proc ~cwd dir =
62
+
Eio.Switch.run @@ fun sw ->
63
+
let child = Eio.Process.spawn proc ~sw ~cwd [ "rm"; "-rf"; dir ] in
64
+
match Eio.Process.await child with
65
+
| `Exited 0 -> ()
66
+
| _ ->
67
+
Fmt.epr "Error: failed to remove %s@." dir;
68
+
exit 1
69
+
in
70
+
let update_lock ~fs ~target dir =
71
+
match Monopam.Mono_lock.load ~fs target with
72
+
| Ok lock -> (
73
+
let lock' = Monopam.Mono_lock.remove lock ~name:dir in
74
+
match Monopam.Mono_lock.save ~fs target lock' with
75
+
| Ok () -> Fmt.pr "Updated mono.lock@."
76
+
| Error e -> Fmt.epr "Warning: failed to update mono.lock: %s@." e)
77
+
| Error _ -> ()
78
+
in
79
+
let commit_removal ~proc ~cwd dir =
80
+
Eio.Switch.run @@ fun sw ->
81
+
let child =
82
+
Eio.Process.spawn proc ~sw ~cwd [ "git"; "add"; "-A"; dir; "mono.lock" ]
83
+
in
84
+
(match Eio.Process.await child with `Exited 0 -> () | _ -> ());
85
+
let child =
86
+
Eio.Process.spawn proc ~sw ~cwd
87
+
[ "git"; "commit"; "-m"; Fmt.str "Remove subtree %s" dir ]
88
+
in
89
+
match Eio.Process.await child with
90
+
| `Exited 0 -> Fmt.pr "Committed removal.@."
91
+
| _ -> Fmt.pr "No changes to commit.@."
92
+
in
42
93
let run dir force no_commit dry_run () =
43
94
Eio_main.run @@ fun env ->
44
95
let fs = Eio.Stdenv.fs env in
···
46
97
let target = Fpath.v (Sys.getcwd ()) in
47
98
let dir_path = Fpath.(target / dir) in
48
99
let eio_path = Eio.Path.(fs / Fpath.to_string dir_path) in
49
-
(* Check if directory exists *)
50
100
(match Eio.Path.kind ~follow:true eio_path with
51
101
| `Directory -> ()
52
102
| _ ->
···
55
105
| exception _ ->
56
106
Fmt.epr "Error: directory %s does not exist@." dir;
57
107
exit 1);
58
-
(* Check for uncommitted changes unless --force *)
59
-
if not force then begin
60
-
let target_eio = Eio.Path.(fs / Fpath.to_string target) in
61
-
let buf = Buffer.create 256 in
62
-
Eio.Switch.run @@ fun sw ->
63
-
let child =
64
-
Eio.Process.spawn proc ~sw ~cwd:target_eio
65
-
~stdout:(Eio.Flow.buffer_sink buf)
66
-
[ "git"; "status"; "--porcelain"; "--"; dir ]
67
-
in
68
-
match Eio.Process.await child with
69
-
| `Exited 0 ->
70
-
let output = Buffer.contents buf in
71
-
if String.trim output <> "" then begin
72
-
Fmt.epr
73
-
"Error: %s has uncommitted changes. Use --force to remove \
74
-
anyway.@."
75
-
dir;
76
-
Fmt.epr "Changes:@.%s@." output;
77
-
exit 1
78
-
end
79
-
| _ -> ()
80
-
end;
108
+
let target_eio = Eio.Path.(fs / Fpath.to_string target) in
109
+
if not force then check_uncommitted ~proc ~cwd:target_eio dir;
81
110
if dry_run then begin
82
111
Fmt.pr "Would remove: %s@." dir;
83
112
`Ok ()
84
113
end
85
114
else begin
86
-
(* Remove the directory *)
87
115
Fmt.pr "Removing %s...@." dir;
88
-
let target_eio = Eio.Path.(fs / Fpath.to_string target) in
89
-
Eio.Switch.run @@ fun sw ->
90
-
let child =
91
-
Eio.Process.spawn proc ~sw ~cwd:target_eio [ "rm"; "-rf"; dir ]
92
-
in
93
-
(match Eio.Process.await child with
94
-
| `Exited 0 -> ()
95
-
| _ ->
96
-
Fmt.epr "Error: failed to remove %s@." dir;
97
-
exit 1);
98
-
(* Update mono.lock *)
99
-
(match Monopam.Mono_lock.load ~fs target with
100
-
| Ok lock -> (
101
-
let lock' = Monopam.Mono_lock.remove lock ~name:dir in
102
-
match Monopam.Mono_lock.save ~fs target lock' with
103
-
| Ok () -> Fmt.pr "Updated mono.lock@."
104
-
| Error e -> Fmt.epr "Warning: failed to update mono.lock: %s@." e)
105
-
| Error _ -> ());
106
-
(* Commit unless --no-commit *)
107
-
if not no_commit then begin
108
-
Eio.Switch.run @@ fun sw ->
109
-
let child =
110
-
Eio.Process.spawn proc ~sw ~cwd:target_eio
111
-
[ "git"; "add"; "-A"; dir; "mono.lock" ]
112
-
in
113
-
(match Eio.Process.await child with `Exited 0 -> () | _ -> ());
114
-
let child =
115
-
Eio.Process.spawn proc ~sw ~cwd:target_eio
116
-
[ "git"; "commit"; "-m"; Fmt.str "Remove subtree %s" dir ]
117
-
in
118
-
match Eio.Process.await child with
119
-
| `Exited 0 -> Fmt.pr "Committed removal.@."
120
-
| _ -> Fmt.pr "No changes to commit.@."
121
-
end;
116
+
remove_dir ~proc ~cwd:target_eio dir;
117
+
update_lock ~fs ~target dir;
118
+
if not no_commit then commit_removal ~proc ~cwd:target_eio dir;
122
119
Fmt.pr "Removed %s@." dir;
123
120
`Ok ()
124
121
end
+27
-18
bin/cmd_verse.ml
+27
-18
bin/cmd_verse.ml
···
48
48
`Ok ()
49
49
end
50
50
in
51
-
let run handle repo refresh () =
52
-
Eio_main.run @@ fun env ->
53
-
Common.with_config env @@ fun config ->
54
-
Common.with_verse_config env @@ fun verse_config ->
55
-
let fs = Eio.Stdenv.fs env in
56
-
let proc = Eio.Stdenv.process_mgr env in
51
+
let pull_inner ~proc ~fs ~config ~verse_config ~handle ~repo ~refresh =
57
52
match
58
53
Monopam.pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo
59
54
~refresh ()
···
62
57
| Error e ->
63
58
Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
64
59
`Error (false, "pull failed")
60
+
in
61
+
let run handle repo refresh () =
62
+
Eio_main.run @@ fun env ->
63
+
Common.with_config env @@ fun config ->
64
+
Common.with_verse_config env @@ fun verse_config ->
65
+
let fs = Eio.Stdenv.fs env in
66
+
let proc = Eio.Stdenv.process_mgr env in
67
+
pull_inner ~proc ~fs ~config ~verse_config ~handle ~repo ~refresh
65
68
in
66
69
Cmd.v info
67
70
Term.(
···
124
127
Fmt.epr "Commit %s not found in any verse diff@." sha;
125
128
`Error (false, "commit not found")
126
129
in
127
-
let run arg refresh patch () =
128
-
Eio_main.run @@ fun env ->
129
-
Common.with_config env @@ fun config ->
130
-
Common.with_verse_config env @@ fun verse_config ->
131
-
let fs = Eio.Stdenv.fs env in
132
-
let proc = Eio.Stdenv.process_mgr env in
130
+
let diff_inner ~proc ~fs ~config ~verse_config ~arg ~refresh ~patch =
133
131
match arg with
134
132
| Some sha when Monopam.is_commit_sha sha ->
135
133
handle_sha ~proc ~fs ~config ~verse_config ~sha ~refresh
···
140
138
Fmt.pr "%a" (Monopam.pp_diff_result ~show_patch:patch) result;
141
139
`Ok ()
142
140
in
141
+
let run arg refresh patch () =
142
+
Eio_main.run @@ fun env ->
143
+
Common.with_config env @@ fun config ->
144
+
Common.with_verse_config env @@ fun verse_config ->
145
+
let fs = Eio.Stdenv.fs env in
146
+
let proc = Eio.Stdenv.process_mgr env in
147
+
diff_inner ~proc ~fs ~config ~verse_config ~arg ~refresh ~patch
148
+
in
143
149
Cmd.v info
144
150
Term.(ret (const run $ arg $ refresh_arg $ patch_arg $ Common.logging_term))
145
151
···
171
177
let doc = "Force fresh fetches from all remotes." in
172
178
Arg.(value & flag & info [ "refresh"; "r" ] ~doc)
173
179
in
174
-
let run sha refresh () =
175
-
Eio_main.run @@ fun env ->
176
-
Common.with_config env @@ fun config ->
177
-
Common.with_verse_config env @@ fun verse_config ->
178
-
let fs = Eio.Stdenv.fs env in
179
-
let proc = Eio.Stdenv.process_mgr env in
180
+
let cherrypick_inner ~proc ~fs ~config ~verse_config ~sha ~refresh =
180
181
match
181
182
Monopam.cherrypick ~proc ~fs ~config ~verse_config ~sha ~refresh ()
182
183
with
···
187
188
| Error e ->
188
189
Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e;
189
190
`Error (false, "cherrypick failed")
191
+
in
192
+
let run sha refresh () =
193
+
Eio_main.run @@ fun env ->
194
+
Common.with_config env @@ fun config ->
195
+
Common.with_verse_config env @@ fun verse_config ->
196
+
let fs = Eio.Stdenv.fs env in
197
+
let proc = Eio.Stdenv.process_mgr env in
198
+
cherrypick_inner ~proc ~fs ~config ~verse_config ~sha ~refresh
190
199
in
191
200
Cmd.v info
192
201
Term.(ret (const run $ sha_arg $ refresh_arg $ Common.logging_term))
+12
-13
lib/clean.ml
+12
-13
lib/clean.ml
···
102
102
Log.app (fun m -> m "Removed %d commits" total_cleaned);
103
103
if force then begin
104
104
Log.app (fun m -> m "Force-pushing cleaned histories to upstream...");
105
-
(try
106
-
Eio.Path.read_dir checkouts_path
107
-
|> List.iter (fun name ->
108
-
let path = Fpath.(checkouts / name) in
109
-
if Git.Repository.is_repo ~fs:fs_t path then
110
-
match
111
-
Git_cli.push_remote ~proc
112
-
~fs:(fs_t :> _ Eio.Path.t)
113
-
~force:true path
114
-
with
115
-
| Ok () -> Log.app (fun m -> m " ✓ %s" name)
116
-
| Error e ->
117
-
Log.app (fun m -> m " ✗ %s: %a" name Git_cli.pp_error e))
105
+
let push_checkout name =
106
+
let path = Fpath.(checkouts / name) in
107
+
if Git.Repository.is_repo ~fs:fs_t path then
108
+
match
109
+
Git_cli.push_remote ~proc
110
+
~fs:(fs_t :> _ Eio.Path.t)
111
+
~force:true path
112
+
with
113
+
| Ok () -> Log.app (fun m -> m " ✓ %s" name)
114
+
| Error e -> Log.app (fun m -> m " ✗ %s: %a" name Git_cli.pp_error e)
115
+
in
116
+
(try Eio.Path.read_dir checkouts_path |> List.iter push_checkout
118
117
with Eio.Io _ -> ());
119
118
Ok ()
120
119
end
+2
-2
test/test_package.ml
+2
-2
test/test_package.ml
···
54
54
let pkg = Package.v ~name:"ocaml" ~version:"dev" ~dev_repo () in
55
55
Alcotest.(check string) "github repo name" "ocaml" (Package.repo_name pkg)
56
56
57
-
let test_repo_name_no_git_suffix () =
57
+
let test_repo_name_no_suffix () =
58
58
let dev_repo = Uri.of_string "https://github.com/ocaml/dune" in
59
59
let pkg = Package.v ~name:"dune" ~version:"dev" ~dev_repo () in
60
60
Alcotest.(check string) "no .git suffix" "dune" (Package.repo_name pkg)
···
153
153
Alcotest.test_case "with synopsis" `Quick test_create_with_synopsis;
154
154
Alcotest.test_case "default values" `Quick test_default_values;
155
155
Alcotest.test_case "github" `Quick test_repo_name_github;
156
-
Alcotest.test_case "no .git suffix" `Quick test_repo_name_no_git_suffix;
156
+
Alcotest.test_case "no .git suffix" `Quick test_repo_name_no_suffix;
157
157
Alcotest.test_case "gitlab" `Quick test_repo_name_gitlab;
158
158
Alcotest.test_case "nested path" `Quick test_repo_name_nested_path;
159
159
Alcotest.test_case "checkout dir" `Quick test_checkout_dir;
+2
-3
test/test_pkg.ml
+2
-3
test/test_pkg.ml
···
2
2
3
3
module Pkg = Monopam.Pkg
4
4
5
-
let test_matches_name_by_pkg_name () =
5
+
let test_matches_by_pkg_name () =
6
6
let pkg =
7
7
Pkg.v ~pkg_name:"d3t" ~subtree:"ocaml-d3t" ~dev_repo:"" ~url_src:""
8
8
~opam_content:""
···
28
28
let suite =
29
29
( "Pkg",
30
30
[
31
-
Alcotest.test_case "matches by pkg name" `Quick
32
-
test_matches_name_by_pkg_name;
31
+
Alcotest.test_case "matches by pkg name" `Quick test_matches_by_pkg_name;
33
32
Alcotest.test_case "matches by subtree" `Quick
34
33
test_matches_name_by_subtree;
35
34
Alcotest.test_case "no match" `Quick test_matches_name_no_match;
+39
-58
test/test_status.ml
+39
-58
test/test_status.ml
···
9
9
Package.v ~name ~version:"dev" ~dev_repo ()
10
10
11
11
(* Helper to create a status with given parameters *)
12
-
let make_status ?(checkout = Status.Missing) ?(subtree = Status.Not_added)
12
+
let status ?(checkout = Status.Missing) ?(subtree = Status.Not_added)
13
13
?(subtree_sync = Status.Unknown) name =
14
14
let package = package name in
15
15
{ Status.package; checkout; subtree; subtree_sync }
···
17
17
(* Test predicates *)
18
18
19
19
let test_is_checkout_clean_missing () =
20
-
let s = make_status ~checkout:Status.Missing "pkg" in
20
+
let s = status ~checkout:Status.Missing "pkg" in
21
21
Alcotest.(check bool)
22
22
"missing is not clean" false
23
23
(Status.is_checkout_clean s)
24
24
25
-
let test_is_checkout_clean_not_repo () =
26
-
let s = make_status ~checkout:Status.Not_a_repo "pkg" in
25
+
let test_checkout_clean_not_repo () =
26
+
let s = status ~checkout:Status.Not_a_repo "pkg" in
27
27
Alcotest.(check bool)
28
28
"not repo is not clean" false
29
29
(Status.is_checkout_clean s)
30
30
31
31
let test_is_checkout_clean_dirty () =
32
-
let s = make_status ~checkout:Status.Dirty "pkg" in
32
+
let s = status ~checkout:Status.Dirty "pkg" in
33
33
Alcotest.(check bool) "dirty is not clean" false (Status.is_checkout_clean s)
34
34
35
35
let test_is_checkout_clean_yes () =
36
-
let s =
37
-
make_status ~checkout:(Status.Clean { ahead = 0; behind = 0 }) "pkg"
38
-
in
36
+
let s = status ~checkout:(Status.Clean { ahead = 0; behind = 0 }) "pkg" in
39
37
Alcotest.(check bool) "clean is clean" true (Status.is_checkout_clean s)
40
38
41
-
let test_is_checkout_clean_with_ahead () =
42
-
let s =
43
-
make_status ~checkout:(Status.Clean { ahead = 5; behind = 0 }) "pkg"
44
-
in
39
+
let test_checkout_clean_with_ahead () =
40
+
let s = status ~checkout:(Status.Clean { ahead = 5; behind = 0 }) "pkg" in
45
41
Alcotest.(check bool)
46
42
"clean with ahead is clean" true
47
43
(Status.is_checkout_clean s)
···
49
45
(* Test needs_pull *)
50
46
51
47
let test_needs_pull_behind () =
52
-
let s =
53
-
make_status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg"
54
-
in
48
+
let s = status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg" in
55
49
Alcotest.(check bool) "behind needs pull" true (Status.needs_pull s)
56
50
57
51
let test_needs_pull_not_behind () =
58
-
let s =
59
-
make_status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg"
60
-
in
52
+
let s = status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg" in
61
53
Alcotest.(check bool) "not behind no pull" false (Status.needs_pull s)
62
54
63
55
let test_needs_pull_dirty () =
64
-
let s = make_status ~checkout:Status.Dirty "pkg" in
56
+
let s = status ~checkout:Status.Dirty "pkg" in
65
57
Alcotest.(check bool) "dirty no pull" false (Status.needs_pull s)
66
58
67
59
(* Test needs_push *)
68
60
69
61
let test_needs_push_ahead () =
70
-
let s =
71
-
make_status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg"
72
-
in
62
+
let s = status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg" in
73
63
Alcotest.(check bool) "ahead needs push" true (Status.needs_push s)
74
64
75
65
let test_needs_push_not_ahead () =
76
-
let s =
77
-
make_status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg"
78
-
in
66
+
let s = status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg" in
79
67
Alcotest.(check bool) "not ahead no push" false (Status.needs_push s)
80
68
81
69
(* Test needs_local_sync *)
82
70
83
-
let test_needs_local_sync_in_sync () =
84
-
let s = make_status ~subtree_sync:Status.In_sync "pkg" in
71
+
let test_local_sync_in_sync () =
72
+
let s = status ~subtree_sync:Status.In_sync "pkg" in
85
73
Alcotest.(check bool) "in sync no action" false (Status.needs_local_sync s)
86
74
87
75
let test_needs_local_sync_behind () =
88
-
let s = make_status ~subtree_sync:(Status.Subtree_behind 3) "pkg" in
76
+
let s = status ~subtree_sync:(Status.Subtree_behind 3) "pkg" in
89
77
Alcotest.(check bool)
90
78
"subtree behind needs sync" true
91
79
(Status.needs_local_sync s)
92
80
93
81
let test_needs_local_sync_ahead () =
94
-
let s = make_status ~subtree_sync:(Status.Subtree_ahead 2) "pkg" in
82
+
let s = status ~subtree_sync:(Status.Subtree_ahead 2) "pkg" in
95
83
Alcotest.(check bool)
96
84
"subtree ahead needs sync" true
97
85
(Status.needs_local_sync s)
98
86
99
87
let test_needs_local_sync_differ () =
100
-
let s = make_status ~subtree_sync:Status.Trees_differ "pkg" in
88
+
let s = status ~subtree_sync:Status.Trees_differ "pkg" in
101
89
Alcotest.(check bool)
102
90
"trees differ needs sync" true
103
91
(Status.needs_local_sync s)
···
105
93
(* Test needs_remote_action *)
106
94
107
95
let test_needs_remote_action_ahead () =
108
-
let s =
109
-
make_status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg"
110
-
in
96
+
let s = status ~checkout:(Status.Clean { ahead = 2; behind = 0 }) "pkg" in
111
97
Alcotest.(check bool) "ahead needs remote" true (Status.needs_remote_action s)
112
98
113
99
let test_needs_remote_action_behind () =
114
-
let s =
115
-
make_status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg"
116
-
in
100
+
let s = status ~checkout:(Status.Clean { ahead = 0; behind = 3 }) "pkg" in
117
101
Alcotest.(check bool)
118
102
"behind needs remote" true
119
103
(Status.needs_remote_action s)
120
104
121
105
let test_needs_remote_action_synced () =
122
-
let s =
123
-
make_status ~checkout:(Status.Clean { ahead = 0; behind = 0 }) "pkg"
124
-
in
106
+
let s = status ~checkout:(Status.Clean { ahead = 0; behind = 0 }) "pkg" in
125
107
Alcotest.(check bool) "synced no remote" false (Status.needs_remote_action s)
126
108
127
109
(* Test is_fully_synced *)
128
110
129
111
let test_is_fully_synced_yes () =
130
112
let s =
131
-
make_status
113
+
status
132
114
~checkout:(Status.Clean { ahead = 0; behind = 0 })
133
115
~subtree:Status.Present ~subtree_sync:Status.In_sync "pkg"
134
116
in
135
117
Alcotest.(check bool) "all synced" true (Status.is_fully_synced s)
136
118
137
-
let test_is_fully_synced_checkout_ahead () =
119
+
let test_fully_synced_checkout_ahead () =
138
120
let s =
139
-
make_status
121
+
status
140
122
~checkout:(Status.Clean { ahead = 1; behind = 0 })
141
123
~subtree:Status.Present ~subtree_sync:Status.In_sync "pkg"
142
124
in
143
125
Alcotest.(check bool)
144
126
"checkout ahead not synced" false (Status.is_fully_synced s)
145
127
146
-
let test_is_fully_synced_subtree_not_added () =
128
+
let test_fully_synced_no_subtree () =
147
129
let s =
148
-
make_status
130
+
status
149
131
~checkout:(Status.Clean { ahead = 0; behind = 0 })
150
132
~subtree:Status.Not_added ~subtree_sync:Status.Unknown "pkg"
151
133
in
152
134
Alcotest.(check bool)
153
135
"subtree not added not synced" false (Status.is_fully_synced s)
154
136
155
-
let test_is_fully_synced_trees_differ () =
137
+
let test_fully_synced_trees_differ () =
156
138
let s =
157
-
make_status
139
+
status
158
140
~checkout:(Status.Clean { ahead = 0; behind = 0 })
159
141
~subtree:Status.Present ~subtree_sync:Status.Trees_differ "pkg"
160
142
in
···
165
147
166
148
let test_filter_actionable_all_synced () =
167
149
let synced =
168
-
make_status
150
+
status
169
151
~checkout:(Status.Clean { ahead = 0; behind = 0 })
170
152
~subtree:Status.Present ~subtree_sync:Status.In_sync "pkg"
171
153
in
···
174
156
175
157
let test_filter_actionable_mixed () =
176
158
let synced =
177
-
make_status
159
+
status
178
160
~checkout:(Status.Clean { ahead = 0; behind = 0 })
179
161
~subtree:Status.Present ~subtree_sync:Status.In_sync "synced"
180
162
in
181
163
let needs_push =
182
-
make_status
164
+
status
183
165
~checkout:(Status.Clean { ahead = 2; behind = 0 })
184
166
~subtree:Status.Present ~subtree_sync:Status.In_sync "needs-push"
185
167
in
186
168
let needs_sync =
187
-
make_status
169
+
status
188
170
~checkout:(Status.Clean { ahead = 0; behind = 0 })
189
171
~subtree:Status.Present ~subtree_sync:(Status.Subtree_behind 1)
190
172
"needs-sync"
191
173
in
192
174
let dirty =
193
-
make_status ~checkout:Status.Dirty ~subtree:Status.Present
175
+
status ~checkout:Status.Dirty ~subtree:Status.Present
194
176
~subtree_sync:Status.Unknown "dirty"
195
177
in
196
178
let result =
···
202
184
( "Status",
203
185
[
204
186
Alcotest.test_case "missing" `Quick test_is_checkout_clean_missing;
205
-
Alcotest.test_case "not repo" `Quick test_is_checkout_clean_not_repo;
187
+
Alcotest.test_case "not repo" `Quick test_checkout_clean_not_repo;
206
188
Alcotest.test_case "dirty" `Quick test_is_checkout_clean_dirty;
207
189
Alcotest.test_case "clean" `Quick test_is_checkout_clean_yes;
208
190
Alcotest.test_case "clean with ahead" `Quick
209
-
test_is_checkout_clean_with_ahead;
191
+
test_checkout_clean_with_ahead;
210
192
Alcotest.test_case "behind" `Quick test_needs_pull_behind;
211
193
Alcotest.test_case "not behind" `Quick test_needs_pull_not_behind;
212
194
Alcotest.test_case "dirty pull" `Quick test_needs_pull_dirty;
213
195
Alcotest.test_case "ahead" `Quick test_needs_push_ahead;
214
196
Alcotest.test_case "not ahead" `Quick test_needs_push_not_ahead;
215
-
Alcotest.test_case "in sync" `Quick test_needs_local_sync_in_sync;
197
+
Alcotest.test_case "in sync" `Quick test_local_sync_in_sync;
216
198
Alcotest.test_case "local behind" `Quick test_needs_local_sync_behind;
217
199
Alcotest.test_case "local ahead" `Quick test_needs_local_sync_ahead;
218
200
Alcotest.test_case "differ" `Quick test_needs_local_sync_differ;
···
221
203
Alcotest.test_case "remote synced" `Quick test_needs_remote_action_synced;
222
204
Alcotest.test_case "all synced" `Quick test_is_fully_synced_yes;
223
205
Alcotest.test_case "checkout ahead" `Quick
224
-
test_is_fully_synced_checkout_ahead;
225
-
Alcotest.test_case "subtree not added" `Quick
226
-
test_is_fully_synced_subtree_not_added;
227
-
Alcotest.test_case "trees differ" `Quick test_is_fully_synced_trees_differ;
206
+
test_fully_synced_checkout_ahead;
207
+
Alcotest.test_case "subtree not added" `Quick test_fully_synced_no_subtree;
208
+
Alcotest.test_case "trees differ" `Quick test_fully_synced_trees_differ;
228
209
Alcotest.test_case "filter all synced" `Quick
229
210
test_filter_actionable_all_synced;
230
211
Alcotest.test_case "filter mixed" `Quick test_filter_actionable_mixed;