Repositories / ocaml-git.git
test/test_ocaml_git.ml
Clone (read-only): git clone http://git.guha-anderson.com/git/ocaml-git.git
open Ocaml_git
let work_root : string = ".build/test-work"
let repo_path : string = work_root ^ "/demo-repo"
let sh (command : string) : unit =
match Sys.command command with
| 0 -> ()
| code -> Alcotest.failf "command failed with %d: %s" code command
let reset_fixture () : unit =
sh ("rm -rf " ^ work_root ^ " && mkdir -p " ^ work_root ^ " && tar -xzf fixtures/demo-repo.tar.gz -C " ^ work_root)
let with_fixture (f : unit -> unit) : unit =
reset_fixture ();
f ()
let check_suffix (label : string) (suffix : string) (value : string) : unit =
Alcotest.(check bool) label true (String.ends_with ~suffix value)
let opens_repository () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
check_suffix "workdir" "demo-repo/" (Option.get (workdir repo));
check_suffix "git_dir" "demo-repo/.git/" (git_dir repo);
Alcotest.(check bool) "not bare" false (is_bare repo);
Alcotest.(check bool) "not empty" false (is_empty repo);
Alcotest.(check string) "head" "refs/heads/main" (head_name repo)
let opens_bare_repository () : unit = with_fixture @@ fun () ->
let path = work_root ^ "/bare-repo.git" in
sh ("git clone --bare " ^ repo_path ^ " " ^ path ^ " >/dev/null 2>&1");
with_repo path @@ fun repo ->
Alcotest.(check bool) "bare" true (is_bare repo);
Alcotest.(check bool) "no workdir" true (Option.is_none (workdir repo));
Alcotest.(check string) "summary" "Update readme" (head_commit repo).summary;
Alcotest.(check bool) "has readme" true (List.exists (fun e -> e.name = "README.md") (tree repo ()).entries)
let discovers_repository_from_child () : unit = with_fixture @@ fun () ->
check_suffix "discover" "demo-repo/.git/" (discover (repo_path ^ "/src"))
let reads_head_commit () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let commit = head_commit repo in
Alcotest.(check int) "oid length" 40 (String.length commit.id);
Alcotest.(check string) "summary" "Update readme" commit.summary;
Alcotest.(check bool) "message" true (String.contains commit.message 'U');
Alcotest.(check string) "author" "Fixture Author" commit.author.name;
Alcotest.(check string) "email" "fixture@example.com" commit.author.email;
Alcotest.(check int) "parents" 1 commit.parent_count
let lists_branches () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let branches : branch list = branches repo in
let names = List.map (fun (b : branch) -> b.name) branches in
Alcotest.(check bool) "main" true (List.mem "main" names);
Alcotest.(check bool) "feature" true (List.mem "feature/demo" names);
Alcotest.(check bool) "main head" true (List.find (fun (b : branch) -> b.name = "main") branches).is_head;
Alcotest.(check bool) "local" true (List.for_all (fun (b : branch) -> b.kind = Local) branches)
let reads_branch_commit () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
Alcotest.(check string) "summary" "Update readme" (branch_commit repo "main").summary
let looks_up_tree_entries () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let readme = tree_entry repo "README.md" in
Alcotest.(check string) "name" "README.md" readme.name;
Alcotest.(check bool) "blob" true (readme.kind = Blob);
Alcotest.(check int) "oid" 40 (String.length readme.id);
Alcotest.(check bool) "src tree" true ((tree_entry repo "src").kind = Tree)
let lists_trees () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let root = tree repo () in
Alcotest.(check bool) "readme" true (List.exists (fun e -> e.name = "README.md" && e.kind = Blob) root.entries);
Alcotest.(check bool) "src" true (List.exists (fun e -> e.name = "src" && e.kind = Tree) root.entries);
let src = tree ~path:"src" repo () in
Alcotest.(check bool) "hello" true (List.exists (fun e -> e.name = "hello.txt" && e.kind = Blob) src.entries)
let reads_blobs () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let blob = blob repo "README.md" in
Alcotest.(check bool) "text" false (blob_is_binary blob);
Alcotest.(check bool) "content" true (String.contains (blob_text blob) 'd')
let walks_commit_history () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
let commits = commits repo "main" in
Alcotest.(check int) "count" 2 (List.length commits);
Alcotest.(check string) "first" "Update readme" (List.hd commits).summary;
Alcotest.(check string) "last" "Initial fixture commit" (List.hd (List.rev commits)).summary
let reports_clean_status () : unit = with_fixture @@ fun () ->
with_repo repo_path @@ fun repo ->
Alcotest.(check int) "clean" 0 (List.length (status repo))
let reports_worktree_status () : unit = with_fixture @@ fun () ->
sh ("printf '\\nlocal edit\\n' >> " ^ repo_path ^ "/README.md");
sh ("printf 'notes\\n' > " ^ repo_path ^ "/notes.txt");
with_repo repo_path @@ fun repo ->
let by_path path = List.find (fun s -> s.path = path) (status repo) in
Alcotest.(check bool) "modified" true (List.mem Worktree_modified (by_path "README.md").flags);
Alcotest.(check bool) "new" true (List.mem Worktree_new (by_path "notes.txt").flags)
let updates_index () : unit = with_fixture @@ fun () ->
sh ("printf 'notes\\n' > " ^ repo_path ^ "/notes.txt");
with_repo repo_path @@ fun repo ->
let idx = index repo in
Fun.protect
~finally:(fun () -> close_index idx)
(fun () ->
Alcotest.(check bool) "readme indexed" true (index_contains idx "README.md");
let original_size = index_size idx in
ignore (index_add idx "notes.txt" |> index_write);
Alcotest.(check bool) "notes indexed" true (index_contains idx "notes.txt");
Alcotest.(check int) "size" (original_size + 1) (index_size idx));
let notes = List.find (fun s -> s.path = "notes.txt") (status repo) in
Alcotest.(check bool) "staged" true (List.mem Index_new notes.flags)
let initializes_repository () : unit = with_fixture @@ fun () ->
let path = work_root ^ "/new-repo" in
sh ("rm -rf " ^ path ^ " && mkdir -p " ^ path);
let repo = init path in
Fun.protect ~finally:(fun () -> close repo) @@ fun () ->
Alcotest.(check bool) "not bare" false (is_bare repo);
Alcotest.(check bool) "empty" true (is_empty repo);
check_suffix "new workdir" "new-repo/" (Option.get (workdir repo))
let rejects_missing_repository () : unit = with_fixture @@ fun () ->
Alcotest.(check bool) "missing" true
(match open_repo (work_root ^ "/missing") with
| _ -> false
| exception Git_error _ -> true)
let () : unit =
Alcotest.run "ocaml-git"
[
( "repository",
[
Alcotest.test_case "opens repository" `Quick opens_repository;
Alcotest.test_case "opens bare repository" `Quick opens_bare_repository;
Alcotest.test_case "discovers repository from child" `Quick discovers_repository_from_child;
Alcotest.test_case "reads head commit" `Quick reads_head_commit;
Alcotest.test_case "lists branches" `Quick lists_branches;
Alcotest.test_case "reads branch commit" `Quick reads_branch_commit;
Alcotest.test_case "looks up tree entries" `Quick looks_up_tree_entries;
Alcotest.test_case "lists trees" `Quick lists_trees;
Alcotest.test_case "reads blobs" `Quick reads_blobs;
Alcotest.test_case "walks commit history" `Quick walks_commit_history;
Alcotest.test_case "reports clean status" `Quick reports_clean_status;
Alcotest.test_case "reports worktree status" `Quick reports_worktree_status;
Alcotest.test_case "updates index" `Quick updates_index;
Alcotest.test_case "initializes repository" `Quick initializes_repository;
Alcotest.test_case "rejects missing repository" `Quick rejects_missing_repository;
] );
]