diff --git a/test/fiber/t_fib1.expected b/test/fiber/t_fib1.expected index f504d3eb..9a6bee27 100644 --- a/test/fiber/t_fib1.expected +++ b/test/fiber/t_fib1.expected @@ -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 diff --git a/test/fiber/t_fib1.ml b/test/fiber/t_fib1.ml index 275dcba7..84c4a667 100644 --- a/test/fiber/t_fib1.ml +++ b/test/fiber/t_fib1.ml @@ -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 (); ()