add some tests for fiber

This commit is contained in:
Simon Cruanes 2024-02-21 00:53:24 -05:00
parent 8a7cfb6fb0
commit 4cdec87aea
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
4 changed files with 170 additions and 0 deletions

15
test/fiber/dune Normal file
View 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
))

View 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
View 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
View file

@ -0,0 +1 @@
(* TODO: test FLS *)