tests: run some tests on both Pool and Simple_pool

test/dune

@@ -9,6 +9,7 @@
   t_chan_train
   t_resource
   t_unfair
+  t_ws_deque
   t_bounded_queue)
  (libraries
   moonpool

test/t_fib.ml

@@ -1,5 +1,12 @@
 open Moonpool
 
+let ( let@ ) = ( @@ )
+
+let with_pool ~kind () f =
+  match kind with
+  | `Simple_pool -> Simple_pool.with_ ~min:4 () f
+  | `Pool -> Pool.with_ ~min:4 () f
+
 let rec fib x =
   if x <= 1 then
     1
@@ -8,8 +15,7 @@ let rec fib x =
 
 let () = assert (List.init 10 fib = [ 1; 1; 2; 3; 5; 8; 13; 21; 34; 55 ])
 
-let run_test () =
+let run_test ~pool () =
-  let pool = Pool.create ~min:4 () in
   let fibs = Array.init 30 (fun n -> Fut.spawn ~on:pool (fun () -> fib n)) in
   let res = Fut.join_array fibs |> Fut.wait_block in
   Pool.shutdown pool;
@@ -50,11 +56,23 @@ let run_test () =
           832040;
         |])
 
-let () =
+let run ~kind () =
   for _i = 1 to 4 do
-    run_test ()
+    let@ pool = with_pool ~kind () in
+    run_test ~pool ()
   done;
 
   (* now make sure we can do this with multiple pools in parallel *)
-  let jobs = Array.init 4 (fun _ -> Thread.create run_test ()) in
+  let jobs =
+    Array.init 4 (fun _ ->
+        Thread.create
+          (fun () ->
+            let@ pool = with_pool ~kind () in
+            run_test ~pool ())
+          ())
+  in
   Array.iter Thread.join jobs
+
+let () =
+  run ~kind:`Pool ();
+  run ~kind:`Simple_pool ()

test/t_fib_rec.ml

@@ -1,4 +1,6 @@
-open Moonpool
+open! Moonpool
+
+let ( let@ ) = ( @@ )
 
 let rec fib_direct x =
   if x <= 1 then
@@ -6,9 +8,13 @@ let rec fib_direct x =
   else
     fib_direct (x - 1) + fib_direct (x - 2)
 
+let n_calls_fib_direct = Atomic.make 0
+
 let rec fib ~on x : int Fut.t =
   if x <= 18 then
-    Fut.spawn ~on (fun () -> fib_direct x)
+    Fut.spawn ~on (fun () ->
+        Atomic.incr n_calls_fib_direct;
+        fib_direct x)
   else
     let open Fut.Infix_local in
     let+ t1 = fib ~on (x - 1) and+ t2 = fib ~on (x - 2) in
@@ -16,14 +22,19 @@ let rec fib ~on x : int Fut.t =
 
 let () = assert (List.init 10 fib_direct = [ 1; 1; 2; 3; 5; 8; 13; 21; 34; 55 ])
 
-let fib_40 : int =
+let fib_40 : int lazy_t =
+  lazy
+    (let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "fib40" in
      let pool = Pool.create ~min:8 () in
      let r = fib ~on:pool 40 |> Fut.wait_block_exn in
      Pool.shutdown pool;
-  r
+     r)
 
 let run_test () =
