From 4e321b9c468b81edd94bd5664e09ff3523eb0561 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 31 May 2023 23:25:31 -0400
Subject: [PATCH] add little benchmark tool in test + start script

---
 Makefile         |  5 +++++
 bench1.sh        |  2 ++
 test/dune        |  6 ++---
 test/t_bench1.ml | 57 ++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 67 insertions(+), 3 deletions(-)
 create mode 100755 bench1.sh
 create mode 100644 test/t_bench1.ml

diff --git a/Makefile b/Makefile
index 1a091758..a6550ad0 100644
--- a/Makefile
+++ b/Makefile
@@ -6,6 +6,11 @@ all:
 clean:
 	@dune clean
 
+test:
+	@dune runtest $(DUNE_OPTS)
+
 WATCH?=@all
 watch:
 	dune build $(DUNE_OPTS) -w $(WATCH)
+
+.PHONY: test clean
diff --git a/bench1.sh b/bench1.sh
new file mode 100755
index 00000000..32ba819a
--- /dev/null
+++ b/bench1.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec dune exec --release --display=quiet -- test/t_bench1.exe $@
diff --git a/test/dune b/test/dune
index be643efa..4f33656e 100644
--- a/test/dune
+++ b/test/dune
@@ -1,3 +1,3 @@
-(test
- (name t_fib)
- (libraries moonpool))
+(tests
+ (names t_fib t_bench1)
+ (libraries moonpool tracy tracy-client))
diff --git a/test/t_bench1.ml b/test/t_bench1.ml
new file mode 100644
index 00000000..16dd78da
--- /dev/null
+++ b/test/t_bench1.ml
@@ -0,0 +1,57 @@
+open Moonpool
+
+let ( let@ ) = ( @@ )
+
+let rec fib x =
+  if x <= 1 then
+    1
+  else
+    fib (x - 1) + fib (x - 2)
+
+let run ~psize ~n ~j () : _ Fut.t =
+  Printf.printf "pool size=%d, n=%d, j=%d\n%!" psize n j;
+  let pool =
+    Pool.create
+      ~on_init_thread:(fun ~dom_id:_ ~t_id () ->
+        Tracy.name_thread (Printf.sprintf "t_%d" t_id))
+      ~min:psize ~per_domain:0 ()
+  in
+
+  let loop () =
+    let@ _sp = Tracy.with_ ~file:__FILE__ ~line:__LINE__ ~name:"loop" () in
+    for _i = 1 to n do
+      let () =
+        let@ _sp = Tracy.with_ ~file:__FILE__ ~line:__LINE__ ~name:"iter" () in
+        Tracy.add_text _sp (string_of_int _i);
+        ignore (Sys.opaque_identity (fib 30) : int)
+      in
+
+      Thread.yield ()
+    done
+  in
+
+  let fut = Fut.for_ ~on:pool j (fun _ -> loop ()) in
+  fut
+
+let () =
+  Tracy.enable ();
+  let j = ref 10 in
+  let n = ref 10 in
+  let psize = ref 4 in
+  let opts =
+    [
+      "-psize", Arg.Set_int psize, " pool size";
+      "-j", Arg.Set_int j, " number of tasks";
+      "-n", Arg.Set_int n, " number of iterations per task";
+    ]
+    |> Arg.align
+  in
+  Arg.parse opts ignore "";
+
+  (* start two distinct pools *)
+  let fut1 = run ~psize:!psize ~n:!n ~j:!j () in
+  let fut2 = run ~psize:!psize ~n:!n ~j:!j () in
+
+  Fut.wait_block_exn fut1;
+  Fut.wait_block_exn fut2;
+  Printf.printf "done\n%!"