mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-06 03:05:30 -05:00
try to make test more deterministic
This commit is contained in:
Simon Cruanes
parent
a2ea24551b
commit
62770a87b5
2 changed files with 140 additions and 94 deletions
|
|
@ -1,60 +1,61 @@
|
|||
============
|
||||
start
|
||||
wait for subs
|
||||
await fiber 0
|
||||
cur fiber is some: true
|
||||
cur fiber is some: true
|
||||
res 0 = 0
|
||||
await fiber 1
|
||||
cur fiber is some: true
|
||||
cur fiber is some: true
|
||||
res 1 = 1
|
||||
await fiber 2
|
||||
cur fiber is some: true
|
||||
cur fiber is some: true
|
||||
res 2 = 2
|
||||
await fiber 3
|
||||
cur fiber is some: true
|
||||
cur fiber is some: true
|
||||
res 3 = 3
|
||||
await fiber 4
|
||||
cur fiber is some: true
|
||||
cur fiber is some: true
|
||||
res 4 = 4
|
||||
main fiber done
|
||||
other fib done
|
||||
main fiber exited
|
||||
1: wait for subs
|
||||
1.0.0: await fiber 0
|
||||
1.0.1: cur fiber[0] is some: true
|
||||
1.0.2: cur fiber[0] is some: true
|
||||
1.0.3: res 0 = 0
|
||||
1.1.0: await fiber 1
|
||||
1.1.1: cur fiber[1] is some: true
|
||||
1.1.2: cur fiber[1] is some: true
|
||||
1.1.3: res 1 = 1
|
||||
1.2.0: await fiber 2
|
||||
1.2.1: cur fiber[2] is some: true
|
||||
1.2.2: cur fiber[2] is some: true
|
||||
1.2.3: res 2 = 2
|
||||
1.3.0: await fiber 3
|
||||
1.3.1: cur fiber[3] is some: true
|
||||
1.3.2: cur fiber[3] is some: true
|
||||
1.3.3: res 3 = 3
|
||||
1.4.0: await fiber 4
|
||||
1.4.1: cur fiber[4] is some: true
|
||||
1.4.2: cur fiber[4] is some: true
|
||||
1.4.3: res 4 = 4
|
||||
2: main fiber done
|
||||
3: other fib done
|
||||
4: main fiber exited
|
||||
============
|
||||
start
|
||||
wait for subs
|
||||
fiber 0 resolved as ok
|
||||
await fiber 0
|
||||
res 0 = 0
|
||||
await fiber 1
|
||||
fiber 1 resolved as ok
|
||||
res 1 = 1
|
||||
await fiber 2
|
||||
fiber 2 resolved as ok
|
||||
res 2 = 2
|
||||
await fiber 3
|
||||
fiber 3 resolved as ok
|
||||
res 3 = 3
|
||||
await fiber 4
|
||||
fiber 4 resolved as ok
|
||||
res 4 = 4
|
||||
await fiber 5
|
||||
fiber 5 resolved as ok
|
||||
res 5 = 5
|
||||
await fiber 6
|
||||
fiber 6 resolved as ok
|
||||
res 6 = 6
|
||||
await fiber 7
|
||||
I'm fiber 7 and I'm about to…
|
||||
sub-fiber 8 was cancelled
|
||||
fiber 8 resolved as error
|
||||
sub-fiber 9 was cancelled
|
||||
fiber 9 resolved as error
|
||||
main fiber result: error Failure("oh no!")
|
||||
fiber 7 resolved as error
|
||||
main fib failed with "oh no!"
|
||||
main fiber exited
|
||||
1: start fibers
|
||||
1.7.1: I'm fiber 7 and I'm about to…
|
||||
1.8.1: sub-fiber 8 was cancelled
|
||||
1.9.1: sub-fiber 9 was cancelled
|
||||
2.0: fiber 0 resolved as ok
|
||||
2.1: fiber 1 resolved as ok
|
||||
2.2: fiber 2 resolved as ok
|
||||
2.3: fiber 3 resolved as ok
|
||||
2.4: fiber 4 resolved as ok
|
||||
2.5: fiber 5 resolved as ok
|
||||
2.6: fiber 6 resolved as ok
|
||||
2.7: fiber 7 resolved as error
|
||||
2.8: fiber 8 resolved as error
|
||||
2.9: fiber 9 resolved as error
|
||||
3: wait for subs
|
||||
4: await fiber 0
|
||||
5: res 0 = 0
|
||||
6: await fiber 1
|
||||
7: res 1 = 1
|
||||
8: await fiber 2
|
||||
9: res 2 = 2
|
||||
10: await fiber 3
|
||||
11: res 3 = 3
|
||||
12: await fiber 4
|
||||
13: res 4 = 4
|
||||
14: await fiber 5
|
||||
15: res 5 = 5
|
||||
16: await fiber 6
|
||||
17: res 6 = 6
|
||||
18: await fiber 7
|
||||
19: main fiber result: error Failure("oh no!")
|
||||
20: main fib failed with "oh no!"
|
||||
21: main fiber exited
|
||||
|
|
|
|||
|
|
@ -1,21 +1,55 @@
|
|||
open Moonpool
|
||||
open! Moonpool
|
||||
module A = Atomic
|
||||
module F = Moonpool_fib.Fiber
|
||||
|
||||
let ( let@ ) = ( @@ )
|
||||
let runner = Ws_pool.create ~num_threads:8 ()
|
||||
let lock = Lock.create ()
|
||||
|
||||
let logf fmt =
|
||||
Printf.ksprintf
|
||||
(fun s ->
|
||||
let out = stdout in
|
||||
(let@ () = Lock.with_ lock in
|
||||
output_string out s);
|
||||
flush out)
|
||||
fmt
|
||||
module TS = struct
|
||||
type t = int list
|
||||
|
||||
let show (s : t) = String.concat "." @@ List.map string_of_int s
|
||||
let init = [ 0 ]
|
||||
|
||||
let next_ = function
|
||||
| [] -> [ 0 ]
|
||||
| n :: tl -> (n + 1) :: tl
|
||||
|
||||
let tick (t : t ref) = t := next_ !t
|
||||
|
||||
let tick_get t =
|
||||
tick t;
|
||||
!t
|
||||
end
|
||||
|
||||
(* more deterministic logging of events *)
|
||||
module Log_ = struct
|
||||
let events : (TS.t * string) list A.t = A.make []
|
||||
|
||||
let add_event t msg : unit =
|
||||
while
|
||||
let old = A.get events in
|
||||
not (A.compare_and_set events old ((t, msg) :: old))
|
||||
do
|
||||
()
|
||||
done
|
||||
|
||||
let logf t fmt = Printf.ksprintf (add_event t) fmt
|
||||
|
||||
let print_and_clear () =
|
||||
let l =
|
||||
A.exchange events []
|
||||
|> List.map (fun (ts, msg) -> List.rev ts, msg)
|
||||
|> List.sort Stdlib.compare
|
||||
in
|
||||
List.iter (fun (ts, msg) -> Printf.printf "%s: %s\n" (TS.show ts) msg) l
|
||||
end
|
||||
|
||||
let logf = Log_.logf
|
||||
|
||||
let () =
|
||||
logf "============\nstart\n";
|
||||
Printf.printf "============\nstart\n";
|
||||
let clock = ref TS.init in
|
||||
let fib =
|
||||
F.spawn_top ~on:runner @@ fun () ->
|
||||
let subs =
|
||||
|
|
@ -28,85 +62,96 @@ let () =
|
|||
ignore
|
||||
(F.spawn_link ~protect:false @@ fun () ->
|
||||
Thread.delay 0.4;
|
||||
logf "other fib done\n%!"
|
||||
TS.tick clock;
|
||||
logf !clock "other fib done"
|
||||
: _ F.t);
|
||||
logf "wait for subs\n%!";
|
||||
|
||||
logf (TS.tick_get clock) "wait for subs";
|
||||
List.iteri
|
||||
(fun i f ->
|
||||
logf "await fiber %d\n%!" i;
|
||||
logf "cur fiber is some: %b\n%!"
|
||||
let clock = ref (0 :: i :: !clock) in
|
||||
logf !clock "await fiber %d" i;
|
||||
logf (TS.tick_get clock) "cur fiber[%d] is some: %b" i
|
||||
(Option.is_some @@ F.Private_.get_cur ());
|
||||
let res = F.await f in
|
||||
logf "cur fiber is some: %b\n%!"
|
||||
logf (TS.tick_get clock) "cur fiber[%d] is some: %b" i
|
||||
(Option.is_some @@ F.Private_.get_cur ());
|
||||
Thread.delay 0.000_01;
|
||||
F.yield ();
|
||||
logf "res %d = %d\n%!" i res)
|
||||
logf (TS.tick_get clock) "res %d = %d" i res)
|
||||
subs;
|
||||
logf "main fiber done\n%!"
|
||||
logf (TS.tick_get clock) "main fiber done"
|
||||
in
|
||||
|
||||
Fut.wait_block_exn @@ F.res fib;
|
||||
logf "main fiber exited\n%!";
|
||||
logf (TS.tick_get clock) "main fiber exited";
|
||||
Log_.print_and_clear ();
|
||||
()
|
||||
|
||||
let () =
|
||||
(* same but now, cancel *)
|
||||
logf "============\nstart\n";
|
||||
(* same but now, cancel one of the sub-fibers *)
|
||||
Printf.printf "============\nstart\n";
|
||||
|
||||
let clock = ref TS.init in
|
||||
let fib =
|
||||
F.spawn_top ~on:runner @@ fun () ->
|
||||
let@ () =
|
||||
F.with_self_cancel_callback (fun ebt ->
|
||||
logf "main fiber cancelled with %s\n%!" @@ Exn_bt.show ebt)
|
||||
logf (TS.tick_get clock) "main fiber cancelled with %s"
|
||||
@@ Exn_bt.show ebt)
|
||||
in
|
||||
|
||||
logf (TS.tick_get clock) "start fibers";
|
||||
let subs =
|
||||
List.init 10 (fun i ->
|
||||
let clock = ref (0 :: i :: !clock) in
|
||||
F.spawn_link ~protect:false @@ fun () ->
|
||||
let@ () =
|
||||
F.with_self_cancel_callback (fun _ ->
|
||||
logf "sub-fiber %d was cancelled\n%!" i)
|
||||
logf (TS.tick_get clock) "sub-fiber %d was cancelled" i)
|
||||
in
|
||||
Thread.delay (float i *. 0.001);
|
||||
F.yield ();
|
||||
if i = 7 then (
|
||||
logf "I'm fiber %d and I'm about to…\n%!" i;
|
||||
logf (TS.tick_get clock) "I'm fiber %d and I'm about to…" i;
|
||||
failwith "oh no!"
|
||||
);
|
||||
i)
|
||||
in
|
||||
|
||||
let post = TS.tick_get clock in
|
||||
List.iteri
|
||||
(fun i fib ->
|
||||
F.on_result fib (function
|
||||
| Ok _ -> logf "fiber %d resolved as ok\n%!" i
|
||||
| Error _ -> logf "fiber %d resolved as error\n%!" i))
|
||||
| Ok _ -> logf (i :: post) "fiber %d resolved as ok" i
|
||||
| Error _ -> logf (i :: post) "fiber %d resolved as error" i))
|
||||
subs;
|
||||
|
||||
ignore
|
||||
(F.spawn_link ~protect:false @@ fun () ->
|
||||
Thread.delay 0.2;
|
||||
logf "other fib done\n%!"
|
||||
logf (TS.tick_get clock) "other fib done"
|
||||
: _ F.t);
|
||||
|
||||
logf "wait for subs\n%!";
|
||||
logf (TS.tick_get clock) "wait for subs";
|
||||
List.iteri
|
||||
(fun i f ->
|
||||
logf "await fiber %d\n%!" i;
|
||||
logf (TS.tick_get clock) "await fiber %d" i;
|
||||
let res = F.await f in
|
||||
logf "res %d = %d\n%!" i res)
|
||||
logf (TS.tick_get clock) "res %d = %d" i res)
|
||||
subs;
|
||||
logf "yield\n%!";
|
||||
logf (TS.tick_get clock) "yield";
|
||||
F.yield ();
|
||||
logf "yielded\n%!";
|
||||
logf "main fiber done\n%!"
|
||||
logf (TS.tick_get clock) "yielded";
|
||||
logf (TS.tick_get clock) "main fiber done"
|
||||
in
|
||||
|
||||
F.on_result fib (function
|
||||
| Ok () -> logf "main fiber result: ok\n%!"
|
||||
| Error ebt -> logf "main fiber result: error %s\n%!" (Exn_bt.show ebt));
|
||||
| Ok () -> logf (TS.tick_get clock) "main fiber result: ok"
|
||||
| Error ebt ->
|
||||
logf (TS.tick_get clock) "main fiber result: error %s" (Exn_bt.show ebt));
|
||||
|
||||
(try Fut.wait_block_exn @@ F.res fib
|
||||
with Failure msg -> logf "main fib failed with %S\n%!" msg);
|
||||
logf "main fiber exited\n%!";
|
||||
with Failure msg -> logf (TS.tick_get clock) "main fib failed with %S" msg);
|
||||
logf (TS.tick_get clock) "main fiber exited";
|
||||
Log_.print_and_clear ();
|
||||
()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue