From a26d8bbd4dd854c17a57d38ef8d8fa0361cc5d7c Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 1 Aug 2026 00:30:46 +0000 Subject: Move storage-related helpers to `Helpers` --- test/Helpers.ml | 25 +++++++++++++++++++++++++ test/unit/backend/Storage.ml | 27 ++++----------------------- 2 files changed, 29 insertions(+), 23 deletions(-) (limited to 'test') diff --git a/test/Helpers.ml b/test/Helpers.ml index bf34b82..784170c 100644 --- a/test/Helpers.ml +++ b/test/Helpers.ml @@ -17,3 +17,28 @@ let condition_as_failure = function let pp_value ppf v = Format.pp_print_string ppf (Concepts.Value.to_string v) let value = Alcotest.testable pp_value Concepts.Value.equal + +module Storage = struct + module type CONFIGURATOR = sig + val configure : string -> Rnt.Concepts.Configuration.term + 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 Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct + let with_connection f dir () = + with_temporary_directory dir begin fun dir -> + begin + let open Utilities.Result in + let* conn = S.connect (C.configure dir) in + Ok (f conn) + end + |> condition_as_failure + end + end +end diff --git a/test/unit/backend/Storage.ml b/test/unit/backend/Storage.ml index 91db411..76bda8b 100644 --- a/test/unit/backend/Storage.ml +++ b/test/unit/backend/Storage.ml @@ -1,21 +1,9 @@ open Rnt -module type CONFIGURATOR = sig - val configure : string -> Rnt.Concepts.Configuration.term -end - -module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct +module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.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 + module H = Helpers.Storage.Make (S) (C) let storage_and_retrieval conn = let key = Concepts.Hash.hash_of_value (Concepts.Value.String "value") in @@ -38,16 +26,9 @@ module Make (S : Abstract.Storage.STORAGE) (C : CONFIGURATOR) = struct 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 + [test_case "storage-and-retrieval" `Quick (H.with_connection storage_and_retrieval "storage-test")] ) end -module LMDB = Make (Rnt.Backend.Storage.LMDB) (LMDB_Configurator) +module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) let suites () = [LMDB.suite "lmdb"] -- cgit v1.2.3 From a3f9ee8f227c94646bcc0a2269127b4fe369ebc0 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 1 Aug 2026 00:31:00 +0000 Subject: Some tests for the merkle tree --- test/test_rnt.ml | 1 + test/unit/kernel/Merkle.ml | 55 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+) create mode 100644 test/unit/kernel/Merkle.ml (limited to 'test') diff --git a/test/test_rnt.ml b/test/test_rnt.ml index a2a8e84..d46be1e 100644 --- a/test/test_rnt.ml +++ b/test/test_rnt.ml @@ -2,5 +2,6 @@ let all_suites = Unit.Concepts.Serialization.suites () @ Unit.Backend.Storage.suites () @ Unit.Backend.Lifecycle.suites () + @ Unit.Kernel.Merkle.suites () let () = Alcotest.run "RNT" all_suites diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml new file mode 100644 index 0000000..a08426f --- /dev/null +++ b/test/unit/kernel/Merkle.ml @@ -0,0 +1,55 @@ +open Rnt + +module StringKey : Rnt.Kernel.Merkle.KEY with type t = string = struct + type t = string + + let encode s = String.to_bytes s |> Concepts.Representation.blob_of_bytes + let compare s1 s2 = String.compare s1 s2 |> Concepts.Ordering.of_int + let decode b = Concepts.Representation.bytes_of_blob b |> String.of_bytes |> Result.ok +end + +module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct + open Alcotest + + module H = Helpers.Storage.Make (S) (C) + module T = Rnt.Kernel.Merkle.Interface (S) (StringKey) (StringKey) + + (* TODO: be a bit more comprehensive (ideally, we want to test splits as well) *) + let storage_and_lookup conn = + let v1, v2, v3, v3', bogus = + begin + let open Utilities.Result in + let* tx = S.start conn in + let* node = T.empty + |> T.insert tx "k1" "v1" + |> fmap (T.insert tx "k2" "v2") + |> fmap (T.insert tx "k3" "v3") + in + let* node' = T.insert tx "k3" "toodles" node in + let* v1 = T.lookup tx "k1" node in + let* v2 = T.lookup tx "k2" node in + let* v3 = T.lookup tx "k3" node in + let* v3' = T.lookup tx "k3" node' in + let* bogus = T.lookup tx "fnord" node in + Ok (v1, v2, v3, v3', bogus) + end + |> Helpers.condition_as_failure + in + check (option string) "" (Some "v1") v1; + check (option string) "" (Some "v2") v2; + check (option string) "" (Some "v3") v3; + check (option string) "" (Some "toodles") v3'; + check (option string) "" None bogus + + (* TODO: this will need `remove` *) + (* let determinism _conn = *) + (* () *) + + let suite prefix = + ( "merkle/" ^ prefix, + [test_case "storage-and-lookup" `Quick (H.with_connection storage_and_lookup "merkle-test")]) +end + +module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) + +let suites () = [LMDB.suite "lmdb"] -- cgit v1.2.3 From b7a09b8c8913b26eb22b98aa77a324a1c23736e2 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 1 Aug 2026 01:27:42 +0000 Subject: Actually test persistence --- test/unit/kernel/Merkle.ml | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) (limited to 'test') diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml index a08426f..f12182a 100644 --- a/test/unit/kernel/Merkle.ml +++ b/test/unit/kernel/Merkle.ml @@ -15,7 +15,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = module T = Rnt.Kernel.Merkle.Interface (S) (StringKey) (StringKey) (* TODO: be a bit more comprehensive (ideally, we want to test splits as well) *) - let storage_and_lookup conn = + let insert_and_lookup conn = let v1, v2, v3, v3', bogus = begin let open Utilities.Result in @@ -41,13 +41,45 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = check (option string) "" (Some "toodles") v3'; check (option string) "" None bogus + let persistence conn = + let addr = + begin + let open Utilities.Result in + let* tx = S.start conn in + let* node = T.empty + |> T.insert tx "k1" "v1" + |> fmap (T.insert tx "k2" "v2") + |> fmap (T.insert tx "k3" "v3") + in + let* () = S.commit tx in + Ok (T.hash_of node) + end + |> Helpers.condition_as_failure + in + let v1, v2, v3 = + begin + let open Utilities.Result in + let* tx = S.start conn in + let* node = T.find tx addr |> Result.map Option.get in + let* v1 = T.lookup tx "k1" node in + let* v2 = T.lookup tx "k2" node in + let* v3 = T.lookup tx "k3" node in + Ok (v1, v2, v3) + end + |> Helpers.condition_as_failure + in + check (option string) "" (Some "v1") v1; + check (option string) "" (Some "v2") v2; + check (option string) "" (Some "v3") v3 + (* TODO: this will need `remove` *) (* let determinism _conn = *) (* () *) let suite prefix = ( "merkle/" ^ prefix, - [test_case "storage-and-lookup" `Quick (H.with_connection storage_and_lookup "merkle-test")]) + [test_case "insert-and-lookup" `Quick (H.with_connection insert_and_lookup "merkle-test"); + test_case "persistence" `Quick (H.with_connection persistence "merkle-test")]) end module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator) -- cgit v1.2.3