merkle range with test

1 files changed, 43 insertions, 1 deletions

diff --git a/test/unit/kernel/Merkle.ml b/test/unit/kernel/Merkle.ml
index 6ac0f63..b54f8d3 100644
--- a/test/unit/kernel/Merkle.ml
+++ b/test/unit/kernel/Merkle.ml
@@ -7,6 +7,8 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
   module T =
     Rnt.Kernel.Merkle.Interface (S) (Rnt.Kernel.Merkle.StringKey) (Rnt.Kernel.Merkle.StringKey)
 
+  module M = Rnt.Kernel.Merkle.Make (S) (Rnt.Kernel.Merkle.StringKey)
+
   (* TODO: be a bit more comprehensive (ideally, we want to test splits as well) *)
   let insert_and_lookup conn =
     let v1, v2, v3, v3', bogus =
@@ -146,13 +148,53 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "removing every key leaves the empty tree" true
       (Concepts.Hash.hash_equals emptied (T.hash_of T.empty))
 
+  let range conn =
+    let key i = Printf.sprintf "k%04d" i in
+    let all = List.init 500 key in
+    let from_on k = List.filter (fun k' -> k' >= k) all in
+    let whole, present, absent, before, after, bounded, stopped =
+      begin
+        let open Utilities.Result in
+        let* tx = S.start conn in
+        let scrambled = List.init 500 (fun i -> key (i * 7919 mod 500)) in
+        let* root =
+          List.fold_left
+            (fun node k -> node |>> M.insert tx k (Concepts.Hash.hash_of_bytes (Bytes.of_string k)))
+            (Ok M.empty) scrambled
+        in
+        let walk ?from ?until () =
+          M.fold_left ?from ?until tx (fun acc k _ -> k :: acc) [] root |> Result.map List.rev
+        in
+        let* whole = walk () in
+        let* present = walk ~from:"k0200" () in
+        let* absent = walk ~from:"k0200a" () in
+        let* before = walk ~from:"a" () in
+        let* after = walk ~from:"z" () in
+        let* bounded = walk ~from:"k0200" ~until:(fun k -> k >= "k0300") () in
+        let* stopped = walk ~until:(fun _ -> true) () in
+        let* () = S.abort tx in
+        Ok (whole, present, absent, before, after, bounded, stopped)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check (list string) "a walk with no range visits every key in order" all whole;
+    check (list string) "a walk from a stored key starts at it" (from_on "k0200") present;
+    check (list string) "a walk from an absent key starts at the next one" (from_on "k0201") absent;
+    check (list string) "a walk from before the first key visits every key" all before;
+    check (list string) "a walk from past the last key visits nothing" [] after;
+    check (list string) "a walk stops before the first key until accepts"
+      (List.init 100 (fun i -> key (200 + i)))
+      bounded;
+    check (list string) "a walk that stops at once visits nothing" [] stopped
+
   let suite =
     ( "kernel/merkle",
       [ test_case "insert-and-lookup" `Quick (H.with_connection insert_and_lookup "merkle-test");
         test_case "batching" `Quick (H.with_connection batching "merkle-test");
         test_case "persistence" `Quick (H.with_connection persistence "merkle-test");
         test_case "iteration" `Quick (H.with_connection iteration "merkle-test");
-        test_case "removal" `Quick (H.with_connection removal "merkle-test") ] )
+        test_case "removal" `Quick (H.with_connection removal "merkle-test");
+        test_case "range" `Quick (H.with_connection range "merkle-test") ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)