Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
5.8 kB · 142 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143(* Copyright (c) 2024-2026 Thomas Gazagnaire <thomas@gazagnaire.org>
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. *)
(* Spec for {!Git_eio.Pull.fast_forward}: advance the current branch to a fetched commit when that is a fast-forward, applying the change to the working tree without overwriting uncommitted edits, and leaving HEAD untouched on a non-fast-forward or an up-to-date pull. *)
let with_temp_repo = Test_helpers.with_temp_repolet commit = Test_helpers.commitlet unwrap = function Ok x -> x | Error (`Msg e) -> Alcotest.fail elet blob repo s = Git_eio.Repository.write_blob repo slet tree repo entries = Git_eio.Repository.write_tree repo (Git.Tree.v entries)let te name hash = Test_helpers.entry ~name hashlet save = Test_helpers.save_worklet read_file = Test_helpers.read_worktreelet set_head = Test_helpers.set_headlet hash = Test_helpers.hash
(* base tree: a=a0 b=b0 c=c0 fetched tree: a=a1 c=c1 d=d1 (b.txt removed) local edit : c.txt -> "c-local"
A fast-forward: a applied, c kept (locally edited), b deleted, d applied. Afterwards HEAD is the fetched commit and only c.txt is dirty. *)let test_fast_forward_preserves_edit () = with_temp_repo @@ fun sw fs root -> let repo = Git_eio.Repository.init ~sw ~fs root in let a0 = blob repo "a0" and b0 = blob repo "b0" and c0 = blob repo "c0" in let a1 = blob repo "a1" and c1 = blob repo "c1" and d1 = blob repo "d1" in let base = commit ~repo ~tree:(tree repo [ te "a.txt" a0; te "b.txt" b0; te "c.txt" c0 ]) ~parents:[] ~message:"base" in let fetched = commit ~repo ~tree:(tree repo [ te "a.txt" a1; te "c.txt" c1; te "d.txt" d1 ]) ~parents:[ base ] ~message:"fetched" in set_head ~repo ~fs ~root base; save ~fs ~root "c.txt" "c-local";
match unwrap (Git_eio.Pull.fast_forward repo ~fetched) with | Git_eio.Pull.Fast_forwarded r -> Alcotest.(check (list string)) "applied" [ "a.txt"; "d.txt" ] r.applied; Alcotest.(check (list string)) "kept" [ "c.txt" ] r.kept; Alcotest.(check (list string)) "deleted" [ "b.txt" ] r.deleted; Alcotest.(check (option hash)) "HEAD advanced to fetched" (Some fetched) (Git_eio.Repository.head repo); Alcotest.(check (option string)) "a.txt applied" (Some "a1") (read_file ~fs ~root "a.txt"); Alcotest.(check (option string)) "c.txt edit kept" (Some "c-local") (read_file ~fs ~root "c.txt"); Alcotest.(check (option string)) "b.txt deleted" None (read_file ~fs ~root "b.txt"); Alcotest.(check (option string)) "d.txt applied" (Some "d1") (read_file ~fs ~root "d.txt"); Alcotest.(check bool) "only c.txt dirty" true (Git_eio.Repository.is_path_dirty repo ~path:"c.txt"); Alcotest.(check bool) "a.txt clean against new HEAD" false (Git_eio.Repository.is_path_dirty repo ~path:"a.txt") | _ -> Alcotest.fail "expected Fast_forwarded"
(* Fetching the commit HEAD already points at is a no-op. *)let test_up_to_date () = with_temp_repo @@ fun sw fs root -> let repo = Git_eio.Repository.init ~sw ~fs root in let a0 = blob repo "a0" in let base = commit ~repo ~tree:(tree repo [ te "a.txt" a0 ]) ~parents:[] ~message:"base" in set_head ~repo ~fs ~root base;
Alcotest.(check bool) "outcome is up-to-date" true (match unwrap (Git_eio.Pull.fast_forward repo ~fetched:base) with | Git_eio.Pull.Up_to_date -> true | _ -> false); Alcotest.(check (option hash)) "HEAD unchanged" (Some base) (Git_eio.Repository.head repo)
(* A fetched commit that is not a descendant of HEAD is refused, touching nothing: not every fetch can fast-forward. *)let test_not_fast_forward () = with_temp_repo @@ fun sw fs root -> let repo = Git_eio.Repository.init ~sw ~fs root in let a0 = blob repo "a0" in let base = commit ~repo ~tree:(tree repo [ te "a.txt" a0 ]) ~parents:[] ~message:"base" in let local = commit ~repo ~tree:(tree repo [ te "a.txt" (blob repo "a-local") ]) ~parents:[ base ] ~message:"local" in let fetched = commit ~repo ~tree:(tree repo [ te "a.txt" (blob repo "a-remote") ]) ~parents:[ base ] ~message:"remote" in set_head ~repo ~fs ~root local; save ~fs ~root "a.txt" "a-local";
(match unwrap (Git_eio.Pull.fast_forward repo ~fetched) with | Git_eio.Pull.Not_fast_forward { local = l; fetched = f } -> Alcotest.(check hash) "local is HEAD" local l; Alcotest.(check hash) "fetched echoed" fetched f | _ -> Alcotest.fail "expected Not_fast_forward"); Alcotest.(check (option hash)) "HEAD untouched" (Some local) (Git_eio.Repository.head repo); Alcotest.(check (option string)) "working tree untouched" (Some "a-local") (read_file ~fs ~root "a.txt")
let suite = ( "pull", [ Alcotest.test_case "fast-forward preserves edit" `Quick test_fast_forward_preserves_edit; Alcotest.test_case "up to date" `Quick test_up_to_date; Alcotest.test_case "not a fast-forward" `Quick test_not_fast_forward; ] )