1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
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 insert_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
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 "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)
let suites () = [LMDB.suite "lmdb"]
|
