diff --git a/bench/concurrent_bench.ml b/bench/concurrent_bench.ml
new file mode 100644
index 00000000..92bb40f9
--- /dev/null
+++ b/bench/concurrent_bench.ml
@@ -0,0 +1,19 @@
+open Main
+
+let read_index () =
+  let r = Index.v ~fresh:false ~readonly:true ~log_size index_name in
+  Fmt.epr "\n Read in readonly index. \n";
+  let count = ref 0 in
+  Index.iter
+    (fun _ _ ->
+      count := !count + 1;
+      if !count mod 1_000 = 0 then
+        Fmt.epr "\r%a%!" pp_stats (!count, index_size))
+    r
+
+let () =
+  let pid = Unix.fork () in
+  if pid <> 0 then
+    let _ = Unix.fork () in
+    read_index ()
+  else add_and_find ()
diff --git a/bench/dune b/bench/dune
index c75e216d..a5c3aeac 100644
--- a/bench/dune
+++ b/bench/dune
@@ -1,5 +1,5 @@
-(executable
- (name main)
+(executables
+ (names main concurrent_bench)
  (libraries fmt index.unix))
 
 (alias
@@ -10,3 +10,8 @@
 (alias
  (name runtest)
  (deps main.exe))
+
+(alias
+ (name cbench)
+ (action
+  (run ./concurrent_bench.exe)))
diff --git a/bench/main.ml b/bench/main.ml
index 9f7f66df..99455a80 100644
--- a/bench/main.ml
+++ b/bench/main.ml
@@ -55,7 +55,7 @@ let t = Index.v ~fresh:true ~log_size index_name
 let pp_stats ppf (count, max) =
   Fmt.pf ppf "\t%4dk/%dk" (count / 1000) (max / 1000)
 
-let () =
+let add_and_find () =
   let t0 = Sys.time () in
   Fmt.epr "Adding %d bindings.\n%!" index_size;
   let rec loop bindings i =
@@ -83,3 +83,8 @@ let () =
   let t2 = Sys.time () -. t1 in
   Fmt.epr "\n%d bindings found in %fs.\n%!" index_size t2;
   print_newline ()
+
+let () =
+  add_and_find ();
+  Index.flush t;
+  ()