mirror of
https://github.com/c-cube/moonpool.git
synced 2025-12-05 19:00:33 -05:00
add some tests for fiber
This commit is contained in:
parent
8a7cfb6fb0
commit
4cdec87aea
4 changed files with 170 additions and 0 deletions
15
test/fiber/dune
Normal file
15
test/fiber/dune
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
(tests
|
||||
(names
|
||||
t_fib1 t_fls)
|
||||
(enabled_if
|
||||
(>= %{ocaml_version} 5.0))
|
||||
(libraries
|
||||
moonpool
|
||||
moonpool.fib
|
||||
trace
|
||||
trace-tef
|
||||
qcheck-core
|
||||
qcheck-core.runner
|
||||
;tracy-client.trace
|
||||
))
|
||||
50
test/fiber/t_fib1.expected
Normal file
50
test/fiber/t_fib1.expected
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
============
|
||||
start
|
||||
wait for subs
|
||||
await fiber 0
|
||||
res 0 = 0
|
||||
await fiber 1
|
||||
res 1 = 1
|
||||
await fiber 2
|
||||
res 2 = 2
|
||||
await fiber 3
|
||||
res 3 = 3
|
||||
await fiber 4
|
||||
res 4 = 4
|
||||
main fiber done
|
||||
other fib done
|
||||
main fiber exited
|
||||
============
|
||||
start
|
||||
wait for subs
|
||||
await fiber 0
|
||||
fiber 0 resolved as ok
|
||||
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
|
||||
res 6 = 6
|
||||
await fiber 7
|
||||
fiber 6 resolved as ok
|
||||
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
|
||||
104
test/fiber/t_fib1.ml
Normal file
104
test/fiber/t_fib1.ml
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
open Moonpool
|
||||
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@ () = Lock.with_ lock in
|
||||
print_string s)
|
||||
fmt
|
||||
|
||||
let () =
|
||||
logf "============\nstart\n";
|
||||
let fib =
|
||||
F.spawn_top ~on:runner @@ fun () ->
|
||||
let subs =
|
||||
List.init 5 (fun i ->
|
||||
F.spawn_link ~protect:false @@ fun () ->
|
||||
Thread.delay 0.000_01;
|
||||
i)
|
||||
in
|
||||
|
||||
ignore
|
||||
(F.spawn_link ~protect:false @@ fun () ->
|
||||
Thread.delay 0.2;
|
||||
logf "other fib done\n%!"
|
||||
: _ F.t);
|
||||
logf "wait for subs\n%!";
|
||||
List.iteri
|
||||
(fun i f ->
|
||||
logf "await fiber %d\n%!" i;
|
||||
let res = F.await f in
|
||||
logf "res %d = %d\n%!" i res)
|
||||
subs;
|
||||
logf "main fiber done\n%!"
|
||||
in
|
||||
|
||||
Fut.wait_block_exn @@ F.res fib;
|
||||
logf "main fiber exited\n%!";
|
||||
()
|
||||
|
||||
let () =
|
||||
(* same but now, cancel *)
|
||||
logf "============\nstart\n";
|
||||
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)
|
||||
in
|
||||
|
||||
let subs =
|
||||
List.init 10 (fun i ->
|
||||
F.spawn_link ~protect:false @@ fun () ->
|
||||
let@ () =
|
||||
F.with_self_cancel_callback (fun _ ->
|
||||
logf "sub-fiber %d was cancelled\n%!" 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;
|
||||
failwith "oh no!"
|
||||
);
|
||||
i)
|
||||
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))
|
||||
subs;
|
||||
|
||||
ignore
|
||||
(F.spawn_link ~protect:false @@ fun () ->
|
||||
Thread.delay 0.2;
|
||||
logf "other fib done\n%!"
|
||||
: _ F.t);
|
||||
|
||||
logf "wait for subs\n%!";
|
||||
List.iteri
|
||||
(fun i f ->
|
||||
logf "await fiber %d\n%!" i;
|
||||
let res = F.await f in
|
||||
logf "res %d = %d\n%!" i res)
|
||||
subs;
|
||||
logf "yield\n%!";
|
||||
F.yield ();
|
||||
logf "yielded\n%!";
|
||||
logf "main fiber done\n%!"
|
||||
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));
|
||||
|
||||
(try Fut.wait_block_exn @@ F.res fib
|
||||
with Failure msg -> logf "main fib failed with %S\n%!" msg);
|
||||
logf "main fiber exited\n%!";
|
||||
()
|
||||
1
test/fiber/t_fls.ml
Normal file
1
test/fiber/t_fls.ml
Normal file
|
|
@ -0,0 +1 @@
|
|||
(* TODO: test FLS *)
|
||||
Loading…
Add table
Reference in a new issue