Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
22 kB · 422 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423(** The checks of one land: which results are reused, which checks run, and what they say together.
A tree is checked for a branch when every check that branch lists passed on that exact tree (doc/rules.md, "A tree is checked"). For each check the results stored under the tree's key give a verdict ({!Results.verdict}): a pass is reused, a confirmed red is printed again without running that check, and anything else runs the check ({!Check_run}); [--retry] asks every check to run whatever the notes say, and a check whose result is not a fact about its tree alone ({!Check.reusable}: the [rules] check) always runs. Each finished run is recorded as a note line ({!Note}) and a journal record; a check named in the outcome as reused names the machine whose result it reused.
The results are written under Git's lock of [refs/notes/mq-checks], so a check never runs before mq knows it can record its result: a lock found on that ref before any check runs is either the commit of mq's own append on the ref's value, which a killed run left and the run lock proves stale, and is removed, or another writer's, and the checks end stuck at once, naming it. A result that could not be recorded after all is said in the outcome, and the checks go on: the tree was checked, and the next land of it checks it again.
The checks of a land run side by side, each in a worktree of its own, as many at once as the repository has build slots ([slots]), started shortest estimate first ({!Order.v}), ties in the order the branch lists them, and each run waits for a build slot ({!Check_run}); a failure's rerun comes at once, in its check's place. A confirmed red, stored or run now, alone stops no other check: every check runs to its verdict, the checks not started yet still start, and the ending, once the last ends, is red and names each red and the checks that passed. Once other work waits for what those checks hold, the run gives the checks a {!constructor-Give_way}: the confirmed red decides the ending, the runs under way are stopped, each keeping its log and its journal record, and the checks not started never start. A check red only as the target's tip is, inherited, is a red that is not the change's: the ending is red when another check is a confirmed red, and otherwise base red, which holds the land rather than charging it. A check stuck at its wall, or one that could not run, ends them stuck, naming the confirmed reds already known: that stops every run under way, and the checks not started yet never start. A run stopped under way has its journal record and no note: its result is {!Check.constructor-Stopped}, with why mq stopped it, which is also the last line of its log. The dependency generations every check reads ({!field-prerequisites}) are ensured first, once, so that no check waits on another's preparation of them. The checks end once the preparation they asked for, every run they stopped and every note they asked for have answered, so nothing they started answers after their end, when the land that owned them is over.
Invariants, over every trace: - a check with a reusable pass never runs, unless [--retry]; - a check runs only once no lock of another writer holds the notes ref; - every finished run of a check is asked to be recorded once, and the ending waits for every answer; - but for [Withdrawn], the ending waits for the answer of every run it stopped and of the preparation it asked for; - the ending is [Passed] iff every check has a pass, reused or run; - the ending is [Base_red] iff no check is a confirmed red, none stuck, and at least one is inherited ({!Check_run.constructor-Inherited}); - a confirmed red, stored or run now, stops no run and keeps no check from starting, until a {!constructor-Give_way}, but with {!field-first_red} or {!field-stored_red_ends}; - a stored confirmed red with {!field-gives_way} starts no run, and the ending is {!constructor-Red}, naming the checks it left unstarted; - the ending waits for the answer of every stored log it asked for, and each stored red carries the log of its own note; - a {!constructor-Give_way} with no confirmed red changes nothing; with one, no run starts after it, every run under way is stopped, and the ending is {!constructor-Red}, naming the checks it stopped or left unstarted; - at most [slots] checks run at once, and a check starts only once every check {!Order.v} places before it has started; - with prerequisites, they are asked for once and no check starts before {!constructor-Prepared}; {!constructor-Unprepared} ends the checks stuck once, busy when a lease was held past its wait, and none starts; an ending decided before either answers stands; - after [Cancelled] no run starts; - after [Drain] no run starts, and every run under way goes on to its verdict and is recorded; - every run started under way has one journal record, a run stopped included, and a stopped run asks for no note; - once the ending is decided, no run is under way and none starts. *)
(** {1:inputs Inputs} *)
type append = { message : string; (** The message of the commit the lock holds. *) on_tip : bool; (** Whether that commit's parents are the notes ref's value: none when the ref is absent. *)}(** The type for the commit a lock on the notes ref holds. *)
type notes_lock = { held : Settle.held; append : append option; (** The commit it holds, when it holds one. *)}(** The type for a lock found on [refs/notes/mq-checks]. *)
val stale : notes_lock -> bool(** [stale l] is [true] iff [l] is the lock of an append of mq's own that a killed process left before its move: it holds a commit whose message {!Note.is_commit_message} reads, on the ref's value. Only the holder of the run lock writes such a commit, so a run that holds the lock knows nobody else does. *)
type request = { checks : Check.t list; (** The checks the target lists, in its order. *) key : Key.t; (** The key of the tree under check. *) notes : Note.t list; (** The results stored under {!field-key}. *) scripts : (Check.name * string) list; (** The digest of each hook script the build configuration covers. *) inputs : (Check.name * (string * Commit.t option) list) list; (** The commit of each input of each check that declares inputs, by the input's name ({!Check.commits}): the build configuration covers them, and the check is given them. *) logs : (Check.name * int * Fpath.t) list; (** The logs of past runs still on this machine, by check and attempt. *) notes_lock : notes_lock option; leftovers : Fpath.t list; (** The check worktrees found under the pool's [.check/] directory under the run lock: a run that was killed left them, since only the holder of the run lock makes one. *) retry : bool; (** [--retry]: every check runs, whatever the notes say. *) first_red : bool; (** Whether the checks end at their first confirmed red, the runs under way stopped and the checks not started dropped: a batch's tree, or a probe of its bisection, whose verdict is the conjunction of its checks and which no land reads beside that red. A land's checks each run to their verdict. *) stored_red_ends : bool; (** Whether a stored confirmed red ends the checks at once, none run: a probe of a land's bisection, whose search reads a prefix's stored red as its verdict. A land's checks with no stored verdict run beside a stored red. {!field-first_red} implies it. *) gives_way : string option; (** The work that waits for the land's build slots, said as why ([2 lands wait]), when the checks begin: a stored confirmed red then decides the ending at once, as a {!constructor-Give_way} would, and no check with no stored verdict starts. *) mode : Note.mode; machine : Host.t; (** The machine the results are recorded as made on. *) platform : Platform_name.t; (** The platform the results are recorded as made on, and the one a check's requirement is read from. *) supported : Platform_name.t list option; (** The platforms the rules support ({!Rules.t.platforms}): only results on one of them count. *) rules : Commit.t; (** The commit of the rules judging the tree. *) commit : Commit.t; (** The replayed commit, whose tree is checked. *) target : Branch.t; target_tip : Commit.t; (** The target's commit the tree was replayed onto. *) scope : Commit.t option; (** The commit whose change from {!field-target_tip} scopes the checks, when it is not {!field-commit}'s own: the head of the range a probe of the target's own tip bisects, so a check scoped by the change builds the range's paths on the target's tree, never the empty change of a tree with itself ([MQ_SCOPE_TIP]). Part of the results' key ({!Build_config}). *) check_wall : int; (** [bounds.check_wall]: a check's wall unless its own. *) grace : int; (** [bounds.check_grace]. *) memory : int; (** [bounds.check_memory]. *) slot_wait : int; (** [bounds.wait_wall]: a run's wait for a build slot and the complete prerequisite preparation. *) slot_overdraft : int; (** [bounds.slot_overdraft]: the slots past {!field-slots} a check may take ({!Order.grant}). *) slots : int; (** The repository's build slots ([mq.slots]): how many checks of the land may run at once. *) estimates : Order.estimates; (** The estimated duration of each check: the checks start shortest first ({!Order.v}). *) job : Branch.t; (** The branch of the land, the serve or the prediction the checks are of: their job at the build slots ({!Order.tag}). *) kind : Order.kind; (** What that job is. *) absent_unknown : bool; (** Whether a check whose command the tree lacks is an error rather than a red ({!Check_run.field-absent_unknown}): the tree of a serve or of a bisection's probe, which may be older than the check. *) probe : bool; (** Whether the tree is a probe of a bisection, whose logs are held apart from the red it searches ({!Check_run.request}). *) confinement : Confinement.t; (** How this machine runs the checks: confined, or why not. *) prerequisites : Generation.t list; (** The dependency generations the locks of {!field-commit} name, dependency first: what every check of the land reads. *)}(** The type for what the checks of one land are asked. *)
val inputs : Branch.t list -> (string * (Branch.t * Commit.t) list) list -> Check.t list -> (Check.name * (string * Commit.t option) list) list(** [inputs branches tips checks] is {!field-inputs} for [checks]: for each that declares inputs, {!Check.commits} of [branches] over [tips], the tips read of each input repository by its path. *)
(** {1:machine The machine} *)
(** The type for the events. *)type event = | Log_read of { note : Note.t; log : Fpath.t option } (** The answer to {!constructor-Read_log} of [note]: the local payload matching its digest, or none. An answer to no lookup under way changes nothing. *) | Run of Check.name * Check_run.event (** An event of a check's run. *) | Recorded of Check.name (** A result of the check is recorded. *) | Not_recorded of Check.name * string (** A result of the check could not be recorded, and why. *) | Cancelled of string (** The land no longer needs the checks, for the reason given (its target moved, a signal): the runs under way are stopped, each recorded {!Check.constructor-Stopped} with that reason once its stop ends it. *) | Drain of string (** The run ends at the next boundary, for the reason given (a new mq at its registered path): the checks not started yet never start, a run still waiting for a build slot is stopped, and the runs under way go on to their verdicts, recorded as any. *) | Failed of string (** A journal record or the removal of a stale lock could not be made: the runs under way are stopped. *) | Prepared (** The prerequisites are ready. *) | Unprepared of [ `Msg of string | `Busy of string ] (** The prerequisites could not be made, and why: [`Busy] when a generation's lease was held past its wait, which says nothing of the tree. *) | Give_way of string (** Other work waits for the build slots these checks hold or the end they keep it behind, as the reason says: once {!red_decided}, the runs under way are stopped, the checks not started never start, and the checks end {!constructor-Red}; otherwise nothing changes. *)
(** The type for the actions. *)type action = | Read_log of { note : Note.t; paths : Fpath.t list } (** Resolve the immutable note payload of a stored red's newest run from local candidate paths, one lookup per stored red. The ending waits for the {!constructor-Log_read} of each; a digest mismatch is no local payload. Successful checks request no lookup. *) | Run of Check.name * Check_run.action (** An action of a check's run. *) | Note of { key : Key.t; note : Note.t } (** Add [note] to the note of [key]'s tree; answered by {!constructor-Recorded} or {!constructor-Not_recorded}. *) | Journal of Event.kind | Remove_lock of Settle.held (** Remove the stale lock of the notes ref, if it still holds what it held. *) | Remove_worktree of Fpath.t (** Remove a check worktree a killed run left, and its registration. *) | Prepare of { commit : Commit.t; generations : Generation.t list } (** Ensure [generations], the dependency generations the locks of [commit] name, once for every check; a task answered by {!constructor-Prepared} or {!constructor-Unprepared}. *) | Stop_prepare of string (** Stop the preparation task at its wait wall or on cancellation. Its answer remains owed before the checks end. *)
(** The type for what the checks say together. *)type ending = | Passed of string (** Every check passed on the tree; the clause the outcome gives them, as [checks build test (4m12s wall, 7m30s of runs)], their wall beside the time of their runs, summed, or [checks reused from build-host]. *) | Red of { check : Check.name; detail : string; log : Fpath.t option; recorded : Ptime.t option; reds : Outcome.red list; } (** A check is a confirmed red, run now or stored: [recorded] is when a stored red was recorded, [None] for one run now. Run now, [detail] names each red, in the order the branch lists them, then the checks that passed, as [check lint failed with exit code 1, last line "dune fmt"; checks build test passed]; [check] is the first red, and [log] is its. [reds] is each red in that order, with its last run's log and what that run named as failed; a stored red names none. After a {!constructor-Give_way}, [detail] names the checks it stopped or left unstarted after the reds, as [check test stopped: 2 lands wait]. *) | Base_red of { detail : string; reds : Outcome.red list } (** No check is a confirmed red, and one or more are red only as the target's tip is ({!Check_run.constructor-Inherited}): [detail] names each, then the checks that passed, as [check build fails as staging's tip 1a2b3c4 does; check fmt passed]; [reds] is each inherited check, in the order the branch lists them, with its last run's log and what that run named as failed. *) | Stuck of { detail : string; log : Fpath.t option; attempt : int option } (** A check reached its wall or could not run, or another writer holds the notes ref. [attempt] is, for a check's run, its attempt on the tree that no run decided: the stuck and errored results recorded for the tree under the check's configuration, plus one; [None] when no run ended it. *) | Unavailable of string (** What the checks needed of the machine could not be done, and why: given once the runs it stopped have answered, without waiting for the notes. *) | Busy of string (** A check could not start because a lock it needs was held past its wait, or it waited [bounds.wait_wall] for a build slot, and which: the machine was busy, which says nothing of the tree, so the land stays queued. Given as {!constructor-Unavailable} is. *) | Withdrawn (** The checks were cancelled. *) | Drained of string (** A {!constructor-Drain} dropped checks that had not started, for the reason given, and the runs under way have ended and are recorded: the tree has no verdict yet, and what ran is reused by the next land of it. *) | Elsewhere of string (** Every check passed that this machine can decide, and a check that lists its platforms still needs a pass on one this machine is not, and which: only a result recorded there decides it, so nothing in the tree is charged and the land waits (doc/configuration.md, "[platforms]"). Once every note asked for is answered. *)
include Machine.S with type event := event and type action := action and type ending := ending
val v : request -> now:Ptime.t -> t * action list(** [v request ~now] is the checks of [request] and their first actions: the removal of a stale lock of the notes ref and of the check worktrees a killed run left, then the runs, or none when the stored results already decide. *)
val pp_ending : ending Fmt.t(** [pp_ending] formats an ending as its word and its words. *)
val wall : t -> Ptime.t * Ptime.t(** [wall t] is when the checks began and when the last run that ended ended: the checks' wall, [began, began] when none ended. *)
val run_seconds : t -> int(** [run_seconds t] is the seconds of every run of [t] that ended, summed. *)
val red_decided : t -> bool(** [red_decided t] is [true] iff a confirmed red decides that [t] ends {!constructor-Red} while some of its checks are under way or not started yet: what a {!constructor-Give_way} stops. *)
val running : t -> Check.name list(** [running t] is the checks whose run is under way. *)
val key : t -> Key.t(** [key t] is the key of the tree [t] checks ({!field-key}). *)
val draining : t -> Check.name list option(** [draining t] is {!running} once each of those checks holds its build slot and none is being stopped; [None] while one waits for a slot or stops. The checks not started yet are not counted: a drained land starts none. *)
val waiting : t -> int(** [waiting t] is how many checks of [t] wait for a build slot: those not started yet and those whose run waits for one ({!Check_run.waiting}). *)
val asking : t -> int(** [asking t] is how many checks of [t] hold a build slot or wait for one: those not started yet, those whose run is under way, and those stopped whose task has not answered yet. *)
val idle : t -> bool(** [idle t] is [true] iff no run is under way, every run stopped has had its task's answer, every note asked for is answered and the preparation asked for has answered: nothing [t] started can still answer. *)
val control : t -> string(** [control t] is the finite control of [t], in words: whether the prerequisites are asked for, the checks still to start, each run under way or stopped with its {!Check_run.control}, the attempts stopped whose task still owes its answer, how many notes are unanswered, the checks red and inherited so far, whether a {!constructor-Drain} dropped checks or a {!constructor-Give_way} stopped them, and the kind of the ending decided, with the attempt of a {!constructor-Stuck} one. It leaves out what no transition reads: instants, reasons, logs, the results reused and the words of the ending. Over a bounded number of checks it takes finitely many values, so the states a run of [t] reaches can be explored as a finite machine ({!Fsm.Shake.Reach}). *)
val footprint : t -> int(** [footprint t] is how many facts [t] holds: the results read and the runs, and nothing else. *)
val certificates : t -> (Note.t list, string) result(** [certificates t] is each configured check's final passed note, in configuration order. Refuses checks that have not passed or cannot be represented as a note. *)
val read_of : t -> Check.name -> (string * Commit.t option) list(** [read_of t name] is the commit of each input the check [name] reads in [t], by the input's name ({!field-inputs}): none for a check that declares no input. *)
val unchecked : branches:Branch.t list -> tips:(string * (Branch.t * Commit.t) list) list -> tree:Tree.t -> Note.t list -> Check.t list -> Check.t list(** [unchecked ~branches ~tips ~tree notes checks] is each check of [checks] that declares inputs and has no decided result ({!Check.Passed} or {!Check.Failed}) among [notes] on [tree] under the configuration the inputs' commits now give it ({!inputs} of [branches] over [tips]): the checks a move of an input leaves unanswered on [tree] (doc/commands.md, "When a dependency moves"). *)
val failing : branches:Branch.t list -> tips:(string * (Branch.t * Commit.t) list) list -> tree:Tree.t -> Note.t list -> Check.t list -> Check.t list(** [failing ~branches ~tips ~tree notes checks] is each check of [checks] that declares inputs and whose newest decided result on [tree], under the configuration the inputs' commits now give it, is {!Check.Failed}, the newest being the last of [notes], as a note's lines are appended. *)