gazagnaire.org
Minimal SQLite key-value store for OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6(** Fuzz tests for the pure OCaml B-tree backed key-value store. *)
7
8open Crowbar
9
10let truncate ?(max_len = 4096) s =
11 if String.length s > max_len then String.sub s 0 max_len else s
12
13(* Core KV operations *)
14
15(** Roundtrip - put then get must return same value. *)
16let test_roundtrip key value =
17 let key = truncate key in
18 let value = truncate value in
19 let db = Sqlite.in_memory () in
20 Sqlite.put db key value;
21 let result = Sqlite.find db key in
22 check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value
23
24(** Delete removes key. *)
25let test_delete_removes key value =
26 let key = truncate key in
27 let value = truncate value in
28 let db = Sqlite.in_memory () in
29 Sqlite.put db key value;
30 Sqlite.delete db key;
31 check (Option.is_none (Sqlite.find db key))
32
33(** mem consistent with get. *)
34let test_mem_consistent key value =
35 let key = truncate key in
36 let value = truncate value in
37 let db = Sqlite.in_memory () in
38 Sqlite.put db key value;
39 check_eq ~pp:Format.pp_print_bool (Sqlite.mem db key)
40 (Option.is_some (Sqlite.find db key))
41
42(** Overwrite replaces value - last put wins. *)
43let test_overwrite key value1 value2 =
44 let key = truncate key in
45 let value1 = truncate value1 in
46 let value2 = truncate value2 in
47 let db = Sqlite.in_memory () in
48 Sqlite.put db key value1;
49 Sqlite.put db key value2;
50 check_eq ~pp:Format.pp_print_string ~eq:( = )
51 (Option.get (Sqlite.find db key))
52 value2
53
54(* Table operations *)
55
56(** Table isolation - same key in different tables must be independent. *)
57let test_table_isolation key value1 value2 =
58 let key = truncate key in
59 let value1 = truncate value1 in
60 let value2 = truncate value2 in
61 let db = Sqlite.in_memory () in
62 let t1 = Sqlite.Table.create db ~name:"table1" in
63 let t2 = Sqlite.Table.create db ~name:"table2" in
64 Sqlite.Table.put t1 key value1;
65 Sqlite.Table.put t2 key value2;
66 check_eq ~pp:Format.pp_print_string ~eq:( = )
67 (Option.get (Sqlite.Table.find t1 key))
68 value1;
69 check_eq ~pp:Format.pp_print_string ~eq:( = )
70 (Option.get (Sqlite.Table.find t2 key))
71 value2
72
73(** Table roundtrip. *)
74let test_table_roundtrip key value =
75 let key = truncate key in
76 let value = truncate value in
77 let db = Sqlite.in_memory () in
78 let t = Sqlite.Table.create db ~name:"test" in
79 Sqlite.Table.put t key value;
80 check_eq ~pp:Format.pp_print_string ~eq:( = )
81 (Option.get (Sqlite.Table.find t key))
82 value
83
84(* Crash safety *)
85
86(** Put must not crash on arbitrary binary data. *)
87let test_put_crash key value =
88 let key = truncate key in
89 let value = truncate value in
90 let db = Sqlite.in_memory () in
91 try Sqlite.put db key value with _exn -> ()
92
93(** Get must not crash on arbitrary key. *)
94let test_get_crash key =
95 let key = truncate key in
96 let db = Sqlite.in_memory () in
97 try ignore (Sqlite.find db key) with _exn -> ()
98
99(** Delete must not crash on arbitrary key. *)
100let test_delete_crash key =
101 let key = truncate key in
102 let db = Sqlite.in_memory () in
103 try Sqlite.delete db key with _exn -> ()
104
105(** Mem must not crash on arbitrary key. *)
106let test_mem_crash key =
107 let key = truncate key in
108 let db = Sqlite.in_memory () in
109 try ignore (Sqlite.mem db key) with _exn -> ()
110
111(* Boundary conditions *)
112
113(** Empty key must work. *)
114let test_empty_key value =
115 let value = truncate value in
116 let db = Sqlite.in_memory () in
117 Sqlite.put db "" value;
118 check_eq ~pp:Format.pp_print_string ~eq:( = )
119 (Option.get (Sqlite.find db ""))
120 value
121
122(** Empty value must work. *)
123let test_empty_value key =
124 let key = truncate key in
125 let db = Sqlite.in_memory () in
126 Sqlite.put db key "";
127 check_eq ~pp:Format.pp_print_string ~eq:( = )
128 (Option.get (Sqlite.find db key))
129 ""
130
131(** Both empty must work. *)
132let test_both_empty () =
133 let db = Sqlite.in_memory () in
134 Sqlite.put db "" "";
135 check_eq ~pp:Format.pp_print_string ~eq:( = )
136 (Option.get (Sqlite.find db ""))
137 ""
138
139(* Sequence operations *)
140
141(** Multiple puts to same key must always have last value. *)
142let test_multiple_puts key values =
143 let key = truncate key in
144 let values = List.map truncate values in
145 if values = [] then check true
146 else begin
147 let db = Sqlite.in_memory () in
148 List.iter (fun v -> Sqlite.put db key v) values;
149 let last = List.hd (List.rev values) in
150 check_eq ~pp:Format.pp_print_string ~eq:( = )
151 (Option.get (Sqlite.find db key))
152 last
153 end
154
155(** Put then delete then put must have second value. *)
156let test_put_delete_put key value1 value2 =
157 let key = truncate key in
158 let value1 = truncate value1 in
159 let value2 = truncate value2 in
160 let db = Sqlite.in_memory () in
161 Sqlite.put db key value1;
162 Sqlite.delete db key;
163 Sqlite.put db key value2;
164 check_eq ~pp:Format.pp_print_string ~eq:( = )
165 (Option.get (Sqlite.find db key))
166 value2
167
168(* Register all tests *)
169
170let suite =
171 ( "sqlite",
172 [
173 test_case "roundtrip" [ bytes; bytes ] test_roundtrip;
174 test_case "delete removes" [ bytes; bytes ] test_delete_removes;
175 test_case "mem consistent" [ bytes; bytes ] test_mem_consistent;
176 test_case "overwrite" [ bytes; bytes; bytes ] test_overwrite;
177 test_case "table isolation" [ bytes; bytes; bytes ] test_table_isolation;
178 test_case "table roundtrip" [ bytes; bytes ] test_table_roundtrip;
179 test_case "put crash safety" [ bytes; bytes ] test_put_crash;
180 test_case "get crash safety" [ bytes ] test_get_crash;
181 test_case "delete crash safety" [ bytes ] test_delete_crash;
182 test_case "mem crash safety" [ bytes ] test_mem_crash;
183 test_case "empty key" [ bytes ] test_empty_key;
184 test_case "empty value" [ bytes ] test_empty_value;
185 test_case "both empty" [ const () ] test_both_empty;
186 test_case "multiple puts" [ bytes; list bytes ] test_multiple_puts;
187 test_case "put delete put" [ bytes; bytes; bytes ] test_put_delete_put;
188 ] )