From f0d7558e50a9eb4f1967d6266cbb037054d21d32 Mon Sep 17 00:00:00 2001 From: Zolisa Bleki Date: Tue, 2 Jul 2024 19:20:01 +0200 Subject: [PATCH] Add unit tests for the `Storage` module. --- lib/storage/filesystem.ml | 4 +- lib/storage/interface.ml | 78 +++++++++------- lib/storage/memory.ml | 3 +- test/test_storage.ml | 191 ++++++++++++++++++++++++++++++++++++++ test/test_zarr.ml | 4 +- 5 files changed, 244 insertions(+), 36 deletions(-) create mode 100644 test/test_storage.ml diff --git a/lib/storage/filesystem.ml b/lib/storage/filesystem.ml index eb17cb6..525b452 100644 --- a/lib/storage/filesystem.ml +++ b/lib/storage/filesystem.ml @@ -27,7 +27,7 @@ module Impl = struct (fun ic -> Ok (In_channel.input_all ic)) with | Sys_error _ | End_of_file -> - Error (`Store_read_error fpath) + Error (`Store_read fpath) let set t key value = let filename = key_to_fspath t key in @@ -108,7 +108,7 @@ let open_store ?(file_perm=0o640) path = Ok Impl.{dirname; file_perm} else Result.error @@ - `Store_read_error (path ^ " is not a Filesystem store.") + `Store_read (path ^ " is not a Filesystem store.") let open_or_create ?(file_perm=0o640) path = try open_store ~file_perm path with diff --git a/lib/storage/interface.ml b/lib/storage/interface.ml index 267d191..93216d7 100644 --- a/lib/storage/interface.ml +++ b/lib/storage/interface.ml @@ -5,7 +5,7 @@ type key = string type range = ByteRange of int * int option type error = - [ `Store_read_error of string + [ `Store_read of string | `Invalid_slice of string | `Invalid_kind of string | `Reshape_error of string @@ -89,17 +89,21 @@ module Make (M : STORE) : S with type t = M.t = struct module GM = GroupMetadata include M + (* All nodes are explicit upon creation so just check the node's metadata key.*) + let is_member t node = + M.is_member t @@ Node.to_metakey node + let rec create_group ?metadata t node = - match metadata, Node.to_metakey node with - | Some m, k -> set t k @@ GM.encode m; - | None, k -> set t k @@ GM.(default |> encode); - make_implicit_groups_explicit t node + if is_member t node then () + else + (match metadata, Node.to_metakey node with + | Some m, k -> set t k @@ GM.encode m; + | None, k -> set t k @@ GM.(default |> encode)); + make_implicit_groups_explicit t @@ Node.parent node - and make_implicit_groups_explicit t node = - List.iter (fun n -> - match get t @@ Node.to_metakey n with - | Ok _ -> () - | Error _ -> create_group t n) @@ Node.ancestors node + and make_implicit_groups_explicit t = function + | None -> () + | Some n -> create_group t n let create_array ?(sep=Extensions.Slash) @@ -121,14 +125,17 @@ module Make (M : STORE) : S with type t = M.t = struct >>= fun codecs -> let meta = AM.create - ~sep ~codecs ~dimension_names ~attributes ~shape kind fill_value chunks + ~sep + ~codecs + ~dimension_names + ~attributes + ~shape + kind + fill_value + chunks in set t (Node.to_metakey node) (AM.encode meta); - Ok (make_implicit_groups_explicit t node) - - (* All nodes are explicit upon creation so just check the node's metadata key.*) - let is_member t node = - M.is_member t @@ Node.to_metakey node + Ok (make_implicit_groups_explicit t @@ Node.parent node) (* Assumes without checking that [metakey] is a valid node metadata key.*) let unsafe_node_type t metakey = @@ -147,38 +154,47 @@ module Make (M : STORE) : S with type t = M.t = struct GM.decode bytes >>= fun meta -> Ok (Either.right meta) | false, _ -> - Error (`Store_read_error (Node.to_path node ^ " is not a store member.")) + Result.error @@ + `Store_read (Node.show node ^ " is not a store member.") let group_metadata node t = match get_metadata node t with - | Ok x -> Ok (Either.find_right x |> Option.get) + | Ok x when Either.is_right x -> + Ok (Either.find_right x |> Option.get) + | Ok _ -> + Result.error @@ + `Store_read (Node.show node ^ " is not a group node.") | Error _ as err -> err let array_metadata node t = match get_metadata node t with - | Ok x -> Ok (Either.find_left x |> Option.get) + | Ok x when Either.is_left x -> + Ok (Either.find_left x |> Option.get) + | Ok _ -> + Result.error @@ + `Store_read (Node.show node ^ " is not an array node.") | Error _ as err -> err let find_child_nodes t node = match is_member t node, Node.to_metakey node with | true, k when unsafe_node_type t k = "group" -> Result.ok @@ - List.fold_left (fun (lacc, racc) pre -> - match - Node.of_path @@ - "/" ^ String.(length pre - 1 |> sub pre 0) - with - | Ok x -> + List.fold_left + (fun (lacc, racc) pre -> + let x = + Result.get_ok @@ (* this operation should not fail *) + Node.of_path @@ + "/" ^ String.(length pre - 1 |> sub pre 0) + in if unsafe_node_type t (pre ^ "zarr.json") = "array" then x :: lacc, racc else - lacc, x :: racc - | Error _ -> lacc, racc) + lacc, x :: racc) ([], []) (snd @@ list_dir t @@ Node.to_prefix node) | true, _ -> - Error (Node.to_path node ^ " is not a group node.") + Error (Node.show node ^ " is not a group node.") | false, _ -> - Error (Node.to_path node ^ " is not a node in this heirarchy.") + Error (Node.show node ^ " is not a node in this heirarchy.") let find_all_nodes t = let rec aux acc p = @@ -276,7 +292,7 @@ module Make (M : STORE) : S with type t = M.t = struct with | Assert_failure _ -> Result.error @@ - `Store_read_error "slice shape is not compatible with node's shape.") + `Store_read "slice shape is not compatible with node's shape.") >>= fun sshape -> let pair = Array.map @@ -312,7 +328,7 @@ module Make (M : STORE) : S with type t = M.t = struct (if "array" = unsafe_node_type t mkey then Ok () else - Error (`Reshape_error (Node.to_path node ^ " is not an array node."))) + Error (`Reshape_error (Node.show node ^ " is not an array node."))) >>= fun () -> get t mkey >>= fun bytes -> AM.decode bytes >>= fun meta -> diff --git a/lib/storage/memory.ml b/lib/storage/memory.ml index c0be211..7578eb4 100644 --- a/lib/storage/memory.ml +++ b/lib/storage/memory.ml @@ -11,8 +11,7 @@ module Impl = struct let get t key = Option.to_result - ~none:(`Store_read_error key) @@ - StrMap.find_opt t key + ~none:(`Store_read key) @@ StrMap.find_opt t key let set t key value = StrMap.replace t key value diff --git a/test/test_storage.ml b/test/test_storage.ml new file mode 100644 index 0000000..732f312 --- /dev/null +++ b/test/test_storage.ml @@ -0,0 +1,191 @@ +open OUnit2 +open Zarr +open Zarr.Storage + +module Ndarray = Owl.Dense.Ndarray.Generic + +let string_of_list = [%show: string list] + +let test_store + (type a) (module M : Zarr.Storage.S with type t = a) (store : a) = + let gnode = Node.root in + + M.create_group store gnode; + assert_equal + ~printer:string_of_bool + true @@ + M.is_member store gnode; + + (match M.group_metadata gnode store with + | Ok meta -> + assert_equal + ~printer:GroupMetadata.show GroupMetadata.default meta + | Error _ -> + assert_failure + "group node created with default values should + have metadata with default values."); + + M.erase_node store gnode; + assert_bool + "Cannot retrive metadata of a node not in the store." @@ + Result.is_error @@ M.group_metadata gnode store; + assert_equal + ~printer:[%show: Node.t list] + [] @@ + M.find_all_nodes store; + + let attrs = `Assoc [("questions", `String "answer")] in + M.create_group + ~metadata:GroupMetadata.(update_attributes default attrs) + store + gnode; + (match M.group_metadata gnode store with + | Ok meta -> + assert_equal + ~printer:Yojson.Safe.show + attrs @@ + GroupMetadata.attributes meta + | Error _ -> + assert_failure + "group node created with specified values should + have metadata with said values."); + + let fake = Node.(gnode / "non-member") |> Result.get_ok in + assert_equal + ~printer:string_of_bool + false @@ + M.is_member store fake; + + let anode = Node.(gnode / "arrnode") |> Result.get_ok in + let r = + M.create_array + ~shape:[|100; 100; 50|] + ~chunks:[|10; 15; 20|] + Bigarray.Complex64 + Complex.zero + anode + store + in + assert_equal (Ok ()) r; + + assert_bool + "Cannot get group metadata from an array node" @@ + Result.is_error @@ M.group_metadata anode store; + + let slice = Owl_types.[|R [0; 20]; I 10; R []|] in + let expected = + Ndarray.create Bigarray.Complex64 [|21; 1; 50|] Complex.zero in + let got = + Result.get_ok @@ + M.get_array anode slice Bigarray.Complex64 store in + assert_equal + ~printer:Owl_pretty.dsnda_to_string + expected + got; + + let x' = Ndarray.map (fun _ -> Complex.one) got in + let r = M.set_array anode slice x' store in + assert_equal (Ok ()) r; + let got = + Result.get_ok @@ + M.get_array anode slice Bigarray.Complex64 store + in + assert_equal ~printer:Owl_pretty.dsnda_to_string x' got; + assert_bool + "get_array can only work with the correct array kind" @@ + Result.is_error @@ M.get_array anode slice Bigarray.Int32 store; + assert_bool + "get_array slice shape must be the same as the array's." @@ + Result.is_error @@ + M.get_array + anode + Owl_types.[|R [0; 20]; I 10; R []; R [] |] + Bigarray.Complex64 + store; + + let bad_slice = Owl_types.[|R [0; 20]; I 10; I 0|] in + assert_bool + "slice written to store must have the same + shape as the array to be written" @@ + Result.is_error @@ + M.set_array anode bad_slice x' store; + let bad_arr = + Ndarray.create Bigarray.Int32 [|21; 1; 50|] Int32.max_int in + assert_bool + "slice written to store must have the same + shape as the array to be written" @@ + Result.is_error @@ + M.set_array anode slice bad_arr store; + + let child = Node.of_path "/some/child" |> Result.get_ok in + M.create_group store child; + (match M.find_child_nodes store gnode with + | Ok (arrays, groups) -> + assert_equal + ~printer:string_of_list + ["/arrnode"] @@ + List.map Node.to_path arrays; + assert_equal + ~printer:string_of_list + ["/some"] @@ + List.map Node.to_path groups + | Error _ -> + assert_failure + "a store with more than one node + should return children for a root node."); + + assert_bool + "Array nodes cannot have children" + (Result.is_error @@ M.find_child_nodes store anode); + + let got = + M.find_all_nodes store + |> List.map Node.show + |> List.fast_sort String.compare in + assert_equal + ~printer:string_of_list + ["/"; "/arrnode"; "/some"; "/some/child"] + got; + + let new_shape = [|25; 32; 10|] in + let r = M.reshape store anode new_shape in + assert_equal (Ok ()) r; + let meta = + Result.get_ok @@ + M.array_metadata anode store in + assert_equal + ~printer:[%show: int array] + new_shape @@ + ArrayMetadata.shape meta; + assert_bool + "Group nodes cannot be reshaped" @@ + Result.is_error @@ M.reshape store gnode new_shape; + assert_bool + "New shape must have the number of dims as the node." @@ + Result.is_error @@ M.reshape store anode [|25; 10|]; + + assert_bool + "Cannot get array metadata from a group node" @@ + Result.is_error @@ M.array_metadata gnode store; + assert_bool + "Cannot get array metadata from a node not a member of store" @@ + Result.is_error @@ M.array_metadata fake store; + + M.erase_node store anode + + +let tests = [ + "test in-memory store" >:: + (fun _ -> + test_store + (module MemoryStore) @@ MemoryStore.create ()) +; + "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.") +] diff --git a/test/test_zarr.ml b/test/test_zarr.ml index 4021dc9..af7f10e 100644 --- a/test/test_zarr.ml +++ b/test/test_zarr.ml @@ -6,6 +6,8 @@ let () = Test_node.tests @ Test_indexing.tests @ Test_metadata.tests @ - Test_codecs.tests + Test_codecs.tests @ + Test_storage.tests + in run_test_tt_main suite