My own corner of monopam
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 Alcobar
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(* INSERT operations *)
169
170(** Insert roundtrip — insert then read_table returns same values. *)
171let test_insert_roundtrip text_val =
172 let text_val = truncate text_val in
173 let db = Sqlite.in_memory () in
174 Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT, b INTEGER)";
175 let rowid =
176 Sqlite.insert db ~table:"t" [ Sqlite.Vtext text_val; Sqlite.Vint 42L ]
177 in
178 let rows = Sqlite.read_table db "t" in
179 check (List.length rows = 1);
180 let rid, values = List.hd rows in
181 check (rid = rowid);
182 match values with
183 | [ Sqlite.Vtext s; Sqlite.Vint 42L ] ->
184 check_eq ~pp:Format.pp_print_string ~eq:( = ) s text_val
185 | _ -> check false
186
187(** Multiple inserts produce distinct rowids. *)
188let test_insert_distinct_rowids n =
189 let n = (abs n mod 50) + 1 in
190 let db = Sqlite.in_memory () in
191 Sqlite.create_table db ~sql:"CREATE TABLE t (x TEXT)";
192 let rowids =
193 List.init n (fun i ->
194 Sqlite.insert db ~table:"t" [ Sqlite.Vtext (string_of_int i) ])
195 in
196 let unique = List.sort_uniq Int64.compare rowids in
197 check (List.length unique = n)
198
199(** Insert with INTEGER PRIMARY KEY uses explicit rowid. *)
200let test_insert_explicit_pk n =
201 let n = Int64.of_int ((abs n mod 100_000) + 1) in
202 let db = Sqlite.in_memory () in
203 Sqlite.create_table db ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, v TEXT)";
204 let rowid =
205 Sqlite.insert db ~table:"t" [ Sqlite.Vint n; Sqlite.Vtext "val" ]
206 in
207 check (rowid = n);
208 let rows = Sqlite.read_table db "t" in
209 let rid, _ = List.hd rows in
210 check (rid = n)
211
212(** Insert must not crash on arbitrary text data. *)
213let test_insert_crash text_val =
214 let text_val = truncate text_val in
215 let db = Sqlite.in_memory () in
216 Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT)";
217 try ignore (Sqlite.insert db ~table:"t" [ Sqlite.Vtext text_val ])
218 with _exn -> ()
219
220(** Insert with blob data roundtrips correctly. *)
221let test_insert_blob_roundtrip blob =
222 let blob = truncate blob in
223 let db = Sqlite.in_memory () in
224 Sqlite.create_table db ~sql:"CREATE TABLE t (data BLOB)";
225 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vblob blob ] in
226 let rows = Sqlite.read_table db "t" in
227 let _, values = List.hd rows in
228 match values with
229 | [ Sqlite.Vblob b ] -> check_eq ~pp:Format.pp_print_string ~eq:( = ) b blob
230 | _ -> check false
231
232(* Register all tests *)
233
234let suite =
235 ( "sqlite",
236 [
237 test_case "roundtrip" [ bytes; bytes ] test_roundtrip;
238 test_case "delete removes" [ bytes; bytes ] test_delete_removes;
239 test_case "mem consistent" [ bytes; bytes ] test_mem_consistent;
240 test_case "overwrite" [ bytes; bytes; bytes ] test_overwrite;
241 test_case "table isolation" [ bytes; bytes; bytes ] test_table_isolation;
242 test_case "table roundtrip" [ bytes; bytes ] test_table_roundtrip;
243 test_case "put crash safety" [ bytes; bytes ] test_put_crash;
244 test_case "get crash safety" [ bytes ] test_get_crash;
245 test_case "delete crash safety" [ bytes ] test_delete_crash;
246 test_case "mem crash safety" [ bytes ] test_mem_crash;
247 test_case "empty key" [ bytes ] test_empty_key;
248 test_case "empty value" [ bytes ] test_empty_value;
249 test_case "both empty" [ const () ] test_both_empty;
250 test_case "multiple puts" [ bytes; list bytes ] test_multiple_puts;
251 test_case "put delete put" [ bytes; bytes; bytes ] test_put_delete_put;
252 test_case "insert roundtrip" [ bytes ] test_insert_roundtrip;
253 test_case "insert distinct rowids" [ int ] test_insert_distinct_rowids;
254 test_case "insert explicit pk" [ int ] test_insert_explicit_pk;
255 test_case "insert crash safety" [ bytes ] test_insert_crash;
256 test_case "insert blob roundtrip" [ bytes ] test_insert_blob_roundtrip;
257 ] )