Joseph Ferano
7b3773c344
They were the whole of this binary's wall clock, and none of it was CPU the machine did not have: one core busy, fifteen idle, for 30-odd seconds of independent programs run strictly one after another. A small pool now forks up to eight of them at once and reads results back through a pipe in the order the rows are written in, so the log is byte-for-byte what it always was — just produced faster. Eight, not sixteen: dune already runs this suite's eleven binaries at once, and test_dev's daemon is the actual critical path at roughly 46s against this one's 30. Handing the pool the whole box would rob the binary that matters more to speed up the one that matters less. Every temporary path a worker touches now carries its own pid, so a program's -O2 row and its -O0 row, run in different forked processes, can never collide on the same exe or the same captured stdout underfoot. Three rows could not be pooled that way regardless: slurp.flan and files.flan write to fixed relative paths their own variants share, with a clean() between them that only makes sense run in order, so those three stay on the direct, unpooled path the whole file used before. A worker that dies without ever writing its result — signalled, OOM-killed, segfaulted mid-compile — is counted and named rather than silently read as a pass; the exit status is trusted over a payload that never arrived. And a worker clears its own SIGALRM handler on the way in, so the parent's watchdog can never be triggered from inside a child holding a stale copy of its sibling list. If the watchdog does fire from the parent, it now kills every worker still in flight before it exits, so a hang does not also leave orphans behind it. Standalone, test_acceptance went from 43.4s to 13.8-20.8s across three runs with identical output every time. The full dune test did not move — 49.4- 49.9s after against 49.8s before — which is the eleven-way sibling parallelism already claiming what this pool would have used.
85 lines
3.9 KiB
OCaml
85 lines
3.9 KiB
OCaml
(* A clock on every test binary, because a green run is not the only outcome
|
|
to plan for.
|
|
|
|
The mutation pass that produced NEXT.md's blind-spot list turned up one
|
|
defect that did not make the suite fail — it made it *hang*. A reader loop
|
|
that forgets to advance reads the same character for ever, and every binary
|
|
that reads a .flan file stops there. Nothing prints, nothing exits, and
|
|
[dune test] waits as long as it is left to. In CI that is a job killed by
|
|
the runner's own timeout, with no failing case named and no output to read.
|
|
|
|
So: an alarm, at two scales.
|
|
|
|
[arm] is the per-binary backstop. It is deliberately generous — test_dev
|
|
launches a daemon and test_acceptance builds for wasm32 — because an alarm
|
|
that fires on a slow machine is a flake, and a flake is how a watchdog gets
|
|
deleted. It is here to turn "for ever" into "fails in ten minutes", not to
|
|
measure anything.
|
|
|
|
[within] is the tight one, for a call whose budget really is small: reading
|
|
a few characters of source. It raises [Timeout] rather than exiting, so the
|
|
caller can report one failing row and carry on through the rest of its
|
|
table — a binary that dies on the first hang tells you much less than one
|
|
that finishes and names every case that hung.
|
|
|
|
SIGALRM is delivered at OCaml's safepoints, which are inserted at loop
|
|
back-edges and function entries, so a tight loop that allocates nothing is
|
|
still interruptible. *)
|
|
|
|
exception Timeout
|
|
|
|
let label = ref "test"
|
|
let budget = ref 0
|
|
let deadline = ref 0.0
|
|
|
|
(* A binary that forks workers of its own (test_acceptance's compile pool, at
|
|
least so far) can register cleanup here: something to run to stop those
|
|
workers before [dying] falls through to [Unix._exit]. Without it, an alarm
|
|
firing mid-run kills only this process and every child it had in flight
|
|
becomes an orphan, reparented to init and left to run — or hang — on its
|
|
own. Best-effort and swallowed: a cleanup action that itself fails must
|
|
not stop the rest of them, or the report of the hang, from happening. *)
|
|
let cleanup : (unit -> unit) list ref = ref []
|
|
let on_cleanup f = cleanup := f :: !cleanup
|
|
|
|
let dying _ =
|
|
List.iter (fun f -> try f () with _ -> ()) !cleanup;
|
|
Printf.eprintf
|
|
"\nFAIL %s: no result after %ds — stopped by the test watchdog.\n\
|
|
\ A test that hangs reports nothing at all; this is that outcome\n\
|
|
\ turned into a failing run.\n"
|
|
!label !budget;
|
|
(* [flush_all] and [Unix._exit], not [exit]: the rows that did pass are in
|
|
stdout's buffer and a watchdog that threw them away would be worse than
|
|
the hang, so both channels are flushed explicitly here rather than left
|
|
to [exit]'s own at_exit-registered flush. [_exit] then skips the rest of
|
|
that at_exit chain entirely, which matters now that test_acceptance.ml
|
|
registers a handler of its own: that handler forces exit 1 whenever
|
|
[failures > 0], and calling plain [exit] here would hand it a chance to
|
|
relabel this exit — after the alarm already fired — as an ordinary
|
|
failing run instead of a hang. Going around the chain is simpler than
|
|
coordinating with what is in it, and does not depend on how many
|
|
handlers get added there later. *)
|
|
flush_all ();
|
|
Unix._exit 2
|
|
|
|
(* Re-arm the backstop for whatever is left of its budget. One second is the
|
|
floor, because [alarm 0] cancels rather than fires. *)
|
|
let backstop () =
|
|
Sys.set_signal Sys.sigalrm (Sys.Signal_handle dying);
|
|
let left = !deadline -. Unix.gettimeofday () in
|
|
ignore (Unix.alarm (max 1 (int_of_float left)))
|
|
|
|
let arm ?(seconds = 600) name =
|
|
label := name;
|
|
budget := seconds;
|
|
deadline := Unix.gettimeofday () +. float_of_int seconds;
|
|
backstop ()
|
|
|
|
(* [f] under a tighter alarm, with the backstop restored afterwards however
|
|
[f] left. *)
|
|
let within seconds f =
|
|
Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout));
|
|
ignore (Unix.alarm seconds);
|
|
Fun.protect ~finally:backstop f
|