Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
7.5 kB · 229 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230module M = Merge_queue
let fix = M.Branch.v "fix"let staging = M.Branch.v "staging"let build = M.Check.name "build"let test = M.Check.name "test"let line p = Fmt.str "%a" M.Progress.pp plet lines ps = List.map line ps
let key = M.Key.of_tree (M.Tree.of_hash (Git.Hash.digest_string ~kind:`Tree "tree"))
let check ?(attempt = 1) ?(rerun = false) result seconds : M.Event.kind = M.Event.check ~key ~result ~seconds ~attempt ~rerun build
(* progress.mli, of_event: a run's take of the entry names the target it replays onto, a run's start names its checks, a run's end its result and time, and a rerun's start follows the run it reruns. *)let test_of_event () = Alcotest.(check (list string)) "a run's take" [ "replaying fix onto staging" ] (lines (M.Progress.of_event fix (Replaying { target = staging; onto = Mq_fixture.hash "tip" }))); Alcotest.(check (list string)) "a run's start" [ "checking fix: build test" ] (lines (M.Progress.of_event fix (Checking { target = staging; checks = [ build; test ]; batch = None }))); Alcotest.(check (list string)) "a run's end" [ "fix: check build passed (3s)" ] (lines (M.Progress.of_event fix (check M.Check.Passed 3))); Alcotest.(check (list string)) "a failure rerun" [ "fix: check build failed (1m5s)"; "rerunning fix: build once, to tell a flake from a red"; ] (lines (M.Progress.of_event fix (check ~rerun:true M.Check.Failed 65))); Alcotest.(check (list string)) "the rerun's red" [ "fix: check build failed again (4s): a red, not a flake" ] (lines (M.Progress.of_event fix (check ~attempt:2 M.Check.Failed 4))); Alcotest.(check (list string)) "the rerun's pass" [ "fix: check build passed on the rerun (4s): a flake, recorded" ] (lines (M.Progress.of_event fix (check ~attempt:2 M.Check.Passed 4))); Alcotest.(check (list string)) "any other kind says nothing" [] (lines (M.Progress.of_event fix (Run_started { run = "r"; mode = M.Note.Scheduled; command = "run" })))
(* progress.mli, pp: the land's start, its beat and its move. *)let test_lines () = Alcotest.(check string) "a land" "landing fix into staging: 2 commits" (line (Landing { branch = fix; target = staging; commits = 2; dry_run = false; source_of = None; })); Alcotest.(check string) "a dry run" "checking fix on staging: 1 commit" (line (Landing { branch = fix; target = staging; commits = 1; dry_run = true; source_of = None; })); Alcotest.(check string) "the lock commit alone" "landing fix into staging: the lock commit" (line (Landing { branch = fix; target = staging; commits = 0; dry_run = false; source_of = None; })); Alcotest.(check string) "into a base's source" "landing fix into staging, main's source: 1 commit" (line (Landing { branch = fix; target = staging; commits = 1; dry_run = false; source_of = Some (M.Branch.v "main"); })); let running ?past checks = line (Running { branch = fix; checks = { M.Progress.checks; past } }) in Alcotest.(check string) "the beat" "checking fix: build passed (40s), test running (12s)" (running [ ( build, Ended { result = M.Check.Passed; seconds = 40; attempt = 1; stopped = None; } ); (test, Running { attempt = 1; seconds = 12 }); ]); Alcotest.(check string) "the beat once every check ended" "checking fix: build passed (40s); past its checks for 33s" (running ~past:33 [ ( build, Ended { result = M.Check.Passed; seconds = 40; attempt = 1; stopped = None; } ); ]); Alcotest.(check string) "no check" "checking fix" (running []); Alcotest.(check string) "the move" "fast-forwarding staging to fix" (line (Moving { branch = fix; target = staging }))
(* progress.mli, checks: where each check stands, from the run's records, each phase with the seconds since it began, an ended run with its own time. A check held in its preparation names that phase. *)let test_checks () = let t0 = Option.get (Ptime.of_float_s 1_800_000_000.) in let at s = Option.get (Ptime.add_span t0 (Ptime.Span.of_int_s s)) in let started check attempt phase : M.Event.kind = M.Event.check_started ~check ~key ~attempt ~phase () in let story = [ ( at 0, M.Event.Checking { target = staging; checks = [ build; test ]; batch = None } ); (at 2, started build 1 M.Event.Preparing); ] in let said ~now story = Option.fold ~none:"none" ~some:(Fmt.str "%a" M.Progress.pp_checks) (M.Progress.checks ~now:(at now) story) in Alcotest.(check string) "no run" "none" (said ~now:5 []); Alcotest.(check string) "held in its preparation" "build preparing (28s), test waiting to start (30s)" (said ~now:30 story); let behind = story @ [ ( at 3, M.Event.slot_bent ~check:test ~key ~attempt:1 ~bend: (M.Order.Held { build = "sleep 36000"; hold = { since = t0; ends = at 3600 }; }) () ); ] in Alcotest.(check string) "waiting behind an mq slot" "build preparing (28s), test waiting to start behind mq slot (sleep 36000) \ since 2027-01-15T08:00:00Z, ends 2027-01-15T09:00:00Z (30s)" (said ~now:30 behind); let story = story @ [ (at 10, started build 1 M.Event.Running) ] in Alcotest.(check string) "its command runs" "build running (20s), test waiting to start (30s)" (said ~now:30 story); let story = story @ [ (at 12, check ~rerun:true M.Check.Failed 2); (at 13, started build 2 M.Event.Preparing); (at 14, started build 2 M.Event.Running); ] in Alcotest.(check string) "its rerun" "build running its rerun (16s), test waiting to start (30s)" (said ~now:30 story); let story = story @ [ (at 16, check ~attempt:2 M.Check.Passed 2); ( at 40, M.Event.check ~key ~result:M.Check.Failed ~seconds:20 ~attempt:2 ~rerun:false test ); ] in Alcotest.(check string) "each ended" "build passed (2s), test failed (20s); past its checks for 20s" (said ~now:60 story)
(* A line said as it is was made what a terminal shows where its text entered mq; the progress prints it byte for byte, so a control in a value built directly reaches the line. *)let test_line_printed_as_held () = List.iter (fun (what, raw, _) -> Alcotest.(check string) what raw (line (M.Progress.Line raw))) Mq_fixture.outside_text
let suite = ( "progress", [ Alcotest.test_case "a line is printed as held" `Quick test_line_printed_as_held; Alcotest.test_case "a journaled change of state" `Quick test_of_event; Alcotest.test_case "each line" `Quick test_lines; Alcotest.test_case "where each check stands" `Quick test_checks; ] )