1 (** Resolving paths within a Git tree, including unreachable objects. *) 2 3 open Test_helpers 4 5 let test_root_tree () = 6 with_temp_directory "ogit-paths" (fun root -> 7 let name = "project" in 8 let path = Filename.concat root name in 9 Unix.mkdir path 0o755; 10 ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]); 11 ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]); 12 ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]); 13 Out_channel.with_open_text (Filename.concat path "file.txt") (fun ch -> 14 output_string ch "data\n"); 15 ignore (git [ "-C"; path; "add"; "." ]); 16 ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]); 17 let root_tree = git [ "-C"; path; "rev-parse"; "HEAD^{tree}" ] in 18 let config = Ogit.Config.{ default with git_project_root = root } in 19 let repository = 20 match Lwt_main.run (Ogit.Resolvers.open_repository config name) with 21 | Ok r -> r 22 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e 23 in 24 Fun.protect 25 ~finally:(fun () -> 26 Lwt_main.run (Ogit.Resolvers.close_repository repository)) 27 (fun () -> 28 match 29 Lwt_main.run (Ogit.Resolvers.Tree.find_path repository root_tree) 30 with 31 | Ok trail -> 32 Alcotest.(check (list (pair string string))) 33 "empty trail" [] trail 34 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e)) 35 36 let test_nested () = 37 with_temp_directory "ogit-paths" (fun root -> 38 let name = "project" in 39 let path = Filename.concat root name in 40 Unix.mkdir path 0o755; 41 ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]); 42 ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]); 43 ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]); 44 let dir = Filename.concat path "dir" in 45 Unix.mkdir dir 0o755; 46 Out_channel.with_open_text (Filename.concat dir "nested.txt") (fun ch -> 47 output_string ch "nested\n"); 48 ignore (git [ "-C"; path; "add"; "." ]); 49 ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]); 50 let nested_tree = git [ "-C"; path; "rev-parse"; "HEAD:dir" ] in 51 let nested_blob = 52 git [ "-C"; path; "rev-parse"; "HEAD:dir/nested.txt" ] 53 in 54 let config = Ogit.Config.{ default with git_project_root = root } in 55 let repository = 56 match Lwt_main.run (Ogit.Resolvers.open_repository config name) with 57 | Ok r -> r 58 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e 59 in 60 Fun.protect 61 ~finally:(fun () -> 62 Lwt_main.run (Ogit.Resolvers.close_repository repository)) 63 (fun () -> 64 match 65 Lwt_main.run (Ogit.Resolvers.Tree.find_path repository nested_blob) 66 with 67 | Ok trail -> 68 Alcotest.(check (list (pair string string))) 69 "nested trail" 70 [ ("dir", nested_tree); ("nested.txt", nested_blob) ] 71 trail 72 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e)) 73 74 let test_unreachable () = 75 with_temp_directory "ogit-paths" (fun root -> 76 let name = "project" in 77 let path = Filename.concat root name in 78 Unix.mkdir path 0o755; 79 ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]); 80 ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]); 81 ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]); 82 Out_channel.with_open_text (Filename.concat path "file.txt") (fun ch -> 83 output_string ch "data\n"); 84 ignore (git [ "-C"; path; "add"; "." ]); 85 ignore (git [ "-C"; path; "commit"; "-q"; "-m"; "init" ]); 86 let dangling_file = Filename.concat root "dangling.txt" in 87 Out_channel.with_open_text dangling_file (fun ch -> 88 output_string ch "dangling\n"); 89 let dangling_blob = 90 git [ "-C"; path; "hash-object"; "-w"; dangling_file ] 91 in 92 let config = Ogit.Config.{ default with git_project_root = root } in 93 let repository = 94 match Lwt_main.run (Ogit.Resolvers.open_repository config name) with 95 | Ok r -> r 96 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e 97 in 98 Fun.protect 99 ~finally:(fun () -> 100 Lwt_main.run (Ogit.Resolvers.close_repository repository)) 101 (fun () -> 102 match 103 Lwt_main.run 104 (Ogit.Resolvers.Tree.find_path repository dangling_blob) 105 with 106 | Error (Ogit.Resolvers.Not_found _) -> () 107 | Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e 108 | Ok _ -> Alcotest.fail "unreachable object should return Not_found")) 109 110 let suite = 111 ( "tree paths", 112 [ 113 Alcotest.test_case "root tree" `Slow test_root_tree; 114 Alcotest.test_case "nested path" `Slow test_nested; 115 Alcotest.test_case "unreachable object" `Slow test_unreachable; 116 ] ) 117