Joseph Ferano
199ab02a2b
It calls exit and not _exit, and the reason is the opposite of what the comment said: the rows that did pass are still in stdout's buffer, and a watchdog that threw them away would tell you less than the hang did. Also observed firing from test_dev, which is blocked on a daemon rather than spinning — the case the reader hang does not cover.
65 lines
2.6 KiB
OCaml
65 lines
2.6 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] rather than [_exit]: the rows that did pass are in stdout's buffer
|
|
and a watchdog that threw them away would be worse than the hang. *)
|
|
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
|