diff options
Diffstat (limited to '')
| -rw-r--r-- | test/Helpers.ml | 19 | ||||
| -rw-r--r-- | test/dune | 2 | ||||
| -rw-r--r-- | test/test_rnt.ml | 4 | ||||
| -rw-r--r-- | test/unit/backend/Storage.ml | 53 |
4 files changed, 76 insertions, 2 deletions
diff --git a/test/Helpers.ml b/test/Helpers.ml new file mode 100644 index 0000000..bf34b82 --- /dev/null +++ b/test/Helpers.ml @@ -0,0 +1,19 @@ +open Rnt + +let rec recursively_remove path = + if Sys.is_directory path then begin + Sys.readdir path |> Array.iter (fun name -> recursively_remove (Filename.concat path name)); + Unix.rmdir path + end + else Sys.remove path + +let with_temporary_directory prefix ?(suffix = "") f = + let path = Filename.temp_dir ~temp_dir:"/tmp" prefix suffix in + Fun.protect (fun () -> f path) ~finally:(fun () -> recursively_remove path) + +let condition_as_failure = function + | Ok r -> r + | Error c -> Alcotest.fail (Concepts.Condition.to_string_hum c) + +let pp_value ppf v = Format.pp_print_string ppf (Concepts.Value.to_string v) +let value = Alcotest.testable pp_value Concepts.Value.equal @@ -1,3 +1,5 @@ +(include_subdirs qualified) + (test (name test_rnt) (libraries rnt alcotest)) diff --git a/test/test_rnt.ml b/test/test_rnt.ml index 4838ff4..5dd79cf 100644 --- a/test/test_rnt.ml +++ b/test/test_rnt.ml @@ -1,2 +1,2 @@ -let test_version () = Alcotest.(check string) "version" "0.1.0" Rnt.version -let () = Alcotest.run "rnt" ["smoke", [Alcotest.test_case "version" `Quick test_version]] +let all_suites = Unit.Backend.Storage.suites () +let () = Alcotest.run "RNT" all_suites diff --git a/test/unit/backend/Storage.ml b/test/unit/backend/Storage.ml new file mode 100644 index 0000000..91db411 --- /dev/null +++ b/test/unit/backend/Storage.ml @@ -0,0 +1,53 @@ +open Rnt + +module type CONFIGURATOR = sig + val configure : string -> Rnt.Concepts.Configuration.term +end + +module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct + open Alcotest + + let with_connection f () = + Helpers.with_temporary_directory "storage-test" begin fun dir -> + begin + let open Utilities.Result in + let* conn = S.connect (C.configure dir) in + Ok (f conn) + end + |> Helpers.condition_as_failure + end + + let storage_and_retrieval conn = + let key = Concepts.Hash.hash_of_value (Concepts.Value.String "value") in + let value = Concepts.Value.Integer 42 in + let blob = Concepts.Representation.blob_of_value value in + let v, v' = + begin + let open Utilities.Result in + let* tx = S.start conn in + let* v = S.get tx key in + let* () = S.put tx key blob in + let* v' = S.get tx key in + Ok Concepts.Representation.(Option.map value_of_blob v, Option.map value_of_blob v') + end + |> Helpers.condition_as_failure + in + check (option Helpers.value) "`get` before `put` should return no value" None v; + check (option Helpers.value) "`get` after `put` should return the inserted value" (Some value) + v' + + let suite prefix = + ( "storage/" ^ prefix, + [test_case "storage-and-retrieval" `Quick (with_connection storage_and_retrieval)] ) +end + +module LMDB_Configurator : CONFIGURATOR = struct + let configure base = + let open Sexplib.Sexp in + List [Atom "lmdb"; List [Atom "path"; Atom base]; List [Atom "mode"; Atom "420"]] + |> Rnt.Concepts.Configuration.term_of_sexp +end + +module LMDB = Make (Rnt.Backend.Storage.LMDB) (LMDB_Configurator) + +let suites () = [LMDB.suite "lmdb"] |