test: update tests, removing the fibers and cancellation tests

test/fiber/dune

@@ -6,7 +6,6 @@
  (libraries
   t_fibers
   moonpool
-  moonpool.fib
   trace
   trace-tef
   qcheck-core

test/fiber/lib/dune

@@ -2,4 +2,4 @@
  (name t_fibers)
  (package moonpool)
  (optional)
- (libraries moonpool moonpool.fib trace qcheck-core hmap))
+ (libraries moonpool trace qcheck-core hmap))

test/fiber/lib/fib.ml

@@ -1,6 +1,7 @@
-open! Moonpool
+module Chan = Moonpool.Chan
+module Exn_bt = Moonpool.Exn_bt
 module A = Atomic
-module F = Moonpool_fib.Fiber
+module Fut = Moonpool.Fut
 
 let ( let@ ) = ( @@ )
 
@@ -49,24 +50,23 @@ let logf = Log_.logf
 let run1 ~runner () =
   Printf.printf "============\nstart\n%!";
   let clock = ref TS.init in
-  let fib =
+  let fut =
-    F.spawn_top ~on:runner @@ fun () ->
+    Fut.spawn ~on:runner @@ fun () ->
     let chan_progress = Chan.create ~max_size:4 () in
     let chans = Array.init 5 (fun _ -> Chan.create ~max_size:4 ()) in
 
     let subs =
       List.init 5 (fun i ->
-          F.spawn ~protect:false @@ fun _n ->
+          Fut.spawn ~on:runner @@ fun _n ->
           Thread.delay (float i *. 0.01);
           Chan.pop chans.(i);
           Chan.push chan_progress i;
-          F.check_if_cancelled ();
           i)
     in
 
     logf (TS.tick_get clock) "wait for subs";
 
