Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
8.8 kB · 235 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236open Merge_queue
(* doc/machines.md, "Offline first": what a pull does to one branch against the value this machine last saw on the remote, and the block it ends in. *)
let b = Branch.vlet c n = Commit.of_hash (Git.Hash.of_hex (String.make 40 n))let short (v : Commit.t) = String.sub (Git.Hash.to_hex (v :> Git.Hash.t)) 0 1
let landing ?(pinned = false) ?(taken = false) name landed since = { Pull.submission = Submission.v ~description:Description.empty []; name = b name; landed = c landed; since = c since; pinned; taken; }
(* History: 0 <- s (seen) <- 1 <- 2 (local: two landings, fa1 and fa2); the remote moved s <- a. *)let facts ?(local = Some (c '2')) ?(agreed = Some (c 'a')) ?(seen = Some (c '5')) ?(contains = [ (c '5', c '2'); (c '5', c 'a') ]) ?(landings = [ landing "fa1" '1' '5'; landing "fa2" '2' '1' ]) ?tracking ?(foreign = 0) ?(tags = []) () = let tracking = match tracking with Some t -> t | None -> seen in { Pull.branch = b "main"; remote = "origin"; local; agreed; seen; tracking; contains; landings; foreign; tags; checkouts = []; pulled = 1; serial = 1; }
let pp_write = function | Pull.Rescue { serial; commit; _ } -> Fmt.str "rescue %d at %s" serial (short commit) | Requeue { entry; _ } -> Fmt.str "requeue %a %s since %s" Branch.pp entry.name (short entry.tip) (short entry.since) | Reset { expected; value; _ } -> Fmt.str "reset %s to %s" (Option.fold ~none:"none" ~some:short expected) (short value) | Seen { value; _ } -> Fmt.str "seen %s" (short value) | Track { branch; remote } -> Fmt.str "track %s/%a" remote Branch.pp branch
let check ?named name expected f = match Pull.reconcile f with | Ok (writes, _, n) -> Alcotest.(check (list string)) name expected (List.map pp_write writes); Option.iter (fun affix -> Alcotest.(check bool) affix true (Option.fold ~none:false ~some:(fun n -> Astring.String.is_infix ~affix n) n)) named | Error o -> Alcotest.failf "%a" Outcome.pp o
let refused ~affix f = match Pull.reconcile f with | Error o -> Alcotest.(check int) "refused" 2 (Outcome.exit o); Alcotest.(check bool) (Outcome.first_line o) true (Astring.String.is_infix ~affix (Outcome.first_line o)); o | Ok _ -> Alcotest.fail "not refused"
(* "When both sides have moved, the local staging takes the agreed copy's value ... The landings this machine made since the last value it saw there go back through the queue in the order they landed": each pinned before the branch is taken back, so a pull cut there leaves them queued. *)let test_diverged () = check "writes" [ "requeue fa1 1 since 5"; "requeue fa2 2 since 1"; "reset 2 to a"; "seen a"; ] (facts ()); match Pull.reconcile (facts ()) with | Ok (_, replays, _) -> Alcotest.(check (list string)) "replays" [ "fa1"; "fa2" ] (List.map (fun (r : Pull.replay) -> Branch.to_string r.name) replays) | Error o -> Alcotest.failf "%a" Outcome.pp o
(* "When this machine has nothing of its own on a branch, the branch fast-forwards"; a branch ahead of a remote that still holds what this machine saw moves nothing; a branch this machine lacks is created, tracking the remote's, as Git sets up a branch made from a remote-tracking branch. *)let test_fast_forward () = check "behind" [ "reset 5 to a"; "seen a" ] (facts ~local:(Some (c '5')) ~landings:[] ()); check "ahead" [] (facts ~agreed:(Some (c '5')) ~landings:[] ~contains:[ (c '5', c '2') ] ()); check "absent" [ "reset none to a"; "track origin/main"; "seen a" ] (facts ~local:None ~landings:[] ())
(* A pull cut after it pinned a landing does not pin it twice; a name a newer branch took comes back as NAME-returned. *)let test_requeued_once () = check "pinned and taken" [ "requeue fa2-returned 2 since 1"; "reset 2 to a"; "seen a" ] (facts ~landings: [ landing ~pinned:true "fa1" '1' '5'; landing ~taken:true "fa2" '2' '1'; ] ())
(* "A commit that the agreed copy held at the last pull and holds no longer ... The pull names it, keeps it reachable under refs/mq/rescue/ and does not replay it." *)let test_rescue () = check ~named:"kept at refs/mq/rescue/origin/main.1" "writes" [ "rescue 1 at 5"; "requeue fa1 1 since 5"; "requeue fa2 2 since 1"; "reset 2 to a"; "seen a"; ] (facts ~contains:[ (c '5', c '2') ] ())
(* "A branch of the DAG deleted on the remote is named by the next pull, which moves nothing." *)let test_deleted () = check ~named:"main was deleted on origin" "nothing" [] (facts ~agreed:None ())
(* A pull that cannot establish the last value it saw refuses and replays nothing it cannot prove its own; so does one that meets a commit that is not this machine's landing, and one that would replay a tagged commit. *)let test_refused () = ignore (refused ~affix:"no record of the value it last saw" (facts ~seen:None ())); ignore (refused ~affix:"1 commit on main" (facts ~foreign:1 ())); let o = refused ~affix:"v1 tags a commit" (facts ~tags:[ "v1" ] ()) in Alcotest.(check (option string)) "next" (Some "git tag -d v1") o.next
(* A machine where mq has not pulled or pushed yet has no record under refs/mq/seen/: what it last saw there is the remote-tracking branch, as Git fetched it, and the record is created by compare-and-swap from nothing. *)let test_tracking () = check "writes" [ "requeue fa1 1 since 5"; "requeue fa2 2 since 1"; "reset 2 to a"; "seen a"; ] (facts ~seen:None ~tracking:(Some (c '5')) ()); match Pull.reconcile (facts ~seen:None ~tracking:(Some (c '5')) ()) with | Ok (writes, _, _) -> Alcotest.(check (list (option string))) "the record's expected value" [ None ] (List.filter_map (function | Pull.Seen { seen; _ } -> Some (Option.map short seen) | _ -> None) writes) | Error o -> Alcotest.failf "%a" Outcome.pp o
let replay name = { Pull.name = b name; target = b "main"; was = c '1' }
(* "The call ends in one outcome block, with exit 1 when any landing needs work", and the landings array names the commit each was and became. *)let test_summary () = let landed = Outcome.v Outcome.Landed "fa1" in let red = Outcome.v Outcome.Needs_work "check test failed" in let o = Pull.summary ~remote:"origin" ~pulled:2 [ (replay "fa1", landed, Some (c '7'), None); (replay "fb", red, None, Some (b "fb")); ] in Alcotest.(check int) "exit" 1 (Outcome.exit o); Alcotest.(check string) "line" "needs_work: pulled 2 commits from origin; of yours, 1 landed again and 1 \ needs work" (Outcome.first_line o); Alcotest.(check (option string)) "next" (Some "mq land fb") o.next; Alcotest.(check (list (option string))) "became" [ Some "7"; None ] (List.map (fun (l : Outcome.landing) -> Option.map short l.became) o.landings); let o = Pull.summary ~remote:"origin" ~pulled:2 [ (replay "fa1", landed, None, None) ] in Alcotest.(check int) "exit" 0 (Outcome.exit o)
(* A signal leaves the landings still to land again queued: the outcome counts them and names the land of the first. *)let test_interrupted () = let o = Pull.interrupted [ replay "fb"; replay "fc" ] in Alcotest.(check int) "exit" 130 (Outcome.exit o); Alcotest.(check string) "line" "interrupted: the pull was interrupted: 2 landings stay queued on the new \ tip" (Outcome.first_line o); Alcotest.(check (option string)) "next" (Some "mq land fb") o.next; Alcotest.(check string) "one" "interrupted: the pull was interrupted: 1 landing stays queued on the new \ tip" (Outcome.first_line (Pull.interrupted [ replay "fc" ]))
let suite = ( "pull", [ Alcotest.test_case "diverged: replayed in order" `Quick test_diverged; Alcotest.test_case "behind, ahead, absent" `Quick test_fast_forward; Alcotest.test_case "requeued once, under a free name" `Quick test_requeued_once; Alcotest.test_case "a dropped commit is rescued" `Quick test_rescue; Alcotest.test_case "a deleted branch is named" `Quick test_deleted; Alcotest.test_case "refused" `Quick test_refused; Alcotest.test_case "the remote-tracking branch, before a record" `Quick test_tracking; Alcotest.test_case "the block" `Quick test_summary; Alcotest.test_case "interrupted" `Quick test_interrupted; ] )