From 7227925fe7e9b3fe15e1ad7bfaab72d0e9de794d Mon Sep 17 00:00:00 2001 From: icristescu Date: Mon, 11 Oct 2021 21:14:35 +0200 Subject: [PATCH] Add test for concurrent reads --- src/index.ml | 1 + src/index_intf.ml | 1 + src/log_file.ml | 12 +++++++--- src/log_file.mli | 3 +++ src/unix/index_unix.ml | 1 + src/unix/index_unix.mli | 1 + test/unix/common.ml | 8 +++---- test/unix/common.mli | 1 + test/unix/main.ml | 49 ++++++++++++++++++++++++++++++++++++----- 9 files changed, 65 insertions(+), 12 deletions(-) diff --git a/src/index.ml b/src/index.ml index 4cf115d9..a5e6e523 100644 --- a/src/index.ml +++ b/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 diff --git a/src/index_intf.ml b/src/index_intf.ml index a9fe5597..ef97ff9f 100644 --- a/src/index_intf.ml +++ b/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 : diff --git a/src/log_file.ml b/src/log_file.ml index 214209d7..d3f3848c 100644 --- a/src/log_file.ml +++ b/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,14 +181,14 @@ 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) @@ -192,6 +196,8 @@ module Make (IO : Io.S) (Key : Data.Key) (Value : Data.Value) = struct | 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 -> diff --git a/src/log_file.mli b/src/log_file.mli index cb425207..bf754c27 100644 --- a/src/log_file.mli +++ b/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 diff --git a/src/unix/index_unix.ml b/src/unix/index_unix.ml index 72de479d..e7a53439 100644 --- a/src/unix/index_unix.ml +++ b/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) diff --git a/src/unix/index_unix.mli b/src/unix/index_unix.mli index 0e549273..b398bbbe 100644 --- a/src/unix/index_unix.mli +++ b/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 diff --git a/test/unix/common.ml b/test/unix/common.ml index f7153f3b..c3756604 100644 --- a/test/unix/common.ml +++ b/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 diff --git a/test/unix/common.mli b/test/unix/common.mli index 6ef87624..ab137467 100644 --- a/test/unix/common.mli +++ b/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 diff --git a/test/unix/main.ml b/test/unix/main.ml index 92288330..9cb72b10 100644 --- a/test/unix/main.ml +++ b/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); ]