-    F.spawn_ignore (fun () ->
+    Moonpool.run_async runner (fun () ->
         for i = 0 to 4 do
           Chan.push chans.(i) ();
           let i' = Chan.pop chan_progress in
@@ -78,19 +78,15 @@ let run1 ~runner () =
        (fun i f ->
          let clock = ref (0 :: i :: clock0) in
          logf !clock "await fiber %d" i;
-         logf (TS.tick_get clock) "cur fiber[%d] is some: %b" i
+         let res = Fut.await f in
-           (Option.is_some @@ F.Private_.get_cur_opt ());
+         Fut.yield ();
-         let res = F.await f in
-         logf (TS.tick_get clock) "cur fiber[%d] is some: %b" i
-           (Option.is_some @@ F.Private_.get_cur_opt ());
-         F.yield ();
          logf (TS.tick_get clock) "res %d = %d" i res)
        subs);
 
     logf (TS.tick_get clock) "main fiber done"
   in
 
-  Fut.await @@ F.res fib;
+  Fut.await fut;
   logf (TS.tick_get clock) "main fiber exited";
   Log_.print_and_clear ();
   ()
@@ -99,15 +95,11 @@ let run2 ~runner () =
   (* same but now, cancel one of the sub-fibers *)
   Printf.printf "============\nstart\n";
 
-  let clock = ref TS.init in
+  let to_await = ref [] in
-  let fib =
-    F.spawn_top ~on:runner @@ fun () ->
-    let@ () =
-      F.with_on_self_cancel (fun ebt ->
-          logf (TS.tick_get clock) "main fiber cancelled with %s"
-          @@ Exn_bt.show ebt)
-    in
 
+  let clock = ref TS.init in
+  let fut =
+    Fut.spawn ~on:runner @@ fun () ->
     let chans_unblock = Array.init 10 (fun _i -> Chan.create ~max_size:4 ()) in
     let chan_progress = Chan.create ~max_size:4 () in
 
@@ -116,11 +108,7 @@ let run2 ~runner () =
       let clock0 = !clock in
       List.init 10 (fun i ->
           let clock = ref (0 :: i :: clock0) in
-          F.spawn ~protect:false @@ fun _n ->
+          Fut.spawn ~on:runner @@ fun _n ->
-          let@ () =
-            F.with_on_self_cancel (fun _ ->
-                logf (TS.tick_get clock) "sub-fiber %d was cancelled" i)
-          in
           Thread.delay 0.002;
 
           (* sync for determinism *)
@@ -132,46 +120,51 @@ let run2 ~runner () =
             failwith "oh no!"
           );
 
-          F.check_if_cancelled ();
           i)
     in
 
     let post = TS.tick_get clock in
     List.iteri
       (fun i fib ->
-        F.on_result fib (function
+        Fut.on_result fib (function
           | Ok _ -> logf (i :: post) "fiber %d resolved as ok" i
           | Error _ -> logf (i :: post) "fiber %d resolved as error" i))
       subs;
 
     (* sequentialize the fibers, for determinism *)
-    F.spawn_ignore (fun () ->
+    let sender =
-        for j = 0 to 9 do
+      Fut.spawn ~on:runner (fun () ->
-          Chan.push chans_unblock.(j) ();
+          for j = 0 to 9 do
-          let j' = Chan.pop chan_progress in
+            Chan.push chans_unblock.(j) ();
-          assert (j = j')
+            let j' = Chan.pop chan_progress in
-        done);
+            assert (j = j')
+          done)
+    in
+    to_await := sender :: !to_await;
 
     logf (TS.tick_get clock) "wait for subs";
     List.iteri
       (fun i f ->
         logf (TS.tick_get clock) "await fiber %d" i;
-        let res = F.await f in
+        let res = Fut.await f in
         logf (TS.tick_get clock) "res %d = %d" i res)
       subs;
     logf (TS.tick_get clock) "yield";
-    F.yield ();
+    Fut.yield ();
     logf (TS.tick_get clock) "yielded";
     logf (TS.tick_get clock) "main fiber done"
   in
 
-  F.on_result fib (function
+  Fut.on_result fut (function
     | 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.await @@ F.res fib
+  (try Fut.await fut
    with Failure msg -> logf (TS.tick_get clock) "main fib failed with %S" msg);
   logf (TS.tick_get clock) "main fiber exited";
+
+  List.iter Fut.await !to_await;
+
   Log_.print_and_clear ();
   ()

test/fiber/lib/fls.ml

@@ -1,7 +1,7 @@
 open! Moonpool
 module A = Atomic
-module F = Moonpool_fib.Fiber
+module F = Moonpool.Fut
-module FLS = Moonpool_fib.Fls
+module FLS = Moonpool.Task_local_storage
 
 (* ### dummy little tracing system with local storage *)
 
@@ -122,7 +122,7 @@ let run ~pool ~pool_name () =
 
     let subs =
       List.init 2 (fun idx_sub_sub ->
-          F.spawn ~protect:true (fun () ->
+          F.spawn ~on:pool (fun () ->
               sub_sub_child ~idx ~idx_child ~idx_sub ~idx_sub_sub ()))
     in
     List.iter F.await subs
@@ -133,8 +133,7 @@ let run ~pool ~pool_name () =
 
     let subs =
       List.init 2 (fun k ->
-          F.spawn ~protect:true @@ fun () ->
+          F.spawn ~on:pool @@ fun () -> sub_child ~idx ~idx_child ~idx_sub:k ())
-          sub_child ~idx ~idx_child ~idx_sub:k ())
     in
 
     let@ () =
@@ -149,16 +148,14 @@ let run ~pool ~pool_name () =
 
     let subs =
       List.init 5 (fun j ->
-          F.spawn ~protect:true @@ fun () -> top_child ~idx ~idx_child:j ())
+          F.spawn ~on:pool @@ fun () -> top_child ~idx ~idx_child:j ())
     in
 
     List.iter F.await subs
   in
 
   Printf.printf "run test on pool = %s\n" pool_name;
-  let fibs =
+  let fibs = List.init 8 (fun idx -> F.spawn ~on:pool (fun () -> top idx)) in
-    List.init 8 (fun idx -> F.spawn_top ~on:pool (fun () -> top idx))
-  in
   List.iter F.await fibs;
 
   Printf.printf "tracing complete\n";

test/fiber/t_fib1.expected

@@ -2,33 +2,21 @@
 start
 1: wait for subs
 1.0.0: await fiber 0
-1.0.1: cur fiber[0] is some: true
+1.0.1: res 0 = 0
-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.1: res 1 = 1
-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.1: res 2 = 2
-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.1: res 3 = 3
-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.1: res 4 = 4
-1.4.2: cur fiber[4] is some: true
-1.4.3: res 4 = 4
 2: main fiber done
 3: main fiber exited
 ============
 start
 1: start fibers
 1.7.1: I'm fiber 7 and I'm about to fail…
-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
@@ -37,8 +25,8 @@ start
 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.8: fiber 8 resolved as ok
-2.9: fiber 9 resolved as error
+2.9: fiber 9 resolved as ok
 3: wait for subs
 4: await fiber 0
 5: res 0 = 0
@@ -55,7 +43,6 @@ start
 16: await fiber 6
 17: res 6 = 6
 18: await fiber 7
-19: main fiber cancelled with Failure("oh no!")
+19: main fiber result: error Failure("oh no!")
-20: main fiber result: error Failure("oh no!")
+20: main fib failed with "oh no!"
-21: main fib failed with "oh no!"
+21: main fiber exited
-22: main fiber exited

test/fiber/t_fib1.ml

@@ -1,6 +1,6 @@
 let ( let@ ) = ( @@ )
 
 let () =
-  let@ runner = Moonpool_fib.main in
+  let@ runner = Moonpool.main in
   T_fibers.Fib.run1 ~runner ();
   T_fibers.Fib.run2 ~runner ()

test/fiber/t_fls.ml

@@ -3,7 +3,7 @@ open! Moonpool
 let ( let@ ) = ( @@ )
 
 let () =
-  let@ _ = Moonpool_fib.main in
+  let@ _ = Moonpool.main in
   (let@ pool = Ws_pool.with_ () in
    T_fibers.Fls.run ~pool ~pool_name:"ws_pool" ());
 

test/fiber/t_main.ml

@@ -1,14 +1,14 @@
 open Moonpool
-module F = Moonpool_fib
+module F = Moonpool.Fut
 
 let ( let@ ) = ( @@ )
 
 let () =
   let r =
-    F.main @@ fun runner ->
+    Moonpool.main @@ fun runner ->
-    let f1 = F.spawn (fun () -> 1) in
+    let f1 = F.spawn ~on:runner (fun () -> 1) in
-    let f2 = F.spawn_top ~on:runner (fun () -> 2) in
+    let f2 = F.spawn ~on:runner (fun () -> 2) in
-    let f3 = F.spawn (fun () -> F.await f1 + 10) in
+    let f3 = F.spawn ~on:runner (fun () -> F.await f1 + 10) in
     let r = F.await f2 + F.await f3 in
     assert (r = 13);
     r
@@ -19,10 +19,10 @@ let () =
   (* run fibers in the background, await them in the main thread *)
   let@ bg = Fifo_pool.with_ ~num_threads:4 () in
   let r =
-    F.main @@ fun runner ->
+    Moonpool.main @@ fun runner ->
-    let f1 = F.spawn_top ~on:bg (fun () -> 1) in
+    let f1 = F.spawn ~on:bg (fun () -> 1) in
-    let f2 = F.spawn_top ~on:runner (fun () -> 2) in
+    let f2 = F.spawn ~on:runner (fun () -> 2) in
-    let f3 = F.spawn_top ~on:bg (fun () -> F.await f1 + 10) in
+    let f3 = F.spawn ~on:bg (fun () -> F.await f1 + 10) in
     let r = F.await f2 + F.await f3 in
     assert (r = 13);
     r
@@ -32,8 +32,8 @@ let () =
 let () =
   try
     let _r =
-      F.main @@ fun _r ->
+      Moonpool.main @@ fun runner ->
-      let fib = F.spawn (fun () -> failwith "oops") in
+      let fib = F.spawn ~on:runner (fun () -> failwith "oops") in
       F.await fib
     in
 

test/lwt/fibers/dune

@@ -6,7 +6,6 @@
  (libraries
   t_fibers
   moonpool
-  moonpool.fib
   moonpool-lwt
   hmap
   trace

test/lwt/fibers/t_fib1.expected

@@ -2,33 +2,21 @@
 start
 1: wait for subs
 1.0.0: await fiber 0
-1.0.1: cur fiber[0] is some: true
+1.0.1: res 0 = 0
-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.1: res 1 = 1
-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.1: res 2 = 2
-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.1: res 3 = 3
-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.1: res 4 = 4
-1.4.2: cur fiber[4] is some: true
-1.4.3: res 4 = 4
 2: main fiber done
 3: main fiber exited
 ============
 start
 1: start fibers
 1.7.1: I'm fiber 7 and I'm about to fail…
-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
@@ -37,8 +25,8 @@ start
 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.8: fiber 8 resolved as ok
-2.9: fiber 9 resolved as error
+2.9: fiber 9 resolved as ok
 3: wait for subs
 4: await fiber 0
 5: res 0 = 0
@@ -55,7 +43,6 @@ start
 16: await fiber 6
 17: res 6 = 6
 18: await fiber 7
-19: main fiber cancelled with Failure("oh no!")
+19: main fiber result: error Failure("oh no!")
-20: main fiber result: error Failure("oh no!")
+20: main fib failed with "oh no!"
-21: main fib failed with "oh no!"
+21: main fiber exited
-22: main fiber exited

test/lwt/fibers/t_main.ml

@@ -1,6 +1,6 @@
 open Moonpool
 module M_lwt = Moonpool_lwt
-module F = Moonpool_fib
+module F = Moonpool.Fut
 
 let ( let@ ) = ( @@ )
 
@@ -9,9 +9,9 @@ let () =
   let@ bg = Fifo_pool.with_ ~num_threads:4 () in
   let r =
     M_lwt.lwt_main @@ fun runner ->
-    let f1 = F.spawn_top ~on:bg (fun () -> 1) in
+    let f1 = F.spawn ~on:bg (fun () -> 1) in
-    let f2 = F.spawn_top ~on:runner (fun () -> 2) in
+    let f2 = F.spawn ~on:runner (fun () -> 2) in
-    let f3 = F.spawn_top ~on:runner (fun () -> F.await f1 + 10) in
+    let f3 = F.spawn ~on:runner (fun () -> F.await f1 + 10) in
     let r = F.await f2 + F.await f3 in
     assert (r = 13);
     r
@@ -24,7 +24,7 @@ let () =
     try
       let _r =
         M_lwt.lwt_main @@ fun runner ->
-        let fib = F.spawn_top ~on:runner (fun () -> failwith "oops") in
+        let fib = F.spawn ~on:runner (fun () -> failwith "oops") in
         F.await fib
       in