From 4e112e15919db938d434daa7d866d8d9d9e32584 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 15 Jun 2023 21:34:33 -0400
Subject: [PATCH] add some property tests

---
 dune-project    |  1 +
 moonpool.opam   |  1 +
 test/dune       |  4 ++--
 test/t_props.ml | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 53 insertions(+), 2 deletions(-)
 create mode 100644 test/t_props.ml

diff --git a/dune-project b/dune-project
index fcde2fa8..ce0512d3 100644
--- a/dune-project
+++ b/dune-project
@@ -20,6 +20,7 @@
   dune
   (either (>= 1.0))
   (trace :with-test)
+  (qcheck-core (and :with-test (>= 0.19)))
   (odoc :with-doc)
   (mdx
    (and
diff --git a/moonpool.opam b/moonpool.opam
index 3458e407..d04f7837 100644
--- a/moonpool.opam
+++ b/moonpool.opam
@@ -13,6 +13,7 @@ depends: [
   "dune" {>= "3.0"}
   "either" {>= "1.0"}
   "trace" {with-test}
+  "qcheck-core" {with-test & >= "0.19"}
   "odoc" {with-doc}
   "mdx" {>= "1.9.0" & with-test}
 ]
diff --git a/test/dune b/test/dune
index 90187c80..5b210cad 100644
--- a/test/dune
+++ b/test/dune
@@ -1,5 +1,5 @@
 (tests
- (names t_fib t_bench1 t_fib_rec t_futs1 t_tree_futs)
- (libraries moonpool 
+ (names t_fib t_bench1 t_fib_rec t_futs1 t_tree_futs t_props)
+ (libraries moonpool qcheck-core qcheck-core.runner
             ;tracy-client.trace
             trace))
diff --git a/test/t_props.ml b/test/t_props.ml
new file mode 100644
index 00000000..ae6638ae
--- /dev/null
+++ b/test/t_props.ml
@@ -0,0 +1,49 @@
+module Q = QCheck
+open Moonpool
+
+let tests = ref []
+let add_test t = tests := t :: !tests
+
+(* main pool *)
+let pool = Pool.create ~min:4 ~per_domain:1 ()
+
+(* pool for future combinators *)
+let pool_fut = Pool.create ~min:2 ()
+
+module Fut2 = (val Fut.infix pool_fut)
+
+let () =
+  add_test
+  @@ 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
+         let l' = Fut.join_list l' |> Fut.wait_block_exn in
+         if l' <> List.map succ l then Q.Test.fail_reportf "bad list";
+         true)
+
+let () =
+  add_test
+  @@ Q.Test.make ~name:"map bind"
+       Q.(small_list small_int)
+       (fun l ->
+         let open Fut2 in
+         let l' =
+           l
+           |> List.map (fun x ->
+                  let* x = Fut.spawn ~on:pool_fut (fun () -> x + 1) in
+                  let* y = Fut.return (x - 1) in
+                  let+ z = Fut.spawn ~on:pool_fut (fun () -> string_of_int y) in
+                  z)
+         in
+
+         Fut.wait_list l' |> Fut.wait_block_exn;
+
+         let l_res = List.map Fut.get_or_fail_exn l' in
+         if l_res <> List.map string_of_int l then
+           Q.Test.fail_reportf "bad list: from %s, to %s"
+             Q.Print.(list int l)
+             Q.Print.(list string l_res);
+         true)
+
+let () = QCheck_base_runner.run_tests_main !tests