From 4cdec87aea4361d73b476ede2ba1227867c18e50 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 21 Feb 2024 00:53:24 -0500
Subject: [PATCH] add some tests for fiber

---
 test/fiber/dune            |  15 ++++++
 test/fiber/t_fib1.expected |  50 ++++++++++++++++++
 test/fiber/t_fib1.ml       | 104 +++++++++++++++++++++++++++++++++++++
 test/fiber/t_fls.ml        |   1 +
 4 files changed, 170 insertions(+)
 create mode 100644 test/fiber/dune
 create mode 100644 test/fiber/t_fib1.expected
 create mode 100644 test/fiber/t_fib1.ml
 create mode 100644 test/fiber/t_fls.ml

diff --git a/test/fiber/dune b/test/fiber/dune
new file mode 100644
index 00000000..58edc229
--- /dev/null
+++ b/test/fiber/dune
@@ -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
+  ))
diff --git a/test/fiber/t_fib1.expected b/test/fiber/t_fib1.expected
new file mode 100644
index 00000000..3352684d
--- /dev/null
+++ b/test/fiber/t_fib1.expected
@@ -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
diff --git a/test/fiber/t_fib1.ml b/test/fiber/t_fib1.ml
new file mode 100644
index 00000000..ad5f0bbc
--- /dev/null
+++ b/test/fiber/t_fib1.ml
@@ -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%!";
+  ()
diff --git a/test/fiber/t_fls.ml b/test/fiber/t_fls.ml
new file mode 100644
index 00000000..a81e8c89
--- /dev/null
+++ b/test/fiber/t_fls.ml
@@ -0,0 +1 @@
+(* TODO: test FLS *)