try to make test more deterministic

test/fiber/t_fib1.expected

@@ -1,60 +1,61 @@
 ============
 start
-wait for subs
+1: wait for subs
-await fiber 0
+1.0.0: await fiber 0
-cur fiber is some: true
+1.0.1: cur fiber[0] is some: true
-cur fiber is some: true
+1.0.2: cur fiber[0] is some: true
-res 0 = 0
+1.0.3: res 0 = 0
-await fiber 1
+1.1.0: await fiber 1
-cur fiber is some: true
+1.1.1: cur fiber[1] is some: true
-cur fiber is some: true
+1.1.2: cur fiber[1] is some: true
-res 1 = 1
+1.1.3: res 1 = 1
-await fiber 2
+1.2.0: await fiber 2
-cur fiber is some: true
+1.2.1: cur fiber[2] is some: true
-cur fiber is some: true
+1.2.2: cur fiber[2] is some: true
-res 2 = 2
+1.2.3: res 2 = 2
-await fiber 3
+1.3.0: await fiber 3
-cur fiber is some: true
+1.3.1: cur fiber[3] is some: true
-cur fiber is some: true
+1.3.2: cur fiber[3] is some: true
-res 3 = 3
+1.3.3: res 3 = 3
-await fiber 4
+1.4.0: await fiber 4
-cur fiber is some: true
+1.4.1: cur fiber[4] is some: true
-cur fiber is some: true
+1.4.2: cur fiber[4] is some: true
-res 4 = 4
+1.4.3: res 4 = 4
-main fiber done
+2: main fiber done
-other fib done
+3: other fib done
-main fiber exited
+4: main fiber exited
 ============
 start
-wait for subs
+1: start fibers
-fiber 0 resolved as ok
+1.7.1: I'm fiber 7 and I'm about to…
-await fiber 0
+1.8.1: sub-fiber 8 was cancelled
-res 0 = 0
+1.9.1: sub-fiber 9 was cancelled
-await fiber 1
+2.0: fiber 0 resolved as ok
-fiber 1 resolved as ok
+2.1: fiber 1 resolved as ok
-res 1 = 1
+2.2: fiber 2 resolved as ok
-await fiber 2
+2.3: fiber 3 resolved as ok
-fiber 2 resolved as ok
+2.4: fiber 4 resolved as ok
-res 2 = 2
+2.5: fiber 5 resolved as ok
-await fiber 3
+2.6: fiber 6 resolved as ok
-fiber 3 resolved as ok
+2.7: fiber 7 resolved as error
-res 3 = 3
+2.8: fiber 8 resolved as error
-await fiber 4
+2.9: fiber 9 resolved as error
-fiber 4 resolved as ok
+3: wait for subs
-res 4 = 4
+4: await fiber 0
-await fiber 5
+5: res 0 = 0
-fiber 5 resolved as ok
+6: await fiber 1
-res 5 = 5
+7: res 1 = 1
-await fiber 6
+8: await fiber 2
-fiber 6 resolved as ok
+9: res 2 = 2
-res 6 = 6
+10: await fiber 3
-await fiber 7
+11: res 3 = 3
-I'm fiber 7 and I'm about to…
+12: await fiber 4
-sub-fiber 8 was cancelled
+13: res 4 = 4
-fiber 8 resolved as error
+14: await fiber 5
-sub-fiber 9 was cancelled
+15: res 5 = 5
-fiber 9 resolved as error
+16: await fiber 6
-main fiber result: error Failure("oh no!")
+17: res 6 = 6
-fiber 7 resolved as error
+18: await fiber 7
-main fib failed with "oh no!"
+19: main fiber result: error Failure("oh no!")
-main fiber exited
+20: main fib failed with "oh no!"
+21: main fiber exited

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 =
+module TS = struct
-  Printf.ksprintf
+  type t = int list
-    (fun s ->
+
-      let out = stdout in
+  let show (s : t) = String.concat "." @@ List.map string_of_int s
-      (let@ () = Lock.with_ lock in
+  let init = [ 0 ]
-       output_string out s);
+
-      flush out)
+  let next_ = function
-    fmt
+    | [] -> [ 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;
+        let clock = ref (0 :: i :: !clock) in
-        logf "cur fiber is some: %b\n%!"
+        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 *)
+  (* same but now, cancel one of the sub-fibers *)
-  logf "============\nstart\n";
+  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
+          | Ok _ -> logf (i :: post) "fiber %d resolved as ok" i
-          | Error _ -> logf "fiber %d resolved as error\n%!" 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 (TS.tick_get clock) "yielded";
-    logf "main fiber done\n%!"
+    logf (TS.tick_get clock) "main fiber done"
   in
 
   F.on_result fib (function
-    | Ok () -> logf "main fiber result: ok\n%!"
+    | Ok () -> logf (TS.tick_get clock) "main fiber result: ok"
-    | Error ebt -> logf "main fiber result: error %s\n%!" (Exn_bt.show ebt));
+    | 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);
+   with Failure msg -> logf (TS.tick_get clock) "main fib failed with %S" msg);
-  logf "main fiber exited\n%!";
+  logf (TS.tick_get clock) "main fiber exited";
+  Log_.print_and_clear ();
   ()