Source file `Timers.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(*
   Manage timers for the tests that have a time limit.
*)

open Testo_util
module T = Types

type timer = {
  test: T.test;
  worker: Multiprocess.Client.worker;
  start_time: float;
  max_duration: float;
}

(* test_id -> timer *)
type t = (string, timer) Hashtbl.t

let create () = Hashtbl.create 100

let add_test timers (test : T.test) worker =
  match test.max_duration with
  | None -> ()
  | Some max_duration ->
      let timer = {
        test;
        worker;
        start_time = Unix.gettimeofday ();
        max_duration;
      } in
      Hashtbl.replace timers test.id timer

let remove_test timers (test : T.test) =
  Hashtbl.remove timers test.id

let remove_timeouts timers =
  let now = Unix.gettimeofday () in
  let timeouts =
    Hashtbl.fold (fun _test_id timer acc ->
      (* not sure if it's safe to remove elements from the table while
         we're iterating over it, so we'll remove the timed-out elements in
         a second pass. *)
      let elapsed = now -. timer.start_time in
      if elapsed > timer.max_duration then
        timer :: acc
      else
        acc
    ) timers []
  in
  List.iter (fun timer -> remove_test timers timer.test) timeouts;
  Helpers.list_map (fun timer ->
    (timer.test, timer.max_duration, timer.worker)
  ) timeouts