(* Copyright (c) 2024-2026 Thomas Gazagnaire Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) let pack_file = let ic = open_in_bin "pack-testzone-0.pack" in let len = in_channel_length ic in let data = really_input_string ic len in close_in ic; data let index_file = let ic = open_in_bin "pack-testzone-0.idx" in let len = in_channel_length ic in let data = really_input_string ic len in close_in ic; data let test_header () = match Git.Pack.of_string pack_file with | Ok pack -> Alcotest.(check int) "version" 2 (Git.Pack.version pack); (* pack-testzone-0 has 192 objects *) Alcotest.(check int) "count" 192 (Git.Pack.count pack) | Error (`Msg m) -> Alcotest.fail m let test_read_first_object () = match Git.Pack.of_string pack_file with | Ok pack -> ( (* Read first object at offset 12 (after header) *) match Git.Pack.read_object_at pack 12 with | Ok (kind, data) -> (* Just verify we got some data *) Alcotest.(check bool) "has data" true (String.length data > 0); Alcotest.(check bool) "valid kind" true (match kind with `Commit | `Tree | `Blob | `Tag -> true) | Error (`Msg m) -> Alcotest.fail m) | Error (`Msg m) -> Alcotest.fail m let test_zlib_inflate () = (* Simple zlib test - compress and decompress *) let original = "Hello, World! This is a test string for zlib compression." in (* Create zlib-compressed data *) let compressed = let reader = Bytesrw.Bytes.Reader.of_string original in let compressed_reader = Bytesrw_zlib.Zlib.compress_reads () reader in Bytesrw.Bytes.Reader.to_string compressed_reader in match Git.Pack.inflate compressed with | Ok decompressed -> Alcotest.(check string) "roundtrip" original decompressed | Error (`Msg m) -> Alcotest.fail m let test_delta () = (* Test delta application with a simple example *) let source = "Hello, World!" in (* Delta format: source_size, target_size, then commands *) (* Source size = 13 (0x0D), Target size = 14 (0x0E) *) (* Command: COPY offset=0, size=13: cmd=0x90 (0x80|0x10), size=0x0D *) (* - bit 7 (0x80): COPY command - bit 4 (0x10): size byte 0 present - offset is 0 by default (no offset bytes) *) (* Command: INSERT 1 byte '!' = 0x01 '!' *) let delta = String.concat "" [ "\x0D"; (* source size = 13 *) "\x0E"; (* target size = 14 *) "\x90\x0D"; (* COPY: cmd=0x90, size=13 *) "\x01!"; (* INSERT: 1 byte '!' *) ] in match Git.Pack.apply_delta ~source ~delta with | Ok target -> Alcotest.(check string) "delta applied" "Hello, World!!" target | Error (`Msg m) -> Alcotest.fail m let test_fold () = (* Test that fold iterates over all objects exactly once *) match Git.Pack.of_string pack_file with | Ok pack -> ( let result = Git.Pack.fold (fun ~offset ~kind ~data acc -> Alcotest.(check bool) "has data" true (String.length data > 0); Alcotest.(check bool) "valid offset" true (offset >= 12); Alcotest.(check bool) "valid kind" true (match kind with `Commit | `Tree | `Blob | `Tag -> true); acc + 1) 0 pack in match result with | Ok count -> Alcotest.(check int) "fold count matches header" 192 count | Error (`Msg m) -> Alcotest.fail m) | Error (`Msg m) -> Alcotest.fail m let test_fold_matches_index () = (* Verify fold visits objects at the same offsets as the index *) match (Git.Pack.of_string pack_file, Git.Pack_index.of_string index_file) with | Ok pack, Ok idx -> (* Collect all offsets from fold *) let fold_offsets = match Git.Pack.fold (fun ~offset ~kind:_ ~data:_ acc -> offset :: acc) [] pack with | Ok offsets -> List.sort compare offsets | Error (`Msg m) -> Alcotest.fail m in (* Collect all offsets from index *) let index_offsets = let offsets = ref [] in Git.Pack_index.iter (fun ~hash:_ ~offset ~crc:_ -> offsets := offset :: !offsets) idx; List.sort compare !offsets in Alcotest.(check int) "same count" (List.length index_offsets) (List.length fold_offsets); Alcotest.(check (list int)) "same offsets" index_offsets fold_offsets | Error (`Msg m), _ -> Alcotest.fail ("pack: " ^ m) | _, Error (`Msg m) -> Alcotest.fail ("index: " ^ m) (* Helper to run git commands in a directory *) let run_git dir args = let cmd = String.concat " " ([ "git"; "-C"; dir ] @ List.map Filename.quote args @ [ "2>/dev/null" ]) in let ic = Unix.open_process_in cmd in let output = In_channel.input_all ic in let _ = Unix.close_process_in ic in String.trim output let test_from_git () = (* Create a fresh repo with git, generate a pack, and verify we can read it *) let tmp_dir = Filename.temp_dir "git_pack_test" "" in Fun.protect ~finally:(fun () -> ignore (Sys.command ("rm -rf " ^ tmp_dir))) (fun () -> (* Initialize repo *) ignore (run_git tmp_dir [ "init" ]); ignore (run_git tmp_dir [ "config"; "user.email"; "test@test.com" ]); ignore (run_git tmp_dir [ "config"; "user.name"; "Test" ]); (* Create some content *) let file1 = Filename.concat tmp_dir "file1.txt" in let file2 = Filename.concat tmp_dir "file2.txt" in let oc = open_out file1 in output_string oc "Hello, World!\n"; close_out oc; ignore (run_git tmp_dir [ "add"; "file1.txt" ]); ignore (run_git tmp_dir [ "commit"; "-m"; "First commit" ]); (* Second commit *) let oc = open_out file2 in output_string oc "Second file content\n"; close_out oc; ignore (run_git tmp_dir [ "add"; "file2.txt" ]); ignore (run_git tmp_dir [ "commit"; "-m"; "Second commit" ]); (* Create pack file *) ignore (run_git tmp_dir [ "gc"; "--aggressive" ]); (* Find the pack file *) let pack_dir = Filename.concat tmp_dir ".git/objects/pack" in let files = Sys.readdir pack_dir in let pack_file_path = Array.to_list files |> List.find (fun f -> Filename.check_suffix f ".pack") |> Filename.concat pack_dir in (* Read and parse the pack *) let ic = open_in_bin pack_file_path in let data = In_channel.input_all ic in close_in ic; match Git.Pack.of_string data with | Ok pack -> ( (* Should have at least: 2 commits, 2 trees, 2 blobs *) Alcotest.(check bool) "has objects" true (Git.Pack.count pack >= 4); (* Verify we can fold over all objects *) let result = Git.Pack.fold (fun ~offset:_ ~kind:_ ~data acc -> acc + String.length data) 0 pack in match result with | Ok total_size -> Alcotest.(check bool) "has content" true (total_size > 0) | Error (`Msg m) -> Alcotest.fail ("fold: " ^ m)) | Error (`Msg m) -> Alcotest.fail m) let test_with_deltas () = (* Create objects that will result in delta encoding *) let tmp_dir = Filename.temp_dir "git_delta_test" "" in Fun.protect ~finally:(fun () -> ignore (Sys.command ("rm -rf " ^ tmp_dir))) (fun () -> (* Initialize repo *) ignore (run_git tmp_dir [ "init" ]); ignore (run_git tmp_dir [ "config"; "user.email"; "test@test.com" ]); ignore (run_git tmp_dir [ "config"; "user.name"; "Test" ]); (* Create a large file that will be delta-compressed when modified *) let file = Filename.concat tmp_dir "large.txt" in let oc = open_out file in let ppf = Format.formatter_of_out_channel oc in (* Write 10KB of content - enough to trigger delta compression *) for i = 1 to 500 do Fmt.pf ppf "Line %d: This is some repetitive content.\n" i done; Format.pp_print_flush ppf (); close_out oc; ignore (run_git tmp_dir [ "add"; "large.txt" ]); ignore (run_git tmp_dir [ "commit"; "-m"; "Add large file" ]); (* Modify just a few lines - this will create a delta *) let oc = open_out file in let ppf = Format.formatter_of_out_channel oc in for i = 1 to 500 do if i = 250 then Fmt.pf ppf "Line %d: MODIFIED CONTENT HERE!\n" i else Fmt.pf ppf "Line %d: This is some repetitive content.\n" i done; Format.pp_print_flush ppf (); close_out oc; ignore (run_git tmp_dir [ "add"; "large.txt" ]); ignore (run_git tmp_dir [ "commit"; "-m"; "Modify large file" ]); (* Create pack with aggressive delta compression *) ignore (run_git tmp_dir [ "repack"; "-a"; "-d"; "--depth=50"; "--window=250" ]); (* Find and read the pack *) let pack_dir = Filename.concat tmp_dir ".git/objects/pack" in let files = Sys.readdir pack_dir in let pack_file_path = Array.to_list files |> List.find (fun f -> Filename.check_suffix f ".pack") |> Filename.concat pack_dir in let ic = open_in_bin pack_file_path in let data = In_channel.input_all ic in close_in ic; match Git.Pack.of_string data with | Ok pack -> ( (* Fold should handle deltas correctly *) let blobs = ref [] in let result = Git.Pack.fold (fun ~offset:_ ~kind ~data acc -> (match kind with `Blob -> blobs := data :: !blobs | _ -> ()); acc + 1) 0 pack in match result with | Ok count -> Alcotest.(check bool) "parsed all" true (count >= 4); (* Verify we got the blob content *) let has_line_content = List.exists (fun b -> String.length b > 5 && String.sub b 0 5 = "Line ") !blobs in Alcotest.(check bool) "found blob content" true has_line_content | Error (`Msg m) -> Alcotest.fail ("fold: " ^ m)) | Error (`Msg m) -> Alcotest.fail m) let tests = [ Alcotest.test_case "header" `Quick test_header; Alcotest.test_case "read_first_object" `Quick test_read_first_object; Alcotest.test_case "zlib_inflate" `Quick test_zlib_inflate; Alcotest.test_case "delta" `Quick test_delta; Alcotest.test_case "fold" `Quick test_fold; Alcotest.test_case "fold_matches_index" `Quick test_fold_matches_index; Alcotest.test_case "from_git" `Slow test_from_git; Alcotest.test_case "with_deltas" `Slow test_with_deltas; ] let suite = ("pack", tests)