bechamel: double free with Test.uniq

[edwintorok]

Test.multiple seems to be fine but Test.uniq does a double free:

  
 let (allocate0 : unit -> _), free0, (allocate1 : int -> _), free1 =
    match kind with
    | Test.Uniq ->
        let v = [| Test.Uniq.prj (allocate ()) |] in
        ( (fun () -> Test.Uniq.prj (allocate ()))
        , (fun v -> free (Test.Uniq.inj v))
        , always v
        , fun a -> a |> Array.iter @@ fun v -> free (Test.Uniq.inj v) )
    | Test.Multiple ->
        let v = unsafe_array_get (Test.Multiple.prj (allocate 1)) 0 in
        ( always v
        , (fun v -> free (Test.Multiple.inj [| v |]))
        , (fun n -> Test.Multiple.prj (allocate n))
        , fun v -> free (Test.Multiple.inj v) )
  in

allocate1 and free1 get called multiple times in the benchmark loop, unlike allocate0 and free0 which get called just once.

Even if the argument ends up unused that can still result in a deadlock, crash or exception being thrown by the 'free1' implementation.

Would probably be useful to have some unit tests for this.

I've modified list.ml slightly to show this:

dune exec ./list.exe
Entering directory '/home/edvint/koji/toolstack-dev2/xapi.spec/scm'
Done: 64% (112/174, 62 left) (jobs: 0)Fatal error: exception File "ocaml/tests/bench/bechamel/examples/list.ml", line 29, characters 6-12: Assertion failed

diff --git a/examples/list.ml b/examples/list.ml
index ede684eb8e..b95bc3f54d 100644
--- a/examples/list.ml
+++ b/examples/list.ml
@@ -7,7 +7,7 @@ open Toolkit
    NOTE: [words] is __outside__ our [(unit -> 'a) Staged.t]*)

 let make_list words =
-  Staged.stage @@ fun () ->
+  Staged.stage @@ fun _ ->
   let rec go n acc = if n = 0 then acc else go (n - 1) (n :: acc) in
   ignore (go ((words / 3) + 1) [])

@@ -23,7 +23,13 @@ let make_list words =
         ; make_list 1000 ]
     ]} *)
 let test =
-  Test.make_indexed ~name:"list" ~fmt:"%s %d" ~args:[ 0; 10; 100; 400; 1000 ]
+  Test.make_indexed_with_resource ~name:"list" ~fmt:"%s %d" ~args:[ 0; 10; 100; 400; 1000 ]
+    ~allocate:(fun _ -> ref false)
+    ~free:(fun r ->
+      assert (not !r);
+      r := true
+    )
+    Test.uniq (* Test.multiple *)
     make_list

 (* From our test, we can start to benchmark it!