Improve test coverage of the storage module.

lib/storage/filesystem.ml

@@ -26,8 +26,7 @@ module Impl = struct
         fpath
         (fun ic -> Ok (In_channel.input_all ic))
     with
-    | Sys_error _ | End_of_file ->
-      Error (`Store_read fpath)
+    | Sys_error _ -> Error (`Store_read fpath)
 
   let set t key value =
     let filename = key_to_fspath t key in
@@ -41,23 +40,23 @@ module Impl = struct
   let list t =
     let module StrSet = Storage_intf.Base.StrSet in
     let rec aux acc path =
-      try
-        match Sys.readdir path with
-        | [||] -> acc
-        | xs ->
-          Array.fold_left (fun set x ->
-            match path ^ x with
-            | p when Sys.is_directory p ->
-              aux set @@ p ^ "/"
-            | p ->
-              StrSet.add (fspath_to_key t p) set) acc xs 
-      with
-      | Sys_error _ -> acc
+      match Sys.readdir path with
+      | [||] -> acc
+      | xs ->
+        Array.fold_left (fun set x ->
+          match path ^ x with
+          | p when Sys.is_directory p ->
+            aux set @@ p ^ "/"
+          | p ->
+            StrSet.add (fspath_to_key t p) set) acc xs 
     in
+  (* calling aux using the basepath t.dirname should not fail
+     since this path already exists by virtue of being able to
+     access this filestystem store. *)
     match
       StrSet.elements @@
       aux StrSet.empty @@
-      key_to_fspath t ""
+      key_to_fspath t "" 
     with
     | [] -> []
     | xs -> "" :: xs
@@ -92,7 +91,7 @@ module Impl = struct
     Storage_intf.Base.list_dir ~list_fn:list t pre
 end
 
-let create ?(file_perm=0o640) path =
+let create ?(file_perm=0o700) path =
   Impl.create_parent_dir path file_perm;
   Sys.mkdir path file_perm;
   let dirname =
@@ -102,18 +101,23 @@ let create ?(file_perm=0o640) path =
       path ^ "/" in
   Impl.{dirname; file_perm}
 
-let open_store ?(file_perm=0o640) path =
-  if Sys.is_directory path then
-    let dirname =
-      if String.ends_with ~suffix:"/" path then
-        path
-      else
-        path ^ "/" in
-    Ok Impl.{dirname; file_perm}
-  else
-    Result.error @@
-    `Store_read (path ^ " is not a Filesystem store.")
-
-let open_or_create ?(file_perm=0o640) path =
-  try open_store ~file_perm path with
-  | Sys_error _ -> Ok (create ~file_perm path)
+let open_store ?(file_perm=0o700) path =
+  try
+    if Sys.is_directory path then
+      let dirname =
+        if String.ends_with ~suffix:"/" path then
+          path
+        else
+          path ^ "/" in
+      Ok Impl.{dirname; file_perm}
+    else
+      Result.error @@
+      `Store_read (path ^ " is not a Filesystem store.")
+  with
+  | Sys_error _ ->
+    Result.error @@ `Store_read (path ^ " does not exist.")
+
+let open_or_create ?(file_perm=0o700) path =
+  match open_store ~file_perm path with
+  | Ok v -> Ok v
+  | Error _ -> Ok (create ~file_perm path)

lib/storage/storage.ml

@@ -92,43 +92,47 @@ module Make (M : STORE) : S with type t = M.t = struct
       Result.ok @@
       List.fold_left
         (fun (lacc, racc) pre ->
+          let p = "/" ^ String.(length pre - 1 |> sub pre 0) in
           if unsafe_node_type t (pre ^ "zarr.json") = "array" then
-            let x =
-              Result.get_ok @@
-              ArrayNode.of_path @@
-              "/" ^ String.(length pre - 1 |> sub pre 0)
-            in
-              x :: lacc, racc
+            let x = Result.get_ok @@ ArrayNode.of_path p in
+            x :: lacc, racc
           else
-            let x =
-              Result.get_ok @@
-              GroupNode.of_path @@
-              "/" ^ String.(length pre - 1 |> sub pre 0)
-            in
-              lacc, x :: racc)
+            let x = Result.get_ok @@ GroupNode.of_path p in
+            lacc, x :: racc)
         ([], []) (snd @@ list_dir t @@ GroupNode.to_prefix node)
     else
       let msg =
         GroupNode.show node ^ " is not a node in this heirarchy." in
       Result.error @@ `Store_read msg
 
   let find_all_nodes t =
-    let rec aux ((l, r) as acc) p =
-      match find_child_nodes t p with
-      | Error _ -> acc
-      | Ok ([], []) -> (l, p :: r)
-      | Ok (arrays, groups) ->
-        let (l', r') =
-          List.map (aux acc) groups |> List.split in
-        arrays @ List.concat l', p :: List.concat r'
-    in aux ([], []) GroupNode.root
+    let keys =
+      List.filter
+        (String.ends_with ~suffix:"/zarr.json")
+        (list_prefix "" t) in
+    let a, g =
+      List.fold_left
+        (fun (lacc, racc) key ->
+          let p = "/" ^ String.(length key - 10 |> sub key 0) in
+          if unsafe_node_type t key = "array" then
+            (Result.get_ok @@ ArrayNode.of_path p) :: lacc, racc
+          else
+            lacc, (Result.get_ok @@ GroupNode.of_path p) :: racc)
+        ([], []) keys in
+    match a, g with
+    | [], [] -> a, g
+    | l, r -> l, GroupNode.root :: r
 
   let erase_group_node t node =
     erase_prefix t @@ GroupNode.to_prefix node
 
   let erase_array_node t node =
     erase t @@ ArrayNode.to_metakey node
 
