Add a simple test when we allocate a uniq resource

bechamel.opam

@@ -21,4 +21,5 @@ depends: [
   "ocaml"      {>= "4.08.0"}
   "dune"       {>= "2.0.0"}
   "fmt"        {>= "0.9.0"}
+  "alcotest"   {with-test}
 ]

test/allocate/dune

@@ -0,0 +1,5 @@
+(test
+ (name test)
+ (package bechamel)
+ (modules test)
+ (libraries bechamel alcotest))

test/allocate/test.ml

@@ -0,0 +1,83 @@
+open Bechamel
+open Bechamel.Toolkit
+
+let all_released =
+  Alcotest.test_case "all released" `Quick @@ fun () ->
+  let global = ref 0 in
+  let called = ref 0 in
+  let test =
+    Test.make_with_resource ~name:"test" Test.uniq
+      ~allocate:(fun () ->
+        incr called;
+        incr global)
+      ~free:(fun () -> decr global)
+      (Staged.stage (Fun.const ()))
+  in
+  let[@warning "-8"] [ test ] = Test.elements test in
+  let cfg = Benchmark.cfg ~limit:10 ~kde:None () in
+  let _ = Benchmark.run cfg Instance.[ monotonic_clock ] test in
+  Alcotest.(check int) "all released" !global 0;
+  if !called = 0 then Alcotest.failf "Benchmark does not allocate"
+
+let with_kde =
+  Alcotest.test_case "with kde" `Quick @@ fun () ->
+  let global = ref 0 in
+  let called = ref 0 in
+  let test =
+    Test.make_with_resource ~name:"test" Test.uniq
+      ~allocate:(fun () ->
+        incr called;
+        incr global)
+      ~free:(fun () -> decr global)
+      (Staged.stage (Fun.const ()))
+  in
+  let[@warning "-8"] [ test ] = Test.elements test in
+  let cfg = Benchmark.cfg ~limit:10 ~kde:(Some 1000) () in
+  let _ = Benchmark.run cfg Instance.[ monotonic_clock ] test in
+  Alcotest.(check int) "with kde" !global 0;
+  if !called = 0 then Alcotest.failf "Benchmark does not allocate"
+
+let uniq_resources =
+  Alcotest.test_case "uniq resources" `Quick @@ fun () ->
+  let tbl = Hashtbl.create 0x100 in
+  let idx = ref 0 in
+  let test =
+    Test.make_with_resource ~name:"test" Test.uniq
+      ~allocate:(fun () ->
+        let value = !idx in
+        incr idx;
+        Hashtbl.add tbl value ();
+        value)
+      ~free:(Hashtbl.remove tbl)
+      (Staged.stage (Fun.const ()))
+  in
+  let[@warning "-8"] [ test ] = Test.elements test in
+  let cfg = Benchmark.cfg ~limit:10 ~kde:(Some 1000) () in
+  let _ = Benchmark.run cfg Instance.[ monotonic_clock ] test in
+  Alcotest.(check int) "uniq resources" (Hashtbl.length tbl) 0
+
+let double_free =
+  Alcotest.test_case "double free" `Quick @@ fun () ->
+  let tbl = Hashtbl.create 0x100 in
+  let idx = ref 0 in
+  let test =
+    Test.make_with_resource ~name:"test" Test.uniq
+      ~allocate:(fun () ->
+        let value = !idx in
+        incr idx;
+        Hashtbl.add tbl value ();
+        value)
+      ~free:(fun value ->
+        match Hashtbl.find_opt tbl value with
+        | None -> Alcotest.failf "Double free"
+        | Some () -> Hashtbl.remove tbl value)
+      (Staged.stage (Fun.const ()))
+  in
+  let[@warning "-8"] [ test ] = Test.elements test in
+  let cfg = Benchmark.cfg ~limit:10 ~kde:(Some 1000) () in
+  let _ = Benchmark.run cfg Instance.[ monotonic_clock ] test in
+  Alcotest.(check int) "double free" (Hashtbl.length tbl) 0
+
+let () =
+  Alcotest.run "allocate"
+    [ ("uniq", [ all_released; with_kde; uniq_resources; double_free ]) ]