Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
8.5 kB · 217 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218(* Sync against its invariants (lib/sync.mli): a start follows a reading that is due, the DAG, the rules branch or a copy holding other commits than when the last sync started and no sync running; a reading follows the run's start, an append to the journal or the end of the run's work; no [[sync]] section, or no scheduler, starts nothing. *)
module M = Merge_queueopen Mq_fixture
let rules_with extra = match M.Rules.of_string (M.Rules.to_string staging_main ^ extra) with | Ok r -> r | Error (`Msg m) -> Alcotest.fail m
let rules = rules_with "\n[sync]\n"let pass rules = { M.Work.rules; rules_commit = hash "rules"; settled = [] }let mq = Fpath.v "/home/bin/mq"let at s = Option.get (Ptime.add_span now (Ptime.Span.of_int_s s))
let ok = function | Ok s -> s | Error e -> Alcotest.failf "%a" M.Machine.pp_error e
let shown = List.map (function | M.Sync.Read_last bs -> "read " ^ String.concat " " (List.map M.Branch.to_string bs) | Start (p, _) -> "start " ^ Fpath.to_string p)
let lines = Alcotest.(list string)
let started ?(mq = Some mq) rules = ok (M.Sync.run_started (M.Sync.v { mq; rules = M.Branch.rules }) ~now (Ok (pass rules)))
let read_all = "read main mq/config staging"
let last ?(running = false) ?(failed = false) s = { M.Sync.started = at s; running; failed }
(* main at the commit [c], and origin's copy of it at [copy]. *)let tip ?copy c = (M.Ref_name.branch (M.Branch.v "main"), hash c) :: Option.fold ~none:[] ~some:(fun c -> [ ( M.Ref_name.remote (M.Ref_name.Tracking.v ~remote:"origin" (M.Branch.v "main")), hash c ); ]) copy
(* the rules branch at the commit [c]. *)let reading ?last ?(tips = []) ?synced () = M.Sync.Read { last; tips; synced }
let none () = let t, actions = started staging_main in Alcotest.check lines "no [sync]: nothing" [] (shown actions); Alcotest.(check (option int)) "it ends at once" (Some 0) (Option.map (fun (r : M.Sync.report) -> r.started) (M.Sync.ending t)); let t, actions = started ~mq:None rules in Alcotest.check lines "no scheduler: nothing" [] (shown actions); Alcotest.(check bool) "it ends at once" true (M.Sync.ending t <> None)
(* A landing is pushed as it lands: the run's start reads the moves of the rules branch and the branches the rules name, a sync starts on the first move, and the next reading follows the next append to the journal, not a timer. *)let first () = let t, actions = started rules in Alcotest.check lines "the moves are read" [ read_all ] (shown actions); let t, actions = ok (M.Sync.incoming t ~now (reading ~tips:(tip "a") ())) in Alcotest.check lines "none yet: one starts" [ "start /home/bin/mq" ] (shown actions); let t, actions = ok (M.Sync.incoming t ~now (Started (Ok ()))) in Alcotest.check lines "nothing more" [] (shown actions); Alcotest.(check (option string)) "no timer" None (Option.map (Fmt.to_to_string (Ptime.pp_rfc3339 ())) (M.Sync.next_timeout t)); let t, actions = ok (M.Sync.timer t ~now:(at 3600)) in Alcotest.check lines "nothing an hour on" [] (shown actions); let t = M.Sync.appended t ~now:(at 10) in let t, actions = ok (M.Sync.timer t ~now:(at 10)) in Alcotest.check lines "read again once the journal grows" [ read_all ] (shown actions); let t, actions = ok (M.Sync.incoming t ~now:(at 10) (reading ~last:(last 0) ~synced:(tip "a") ~tips:(tip "b") ())) in Alcotest.check lines "a landing since: the next one starts" [ "start /home/bin/mq" ] (shown actions); let t, _ = ok (M.Sync.incoming t ~now:(at 10) (Started (Ok ()))) in let t, actions = ok (M.Sync.alone t ~now:(at 11)) in Alcotest.check lines "the run's end reads once more" [ read_all ] (shown actions); let t, actions = ok (M.Sync.incoming t ~now:(at 11) (reading ~last:(last 10) ~synced:(tip "b") ~tips:(tip "b") ())) in Alcotest.check lines "nothing moved since: nothing" [] (shown actions); Alcotest.(check (option int)) "two started" (Some 2) (Option.map (fun (r : M.Sync.report) -> r.started) (M.Sync.ending t))
(* doc/configuration.md, "Sync": a sync is due when the DAG or its copy holds other commits than when the last sync started, whatever the time of either (a reflog's time is to the second, and a push in the second a sync started decided wrongly); a sync that failed is started again at a run's first reading, whatever moved. *)let due () = let due ?(first = false) ?last ?(tips = []) ?synced () = M.Sync.due ~first { last; tips; synced } in Alcotest.(check bool) "nothing, none yet" false (due ()); Alcotest.(check bool) "a branch, none yet" true (due ~tips:(tip "a") ()); Alcotest.(check bool) "the tips it started from" false (due ~last:(last 10) ~synced:(tip "a") ~tips:(tip "a") ()); Alcotest.(check bool) "a branch moved since" true (due ~last:(last 10) ~synced:(tip "a") ~tips:(tip "b") ()); Alcotest.(check bool) "a copy moved since" true (due ~last:(last 10) ~synced:(tip ~copy:"a" "b") ~tips:(tip ~copy:"b" "b") ()); Alcotest.(check bool) "a copy made since" true (due ~last:(last 10) ~synced:(tip "a") ~tips:(tip ~copy:"a" "a") ()); Alcotest.(check bool) "none recorded" true (due ~last:(last 10) ~tips:(tip "a") ()); Alcotest.(check bool) "still running" false (due ~last:(last ~running:true 10) ~synced:(tip "a") ~tips:(tip "b") ()); Alcotest.(check bool) "failed: tried again at a run's first reading" true (due ~first:true ~last:(last ~failed:true 10) ~synced:(tip "a") ~tips:(tip "a") ()); Alcotest.(check bool) "failed: not again within the run" false (due ~last:(last ~failed:true 10) ~synced:(tip "a") ~tips:(tip "a") ()); Alcotest.(check bool) "failed, still running" false (due ~first:true ~last:(last ~running:true ~failed:true 10) ())
let not_due () = let read r = let t, _ = started rules in let _, actions = ok (M.Sync.incoming t ~now:(at 600) r) in shown actions in Alcotest.check lines "nothing moved since: none" [] (read (reading ~last:(last 480) ~synced:(tip "a") ~tips:(tip "a") ())); Alcotest.check lines "moved, but still running: none" [] (read (reading ~last:(last ~running:true 0) ~synced:(tip "a") ~tips:(tip "b") ())); Alcotest.check lines "moved and ended: one" [ "start /home/bin/mq" ] (read (reading ~last:(last 0) ~synced:(tip "a") ~tips:(tip "b") ()))
let ended t = Option.map (fun (r : M.Sync.report) -> r.started) (M.Sync.ending t)
let at_end () = let t, _ = started rules in let t, actions = ok (M.Sync.alone t ~now) in Alcotest.check lines "the reading under way answers" [] (shown actions); Alcotest.(check (option int)) "not ended yet" None (ended t); let t, actions = ok (M.Sync.incoming t ~now (reading ~tips:(tip "a") ())) in Alcotest.check lines "a sync due starts" [ "start /home/bin/mq" ] (shown actions); let t, actions = ok (M.Sync.incoming t ~now (Started (Ok ()))) in Alcotest.check lines "then nothing" [] (shown actions); Alcotest.(check (option int)) "one started, and it ends" (Some 1) (ended t); let t, _ = started rules in let t, _ = ok (M.Sync.alone t ~now) in let t, actions = ok (M.Sync.incoming t ~now (reading ~last:(last 0) ~synced:(tip "a") ~tips:(tip "a") ())) in Alcotest.check lines "none due: nothing" [] (shown actions); Alcotest.(check (option int)) "none started, and it ends" (Some 0) (ended t)
let section () = Alcotest.(check bool) "[sync] reads back" true (match M.Rules.of_string (M.Rules.to_string rules) with | Ok r -> r.sync | Error (`Msg m) -> Alcotest.fail m); match M.Rules.of_string (M.Rules.to_string staging_main ^ "\n[sync]\nevery = \"5m\"\n") with | Ok _ -> Alcotest.fail "sync.every was accepted" | Error (`Msg m) -> Alcotest.(check string) "a key refused by name" "sync takes no key, and has \"every\"" m
let suite = ( "sync", [ Alcotest.test_case "no [sync], no scheduler" `Quick none; Alcotest.test_case "a sync as the DAG moves" `Quick first; Alcotest.test_case "a move since the last sync" `Quick due; Alcotest.test_case "a sync not due" `Quick not_due; Alcotest.test_case "a run that ends as it reads" `Quick at_end; Alcotest.test_case "the [sync] section" `Quick section; ] )