Add test for interleaved reads

src/index.ml

@@ -1039,6 +1039,7 @@ module Private = struct
   module Data = Data
   module Layout = Layout
   module Logs = Log
+  module Log_file = Log_file
 
   module Hook = struct
     type 'a t = 'a -> unit

src/index_intf.ml

@@ -312,6 +312,7 @@ module type Index = sig
     module Fan = Fan
     module Data = Data
     module Layout = Layout
+    module Log_file = Log_file
 
     module Logs : sig
       val setup :

src/log_file.ml

@@ -73,12 +73,16 @@ module Make (IO : Io.S) (Key : Data.Key) (Value : Data.Value) = struct
     assert (r = len);
     fst (Entry.decode_key (Bytes.unsafe_to_string scratch.buffer) 0)
 
-  let entry_of_offset t (scratch : Scratch.t) off =
+  let entry_of_offset' ~hook t (scratch : Scratch.t) off =
     let len = Entry.encoded_size in
     let r = IO.read t.io ~off ~len scratch.buffer in
+    hook ();
     assert (r = Entry.encoded_size);
     Entry.decode (Bytes.unsafe_to_string scratch.buffer) 0
 
+  let entry_of_offset t scratch off =
+    entry_of_offset' ~hook:Fun.id t scratch off
+
   let elt_index t key =
     (* NOTE: we use the _uppermost_ bits of the key hash to index the bucket
        array, so that the hashtbl is approximately sorted by key hash (with only
@@ -177,21 +181,23 @@ module Make (IO : Io.S) (Key : Data.Key) (Value : Data.Value) = struct
     IO.iter_keys (fun offset key -> replace_memory t scratch key offset) io;
     t
 
-  let find t key =
+  let find' ~hook t key =
     let elt_idx = elt_index t key in
     let bucket = t.hashtbl.(elt_idx) in
     let scratch = Scratch.create () in
     Small_list.find_map bucket ~f:(fun offset ->
         (* We expect the keys to match most of the time, so we decode the
            value at the same time. *)
-        let entry = entry_of_offset t scratch offset in
+        let entry = entry_of_offset' ~hook t scratch offset in
         match Key.equal key entry.key with
         | false -> None
         | true -> Some entry.value)
     |> function
     | None -> raise Not_found
     | Some x -> x
 
+  let find t key = find' ~hook:Fun.id t key
+
   let fold t ~f ~init =
     let scratch = Scratch.create () in
     ArrayLabels.fold_left t.hashtbl ~init ~f:(fun acc bucket ->

src/log_file.mli

@@ -65,4 +65,7 @@ module Make (IO : Io.S) (Key : Data.Key) (Value : Data.Value) : sig
     generation:int63 -> ?hook:(unit -> unit) -> reopen:bool -> t -> unit
   (** [clear t] clears both [t]'s in-memory state and its underlying IO handle.
       The flags are passed to [IO.clear]. *)
+
+  val find' : hook:(unit -> unit) -> t -> key -> value
+  (** Similar to [find] but to be used in tests. *)
 end

src/unix/index_unix.ml

@@ -426,6 +426,7 @@ module Syscalls = Syscalls
 module Private = struct
   module IO = IO
   module Raw = Raw
+  module Thread = Thread
 
   module Make (K : Index.Key.S) (V : Index.Value.S) =
     Index.Private.Make (K) (V) (Platform)

src/unix/index_unix.mli

@@ -28,6 +28,7 @@ module Syscalls = Syscalls
 module Private : sig
   module IO : Index.Platform.IO
   module Raw = Raw
+  module Thread : Index.Platform.THREAD
 
   module Make (K : Index.Key.S) (V : Index.Value.S) (C : Index.Cache.S) :
     Index.Private.S with type key = K.t and type value = V.t

test/unix/common.ml

@@ -38,8 +38,8 @@ type binding = Key.t * Value.t
 let pp_binding ppf (key, value) =
   Fmt.pf ppf "{ %a → %a }" (Repr.pp Key.t) key (Repr.pp Value.t) value
 
-let check_entry findf typ k v =
-  match findf k with
+let check_entry ~find typ k v =
+  match find k with
   | v' when Value.equal v v' -> ()
   | v' (* v =/= v' *) ->
       Alcotest.failf "Found %s when checking for binding %a in %s" v' pp_binding
@@ -56,7 +56,7 @@ module Tbl = struct
     assert (Hashtbl.length h = size);
     h
 
-  let check_binding tbl = check_entry (Hashtbl.find tbl) "table"
+  let check_binding tbl = check_entry ~find:(Hashtbl.find tbl) "table"
 end
 
 module Index = struct
@@ -66,7 +66,7 @@ module Index = struct
     let ((key, value) as binding) = (Key.v (), Value.v ()) in
     (binding, replace' ?hook t key value)
 
-  let check_binding index = check_entry (find index) "index"
+  let check_binding index = check_entry ~find:(find index) "index"
 
   let check_not_found index k =
     match find index k with

test/unix/common.mli

@@ -108,3 +108,4 @@ val check_equivalence : Index.t -> (Key.t, Value.t) Hashtbl.t -> unit
 val check_disjoint : Index.t -> (Key.t, Value.t) Hashtbl.t -> unit
 val get_open_fd : string -> [> `Ok of string list | `Skip of string ]
 val partition : string -> string list -> string list * string list
+val check_entry : find:(string -> string) -> string -> string -> string -> unit

test/unix/main.ml

@@ -2,6 +2,8 @@ module Hook = Index.Private.Hook
 module Layout = Index.Private.Layout
 module Semaphore = Semaphore_compat.Semaphore.Binary
 module I = Index
+module IO = Index_unix.Private.IO
+module Int63 = Optint.Int63
 open Common
 
 type index = Common.Index.t
@@ -127,16 +129,15 @@ module Live = struct
     Index.flush rw;
     Index.clear rw;
     Index.close rw;
-    let module I = Index_unix.Private.IO in
     let test_there path =
-      match I.v_readonly path with
+      match IO.v_readonly path with
       | Error `No_file_on_disk -> Alcotest.failf "expected file: %s" path
       | Ok data ->
-          Alcotest.(check int) path (I.size data) (I.size_header data);
-          I.close data
+          Alcotest.(check int) path (IO.size data) (IO.size_header data);
+          IO.close data
     in
     let test_not_there path =
-      match I.v_readonly path with
+      match IO.v_readonly path with
       | Error `No_file_on_disk -> ()
       | Ok _ -> Alcotest.failf "do not expect file: %s" path
     in
@@ -1040,6 +1041,43 @@ module Throttle = struct
     ]
 end
 
+module Log_file = struct
+  module Log_file = I.Private.Log_file.Make (IO) (Key) (Value)
+  module Thread = Index_unix.Private.Thread
+
+  let reads () =
+    let root = Context.fresh_name "empty_index" in
+    let log_path = Layout.log ~root in
+    let log_io =
+      IO.v ~fresh:false ~fan_size:Int63.zero ~generation:Int63.zero log_path
+    in
+    let log = Log_file.create log_io in
+    let k1, v1 = (Key.v (), Value.v ()) in
+    let k2, v2 = (Key.v (), Value.v ()) in
+    Log_file.replace log k1 v1;
+    Log_file.replace log k2 v2;
+    let find = Log_file.find log in
+    check_entry ~find "log" k1 v1;
+    let find = Log_file.find log in
+    check_entry ~find "log" k2 v2;
+    let hook () = ignore_value (Log_file.find log k1) in
+    let () =
+      let thread =
+        Thread.async (fun () ->
+            let find = Log_file.find' ~hook log in
+            check_entry ~find "log" k2 v2)
+      in
+      Thread.await thread |> function
+      | Ok () -> ()
+      | Error (`Async_exn exn) ->
+          Alcotest.failf "Unexpected asynchronous exception: %s"
+            (Printexc.to_string exn)
+    in
+    Log_file.close log
+
+  let tests = [ ("interleaved reads", `Quick, reads) ]
+end
+
 let () =
   Common.report ();
   Alcotest.run "index.unix"
@@ -1053,4 +1091,5 @@ let () =
       ("filter", Filter.tests);
       ("flush_callback", Flush_callback.tests);
       ("throttle", Throttle.tests);
+      ("log file", Log_file.tests);
     ]