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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
open Rnt
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) (Rnt.Kernel.Merkle.StringKey) (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 =
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
let* () = S.abort tx in
Ok (v1, v2, v3, v3', bogus)
end
|> Helpers.condition_as_failure
in
check (option string) "that in-memory reads from the first write work properly" (Some "v1") v1;
check (option string) "that in-memory reads from the second write work properly" (Some "v2") v2;
check (option string) "that in-memory reads from the third write work properly" (Some "v3") v3;
check (option string) "that in-memory reads from a value replacement work properly"
(Some "toodles") v3';
check (option string) "that in-memory reads from a non-existent key returns nothing" None bogus
let batching conn =
let intermediate, final =
begin
let open Utilities.Result in
let* tx = S.start conn in
let intermediate = ref None in
let* final =
T.with_batch tx (fun () ->
let* i = T.empty |> T.insert tx "tree" "maple" in
intermediate := Some (T.hash_of i);
T.insert tx "tree" "spruce" i )
in
let* () = S.commit tx in
Ok (Option.get !intermediate, T.hash_of final)
end
|> Helpers.condition_as_failure
in
let i_node, f_node =
begin
let open Utilities.Result in
let* tx = S.start conn in
let* intermediate = T.find tx intermediate in
let* final = T.find tx final in
Ok (intermediate, final)
end
|> Helpers.condition_as_failure
in
check bool "that the intermediate node does not get persisted" true (Option.is_none i_node);
check bool "that the final node does get persisted" true (Option.is_some f_node)
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) "that on-disk reads from the first write work properly" (Some "v1") v1;
check (option string) "that on-disk reads from the second write work properly" (Some "v2") v2;
check (option string) "that on-disk reads from the third write work properly" (Some "v3") v3
let iteration conn =
let keys, values =
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* keys = T.fold_left tx (fun acc k _ -> k :: acc) [] node |> Result.map List.rev in
let* values = T.fold_left tx (fun acc _ v -> v :: acc) [] node |> Result.map List.rev in
let* () = S.abort tx in
Ok (keys, values)
end
|> Helpers.condition_as_failure
in
check (list string) "that keys are properly enumerated from left to right" ["k1"; "k2"; "k3"]
keys;
check (list string) "that values are properly enumerated from left to right" ["v1"; "v2"; "v3"]
values
(* 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 "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") ] )
end
module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
let suites () = [LMDB.suite "lmdb"]
|