+  let erase_all_nodes t =
+    (* [erase_prefix t ""] is surely faster? *)
+    erase_values t @@ list_prefix "" t
+
   let set_array
   : type a b.
     ArrayNode.t ->

lib/storage/storage_intf.ml

@@ -109,6 +109,10 @@ module type S = sig
       erases all child nodes of [n]. If node [n] is not a member
       of store [t] then this is a no-op. *)
 
+  val erase_all_nodes : t -> unit
+  (** [erase_all_nodes t] clears the store [t] by deleting all nodes.
+      If the store is already empty, this is a no-op. *)
+
   val group_exists : t -> GroupNode.t -> bool
   (** [group_exists t n] returns [true] if group node [n] is a member
       of store [t] and [false] otherwise. *)

test/test_storage.ml

@@ -27,6 +27,9 @@ let test_store
       have metadata with default values.");
 
   M.erase_group_node store gnode;
+  (* tests deleting a non-existant group *)
+  M.erase_group_node store @@ Result.get_ok @@ GroupNode.(root / "nonexist");
+
   assert_bool
     "Cannot retrive metadata of a node not in the store." @@
     Result.is_error @@ M.group_metadata gnode store;
@@ -68,6 +71,18 @@ let test_store
       store
   in
   assert_equal (Ok ()) r;
+  (* should work with a custom chain too *)
+  let r =
+    M.create_array
+      ~codecs:{a2a = []; a2b = Bytes Big; b2b = []}
+      ~shape:[|100; 100; 50|]
+      ~chunks:[|10; 15; 20|]
+      Bigarray.Complex64
+      Complex.zero
+      anode
+      store
+  in
+  assert_equal (Ok ()) r;
 
   let slice = Owl_types.[|R [0; 20]; I 10; R []|] in
   let expected =
@@ -131,6 +146,14 @@ let test_store
       "a store with more than one node
       should return children for a root node.");
 
+  (* test getting child nodes of a group not a member of this store. *)
+  let r =
+    M.find_child_nodes store @@
+    (Result.get_ok @@ GroupNode.(root / "fakegroup")) in
+  assert_bool
+    "finding child nodes of a non-store group node should fail." @@
+    Result.is_error r;
+
   let ac, gc = M.find_all_nodes store in
   let got =
     List.map ArrayNode.show ac @ List.map GroupNode.show gc
@@ -158,21 +181,76 @@ let test_store
     "Cannot get array metadata from a node not a member of store" @@
     Result.is_error @@ M.array_metadata fake store;
 
-  M.erase_array_node store anode
-
+  M.erase_array_node store anode;
+  (* test clearing of store *)
+  M.erase_all_nodes store;
+  assert_equal
+    ~printer:[%show: ArrayNode.t list * GroupNode.t list]
+    ([], []) @@
+    M.find_all_nodes store
 
 let tests = [
-  "test in-memory store" >::
-    (fun _ ->
-      test_store
-        (module MemoryStore) @@ MemoryStore.create ())
+
+"test in-memory store" >::
+  (fun _ ->
+    let s = MemoryStore.create () in
+    (* test if store is empty upon creation *)
+    assert_equal
+      ~printer:[%show: ArrayNode.t list * GroupNode.t list]
+      ([], [])
+      (MemoryStore.find_all_nodes s);
+    test_store (module MemoryStore) s)
 ;
-  "test filesystem store" >::
-    (fun _ ->
-      let tmp_dir = Filename.get_temp_dir_name () ^ ".zarr" in
-      Sys.mkdir tmp_dir 0o777;
-      match FilesystemStore.open_or_create ~file_perm:0o777 tmp_dir with
-      | Ok s -> test_store (module FilesystemStore) s
-      | Error _ ->
-        assert_failure "FilesystemStore creation should not fail.")
+
+"test filesystem store" >::
+  (fun _ ->
+    let tmp_dir = Filename.get_temp_dir_name () ^ ".zarr/" in
+    (match FilesystemStore.open_or_create tmp_dir with
+    | Ok s ->
+        (* test if store is empty upon creation *)
+        assert_equal
+          ~printer:[%show: ArrayNode.t list * GroupNode.t list]
+          ([], [])
+          (FilesystemStore.find_all_nodes s);
+        test_store (module FilesystemStore) s
+    | Error _ ->
+      assert_failure "FilesystemStore creation should not fail.");
+
+    let r = FilesystemStore.open_or_create tmp_dir in
+    assert_bool
+      "An existing store should not fail to open."
+      (Result.is_ok r);
+
+    (* test storage creation using named directory that already exists *)
+    let err_msg =
+      Format.sprintf "%s: File exists" tmp_dir in
+    assert_raises
+      (Sys_error err_msg)
+      (fun () -> FilesystemStore.create tmp_dir);
+    (* tests storage creation using a new directory *)
+    let new_dir = Filename.get_temp_dir_name () ^ "newdir12345.zarr" in
+    assert_bool
+      "Creation of new non-existing store should not fail."
+      (try
+        ignore @@ FilesystemStore.create new_dir;
+        true
+        with
+        | Sys_error _ -> false);
+
+    (* test successful opening of an existing store. *)
+    assert_bool
+      "An existing store should not fail to open."
+      (Result.is_ok @@ FilesystemStore.open_store new_dir);
+
+    (* test failure of opening an non-existant store. *)
+    assert_bool
+      "reading a non-existant store should always fail." @@
+      Result.is_error @@
+      FilesystemStore.open_store "non-existant-zarr-store112345.zarr";
+
+    (* test failure of opening a store using a file instead of directory *)
+    let fn = Filename.temp_file "nonexistantfile" ".zarr" in
+    assert_bool
+      "reading a store from a file should always fail." @@
+      Result.is_error @@ FilesystemStore.open_store fn)
 ]