make test more deterministic

This commit is contained in:
Simon Cruanes 2023-09-19 11:35:01 -04:00
parent 274496fe81
commit f05374586b
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 1836 additions and 5015 deletions

File diff suppressed because it is too large Load diff

View file

@ -2,11 +2,32 @@ open Lwt.Syntax
let ( let@ ) = ( @@ )
let inner_loop i =
module Barrier = struct
type t = {
mutable n: int;
size: int;
cond: unit Lwt_condition.t;
}
let create size : t = { n = 0; size; cond = Lwt_condition.create () }
let wait (self : t) : unit Lwt.t =
self.n <- self.n + 1;
if self.n >= self.size then (
(* all reached barrier, reset and wakeup everyone *)
self.n <- 0;
Lwt_condition.broadcast self.cond ();
Lwt.return ()
) else
Lwt_condition.wait self.cond
end
let inner_loop ~off i barrier =
let rec loop j =
if j >= 5 then
Lwt.return ()
else
let* () = Lwt_unix.sleep (float off *. 0.01) in
let* () =
let@ _sp =
Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "inner.loop.step"
@ -16,15 +37,18 @@ let inner_loop i =
let* () =
if j = 2 then
let* () = Lwt_unix.sleep (float off *. 0.01) in
let@ _sp =
Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "sub-sleep"
in
Lwt_unix.sleep 0.010
Lwt_unix.sleep 0.01
else
Lwt.return ()
in
Lwt_unix.sleep 0.006
let* () = Lwt_unix.sleep 0.06 in
let* () = Barrier.wait barrier in
Lwt.return ()
in
loop (j + 1)
@ -35,25 +59,21 @@ let inner_loop i =
in
loop 0
let outer_loop () =
let outer_loop ~off barrier =
let rec loop i =
if i = 50 then
if i = 20 then
Lwt.return ()
else
let* () =
let* () = Lwt_unix.sleep (float off *. 0.04) in
let@ _sp =
Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "outer.loop.step"
in
let fut_sleep =
let@ _sp =
Trace_lwt.with_span_lwt ~__FILE__ ~__LINE__ "outer.sleep"
in
Lwt_unix.sleep 0.09
in
let* () = inner_loop i and* () = inner_loop i in
let* () = fut_sleep in
let barrier_inner = Barrier.create 2 in
let* () = inner_loop ~off:0 i barrier_inner
and* () = inner_loop ~off:1 i barrier_inner in
let* () = Barrier.wait barrier in
Lwt.return ()
in
loop (i + 1)
@ -69,7 +89,8 @@ let run () : unit Lwt.t =
Trace.set_process_name "main";
Trace.set_thread_name "t1";
let* () = outer_loop () and* () = outer_loop () in
let barrier = Barrier.create 2 in
let* () = outer_loop ~off:0 barrier and* () = outer_loop ~off:1 barrier in
Lwt.return ()
let () =