Joseph Ferano
3ace7c262f
The mutation pass turned up one defect that did not make the suite go red: a reader branch that forgets to advance reads the same character for ever, and dune test waits as long as it is left to. In CI that is a job killed by the runner with nothing named and no output to read. watchdog.ml puts an alarm on every test binary — generous, because an alarm that fires on a slow machine is a flake — and a five-second one around each read in test_flan, where the budget really is small. The first read that does not return wedges the rest, so a looping reader costs five seconds and names the row instead of costing eight minutes or never finishing. Both were watched: the string-escape loop now fails in five seconds with the case named, and the per-binary backstop was armed short and observed to fire.
63 lines
2.5 KiB
OCaml
63 lines
2.5 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
|
|
|
|
let dying _ =
|
|
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 stderr;
|
|
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
|