Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
5.2 kB · 148 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149(* A target's queue as Murmuration orders a scheduler's queue (Vijayakumar, Madhavapeddy and Kalyvianaki, SoCC 2024, sections 3-4): the shortest job first with no preemption, a starved job first, and the independent tasks of the queue run at once. A land is a job; two lands are independent when their cones are disjoint, and only then. *)
module M = Merge_queuemodule Sim_queue = Merge_queue_sim.Sim_queue
let ms = 1000let long = M.Check.name "long"let short = M.Check.name "short"let estimates () = M.Order.estimates [ (long, 90 * ms); (short, 5 * ms) ]let duration c = M.Order.estimate (estimates ()) clet now = Ptime.epoch
let at s = match Ptime.add_span now (Ptime.Span.of_int_s s) with | Some t -> t | None -> assert false
let entry name ~at:s check cone = { M.Order.job = { branch = M.Branch.v name; arrived = at s; ready = [ check ] }; cone; }
let run policy queue = Sim_queue.run ~duration (estimates ()) ~now policy queue
let course ls name = match List.find_opt (fun (l : Sim_queue.course) -> M.Branch.equal l.branch (M.Branch.v name)) ls with | Some l -> l | None -> Alcotest.failf "%s is not in the queue" name
(* No two lands whose cones overlap are ever under check at once: the one checked second starts on a tip that holds the first. *)let serial_where_overlapping ls = List.iter (fun (a : Sim_queue.course) -> List.iter (fun (b : Sim_queue.course) -> if (not (M.Branch.equal a.branch b.branch)) && a.started_ms < b.landed_ms && b.started_ms < a.landed_ms && not (M.Cone.disjoint a.cone b.cone) then Alcotest.failf "%a and %a overlap and were checked at once" Sim_queue.pp a Sim_queue.pp b) ls) ls
(* A 90 s land queued first, then two 5 s lands a second later, the three cones disjoint. One at a time: 0-90, 90-95, 95-100 s, leads 90, 94, 99 s. Admitted: the two short ones start at 1 s on the tip the long one started on, land at 6 s, and the long one lands at 90 s: leads 90, 5, 5 s. *)let independent () = [ entry "long" ~at:0 long (M.Cone.dirs [ "a" ]); entry "s1" ~at:1 short (M.Cone.dirs [ "b" ]); entry "s2" ~at:1 short (M.Cone.dirs [ "c" ]); ]
let test_parallel () = let serial = run Serial (independent ()) in Alcotest.(check int) "one at a time: the mean lead" 94_333 (Sim_queue.mean_lead_ms serial); let ls = run Admit (independent ()) in let l = course ls "long" and s1 = course ls "s1" and s2 = course ls "s2" in Alcotest.(check (list int)) "admitted: the lands' landing" [ 90 * ms; 6 * ms; 6 * ms ] [ l.landed_ms; s1.landed_ms; s2.landed_ms ]; Alcotest.(check (list int)) "admitted: the short lands start on the long one's base" [ 0; 0; 0 ] [ l.base; s1.base; s2.base ]; Alcotest.(check int) "admitted: the mean lead" 33_333 (Sim_queue.mean_lead_ms ls); serial_where_overlapping ls
(* With no adapter every cone is the whole tree: the queue stays serial, the short lands by the shortest first once the long one has landed. *)let test_default_serial () = let ls = run Admit (List.map (fun (e : M.Order.entry) -> { e with cone = M.Cone.whole }) (independent ())) in Alcotest.(check (list int)) "whole cones: the lands' start" [ 0; 90 * ms; 95 * ms ] (List.map (fun (l : Sim_queue.course) -> l.started_ms) ls); serial_where_overlapping ls
(* [b] lies inside [a]'s cone: the 5 s land waits for the 90 s one to land and starts on the tip that holds it. *)let test_overlapping () = let ls = run Admit [ entry "a" ~at:0 long (M.Cone.dirs [ "a" ]); entry "b" ~at:1 short (M.Cone.dirs [ "a/b" ]); ] in let b = course ls "b" in Alcotest.(check (pair int int)) "b starts once a has landed, on its tip" (90 * ms, 1) (b.started_ms, b.base); serial_where_overlapping ls
(* A 90 s land and a stream of 5 s lands that overlap it, one arriving every 5 s from 0 to 295 s, so a shorter land is always queued. The long land is starved once it has waited more than twice its 90 s estimate: at 185 s, when the land under check since 180 s lands, and not at 180 s, when it has waited exactly twice. *)let test_starvation () = let shorts = List.init 60 (fun i -> entry (Fmt.str "s%02d" i) ~at:(5 * i) short (M.Cone.dirs [ "x/y" ])) in let ls = run Admit (entry "long" ~at:0 long (M.Cone.dirs [ "x" ]) :: shorts) in let l = course ls "long" in Alcotest.(check int) "the long land starts" (185 * ms) l.started_ms; Alcotest.(check bool) "its wait is at most twice its estimate and one short land" true (l.started_ms - l.arrived_ms <= (M.Order.starvation * 90 * ms) + (5 * ms)); serial_where_overlapping ls
let suite = ( "queue", [ Alcotest.test_case "independent lands are checked at once" `Quick test_parallel; Alcotest.test_case "the default cone keeps the queue serial" `Quick test_default_serial; Alcotest.test_case "overlapping lands stay serial" `Quick test_overlapping; Alcotest.test_case "the starvation bound holds" `Quick test_starvation; ] )