Repositories / ocaml-git.git

test/test_ocaml_git.ml

Clone (read-only): git clone http://git.guha-anderson.com/git/ocaml-git.git

Branch
7840 bytes · 532c3814edd0
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; ] ); ]