update tests

This commit is contained in:
Simon Cruanes 2024-03-01 17:09:11 -05:00
parent 37751c79e4
commit 4325fda345
2 changed files with 23 additions and 23 deletions

View file

@ -49,22 +49,21 @@ let logf = Log_.logf
let () =
Printf.printf "============\nstart\n";
let@ nursery = F.Nursery.with_create_top ~on:runner () in
let clock = ref TS.init in
let fib =
F.spawn_top ~on:runner @@ fun () ->
F.spawn nursery @@ fun nursery ->
let subs =
List.init 5 (fun i ->
F.spawn_link ~protect:false @@ fun () ->
F.spawn nursery ~protect:false @@ fun _n ->
Thread.delay (float i *. 0.01);
i)
in
ignore
(F.spawn_link ~protect:false @@ fun () ->
Thread.delay 0.4;
TS.tick clock;
logf !clock "other fib done"
: _ F.t);
F.spawn_ignore nursery ~protect:false (fun _n ->
Thread.delay 0.4;
TS.tick clock;
logf !clock "other fib done");
logf (TS.tick_get clock) "wait for subs";
List.iteri
@ -92,8 +91,9 @@ let () =
Printf.printf "============\nstart\n";
let clock = ref TS.init in
let@ nursery = F.Nursery.with_create_top ~on:runner () in
let fib =
F.spawn_top ~on:runner @@ fun () ->
F.spawn nursery @@ fun nursery ->
let@ () =
F.with_self_cancel_callback (fun ebt ->
logf (TS.tick_get clock) "main fiber cancelled with %s"
@ -104,7 +104,7 @@ let () =
let subs =
List.init 10 (fun i ->
let clock = ref (0 :: i :: !clock) in
F.spawn_link ~protect:false @@ fun () ->
F.spawn nursery ~protect:false @@ fun _n ->
let@ () =
F.with_self_cancel_callback (fun _ ->
logf (TS.tick_get clock) "sub-fiber %d was cancelled" i)
@ -126,11 +126,9 @@ let () =
| Error _ -> logf (i :: post) "fiber %d resolved as error" i))
subs;
ignore
(F.spawn_link ~protect:false @@ fun () ->
Thread.delay 0.2;
logf (TS.tick_get clock) "other fib done"
: _ F.t);
F.spawn_ignore nursery ~protect:false (fun _n ->
Thread.delay 0.2;
logf (TS.tick_get clock) "other fib done");
logf (TS.tick_get clock) "wait for subs";
List.iteri

View file

@ -96,6 +96,7 @@ module Render = struct
end
let run ~pool ~pool_name () =
let@ nursery = F.Nursery.with_create_top ~on:pool () in
let tracer = Tracer.create () in
let sub_sub_child ~idx ~idx_child ~idx_sub ~idx_sub_sub () =
@ -110,7 +111,7 @@ let run ~pool ~pool_name () =
done
in
let sub_child ~idx ~idx_child ~idx_sub () =
let sub_child ~idx ~idx_child ~idx_sub nursery =
let@ () =
Tracer.with_span tracer (spf "child_%d.%d.%d" idx idx_child idx_sub)
in
@ -122,19 +123,19 @@ let run ~pool ~pool_name () =
let subs =
List.init 2 (fun idx_sub_sub ->
F.spawn_link ~protect:true (fun () ->
F.spawn ~protect:true nursery (fun _nursery ->
sub_sub_child ~idx ~idx_child ~idx_sub ~idx_sub_sub ()))
in
List.iter F.await subs
in
let top_child ~idx ~idx_child () =
let top_child ~idx ~idx_child nursery =
let@ () = Tracer.with_span tracer (spf "child.%d.%d" idx idx_child) in
let subs =
List.init 2 (fun k ->
F.spawn_link ~protect:true @@ fun () ->
sub_child ~idx ~idx_child ~idx_sub:k ())
F.spawn nursery ~protect:true @@ fun nursery ->
sub_child ~idx ~idx_child ~idx_sub:k nursery)
in
let@ () =
@ -144,12 +145,13 @@ let run ~pool ~pool_name () =
List.iter F.await subs
in
let top idx =
let top nursery idx =
let@ () = Tracer.with_span tracer (spf "top_%d" idx) in
let subs =
List.init 5 (fun j ->
F.spawn_link ~protect:true @@ fun () -> top_child ~idx ~idx_child:j ())
F.spawn nursery ~protect:true @@ fun nursery ->
top_child ~idx ~idx_child:j nursery)
in
List.iter F.await subs
@ -157,7 +159,7 @@ let run ~pool ~pool_name () =
Printf.printf "run test on pool = %s\n" pool_name;
let fibs =
List.init 8 (fun idx -> F.spawn_top ~on:pool (fun () -> top idx))
List.init 8 (fun idx -> F.spawn nursery (fun nursery -> top nursery idx))
in
List.iter F.wait_block_exn fibs;