-  let pool = Pool.create ~min:8 () in
+  let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "run-test" in
+  let@ pool = Pool.with_ ~min:8 () in
+
+  let (lazy fib_40) = fib_40 in
 
   assert (
     List.init 10 (fib ~on:pool)
@@ -34,11 +45,26 @@ let run_test () =
   let fibs = Array.init n_fibs (fun _ -> fib ~on:pool 40) in
 
   let res = Fut.join_array fibs |> Fut.wait_block in
-  Pool.shutdown pool;
 
   assert (res = Ok (Array.make n_fibs fib_40))
 
+let setup_counter () =
+  if Trace.enabled () then
+    ignore
+      (Thread.create
+         (fun () ->
+           while true do
+             Thread.delay 0.01;
+             Trace.counter_int "n-fib-direct" (Atomic.get n_calls_fib_direct)
+           done)
+         ()
+        : Thread.t)
+
 let () =
+  let@ () = Trace_tef.with_setup () in
+  setup_counter ();
+
+  let (lazy fib_40) = fib_40 in
   Printf.printf "fib 40 = %d\n%!" fib_40;
   for _i = 1 to 2 do
     run_test ()

test/t_props.ml

@@ -1,20 +1,19 @@
 module Q = QCheck
 open Moonpool
 
+let ( let@ ) = ( @@ )
 let tests = ref []
 let add_test t = tests := t :: !tests
 
-(* main pool *)
+let with_pool ~kind () f =
-let pool = Pool.create ~min:4 ~per_domain:1 ()
+  match kind with
-
+  | `Simple_pool -> Simple_pool.with_ ~min:4 ~per_domain:1 () f
-(* pool for future combinators *)
+  | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f
-let pool_fut = Pool.create ~min:2 ()
-
-module Fut2 = (val Fut.infix pool_fut)
 
 let () =
-  add_test
+  add_test @@ fun ~kind ->
-  @@ Q.Test.make ~name:"map then join_list"
+  let@ pool = with_pool ~kind () in
+  Q.Test.make ~name:"map then join_list"
     Q.(small_list small_int)
     (fun l ->
       let l' = List.map (fun x -> Fut.spawn ~on:pool (fun () -> x + 1)) l in
@@ -23,17 +22,18 @@ let () =
       true)
 
 let () =
-  add_test
+  add_test @@ fun ~kind ->
-  @@ Q.Test.make ~name:"map bind"
+  let@ pool = with_pool ~kind () in
+  Q.Test.make ~name:"map bind"
     Q.(small_list small_int)
     (fun l ->
-         let open Fut2 in
+      let open Fut.Infix_local in
       let l' =
         l
         |> List.map (fun x ->
-                  let* x = Fut.spawn ~on:pool_fut (fun () -> x + 1) in
+               let* x = Fut.spawn ~on:pool (fun () -> x + 1) in
                let* y = Fut.return (x - 1) in
-                  let+ z = Fut.spawn ~on:pool_fut (fun () -> string_of_int y) in
+               let+ z = Fut.spawn ~on:pool (fun () -> string_of_int y) in
                z)
       in
 
@@ -46,4 +46,9 @@ let () =
           Q.Print.(list string l_res);
       true)
 
-let () = QCheck_base_runner.run_tests_main !tests
+let () =
+  let tests =
+    List.map (fun t -> [ t ~kind:`Simple_pool; t ~kind:`Pool ]) !tests
+    |> List.flatten
+  in
+  QCheck_base_runner.run_tests_main tests

test/t_resource.ml

@@ -2,8 +2,13 @@ open! Moonpool
 
 let ( let@ ) = ( @@ )
 
+let with_pool ~kind () f =
+  match kind with
+  | `Simple_pool -> Simple_pool.with_ ~min:4 ~per_domain:1 () f
+  | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f
+
 (* test proper resource handling *)
-let () =
+let run ~kind () =
   let@ () = Trace_tef.with_setup () in
   let a = Atomic.make 0 in
   for _i = 1 to 1_000 do
@@ -12,7 +17,11 @@ let () =
     if _i mod 100 = 0 then Thread.delay 0.8;
 
     (* allocate a new pool at each iteration *)
-    let@ p = Pool.with_ ~min:4 () in
+    let@ p = with_pool ~kind () in
     Pool.run_wait_block p (fun () -> Atomic.incr a)
   done;
   assert (Atomic.get a = 1_000)
+
+let () =
+  run ~kind:`Pool ();
+  run ~kind:`Simple_pool ()

test/t_tree_futs.ml

@@ -2,6 +2,11 @@ open Moonpool
 
 let ( let@ ) = ( @@ )
 
+let with_pool ~kind ~j () f =
+  match kind with
+  | `Simple_pool -> Simple_pool.with_ ~min:j () f
+  | `Pool -> Pool.with_ ~min:j () f
+
 type 'a tree =
   | Leaf of 'a
   | Node of 'a tree Fut.t * 'a tree Fut.t
@@ -61,15 +66,13 @@ let stat_thread () =
       done)
     ()
 
-let () =
+let run_main ~kind () =
-  (*
+  let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "run_main" in
-  Tracy_client_trace.setup ();
-   *)
   let start = Unix.gettimeofday () in
   let n = try int_of_string (Sys.getenv "N") with _ -> default_n in
   let j = try int_of_string (Sys.getenv "J") with _ -> 4 in
 
-  let pool = Pool.create ~min:j () in
+  let@ pool = with_pool ~kind ~j () in
   ignore (stat_thread () : Thread.t);
 
   Printf.printf "n=%d, j=%d\n%!" n j;
@@ -79,3 +82,11 @@ let () =
   assert (n1 = 1 lsl (n - 1));
   assert (n2 = 1 lsl (n - 1));
   ()
+
+let () =
+  let@ () = Trace_tef.with_setup () in
+  (*
+  Tracy_client_trace.setup ();
+   *)
+  run_main ~kind:`Pool ();
+  run_main ~kind:`Simple_pool ()