Minimal SQLite key-value store for OCaml
feat(btree,sqlite): add in-memory pager for ~60x faster fuzz tests
Add Pager.mem for purely in-memory B-tree storage (no file backing)
and Sqlite.in_memory constructor. Fuzz tests now run in 0.5s vs ~30s
by eliminating per-iteration Eio_main.run and file I/O overhead.
Also syncs ocaml-claude-skills upstream changes (plugin restructure)
and adds fuzz skill with updated Crowbar API patterns.
+75
-100
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+65
-99
fuzz/fuzz_sqlite.ml
+65
-99
fuzz/fuzz_sqlite.ml
···
3
3
SPDX-License-Identifier: MIT
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** Fuzz tests for the pure OCaml B-tree backed key-value store.
7
-
8
-
These tests verify crash safety, roundtrip invariants, and boundary
9
-
conditions using Crowbar for property-based testing. *)
6
+
(** Fuzz tests for the pure OCaml B-tree backed key-value store. *)
10
7
11
8
open Crowbar
12
9
13
-
(* Helper to limit input size to avoid excessive memory usage *)
14
10
let truncate ?(max_len = 4096) s =
15
11
if String.length s > max_len then String.sub s 0 max_len else s
16
12
17
-
(* Helper to run a test with a temp database *)
18
-
let with_temp_db f =
19
-
Eio_main.run @@ fun env ->
20
-
let cwd = Eio.Stdenv.cwd env in
21
-
let tmp_dir = Eio.Path.(cwd / "_build" / "fuzz_sqlite") in
22
-
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ());
23
-
let path =
24
-
Eio.Path.(tmp_dir / Printf.sprintf "fuzz_%d.db" (Random.int 1_000_000))
25
-
in
26
-
Eio.Switch.run @@ fun sw ->
27
-
let db = Sqlite.create ~sw path in
28
-
Fun.protect
29
-
~finally:(fun () ->
30
-
Sqlite.close db;
31
-
try Eio.Path.unlink path with Eio.Io _ -> ())
32
-
(fun () -> f db)
33
-
34
-
(* ============================================================ *)
35
13
(* Core KV operations *)
36
-
(* ============================================================ *)
37
14
38
15
(** Roundtrip - put then get must return same value. *)
39
16
let test_roundtrip key value =
40
17
let key = truncate key in
41
18
let value = truncate value in
42
-
with_temp_db @@ fun db ->
19
+
let db = Sqlite.in_memory () in
43
20
Sqlite.put db key value;
44
21
let result = Sqlite.get db key in
45
22
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value
46
23
47
-
(** Delete removes key - get must return None after delete. *)
24
+
(** Delete removes key. *)
48
25
let test_delete_removes key value =
49
26
let key = truncate key in
50
27
let value = truncate value in
51
-
with_temp_db @@ fun db ->
28
+
let db = Sqlite.in_memory () in
52
29
Sqlite.put db key value;
53
30
Sqlite.delete db key;
54
-
let result = Sqlite.get db key in
55
-
check (Option.is_none result)
31
+
check (Option.is_none (Sqlite.get db key))
56
32
57
-
(** mem consistent with get - mem returns true iff get returns Some. *)
33
+
(** mem consistent with get. *)
58
34
let test_mem_consistent key value =
59
35
let key = truncate key in
60
36
let value = truncate value in
61
-
with_temp_db @@ fun db ->
37
+
let db = Sqlite.in_memory () in
62
38
Sqlite.put db key value;
63
-
let mem_result = Sqlite.mem db key in
64
-
let get_result = Sqlite.get db key in
65
-
check_eq ~pp:Format.pp_print_bool mem_result (Option.is_some get_result)
39
+
check_eq ~pp:Format.pp_print_bool (Sqlite.mem db key)
40
+
(Option.is_some (Sqlite.get db key))
66
41
67
42
(** Overwrite replaces value - last put wins. *)
68
43
let test_overwrite key value1 value2 =
69
44
let key = truncate key in
70
45
let value1 = truncate value1 in
71
46
let value2 = truncate value2 in
72
-
with_temp_db @@ fun db ->
47
+
let db = Sqlite.in_memory () in
73
48
Sqlite.put db key value1;
74
49
Sqlite.put db key value2;
75
-
let result = Sqlite.get db key in
76
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value2
50
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
51
+
(Option.get (Sqlite.get db key))
52
+
value2
77
53
78
-
(* ============================================================ *)
79
54
(* Table operations *)
80
-
(* ============================================================ *)
81
55
82
56
(** Table isolation - same key in different tables must be independent. *)
83
57
let test_table_isolation key value1 value2 =
84
58
let key = truncate key in
85
59
let value1 = truncate value1 in
86
60
let value2 = truncate value2 in
87
-
with_temp_db @@ fun db ->
61
+
let db = Sqlite.in_memory () in
88
62
let t1 = Sqlite.Table.create db ~name:"table1" in
89
63
let t2 = Sqlite.Table.create db ~name:"table2" in
90
64
Sqlite.Table.put t1 key value1;
91
65
Sqlite.Table.put t2 key value2;
92
-
let r1 = Sqlite.Table.get t1 key in
93
-
let r2 = Sqlite.Table.get t2 key in
94
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get r1) value1;
95
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get r2) value2
66
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
67
+
(Option.get (Sqlite.Table.get t1 key))
68
+
value1;
69
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
70
+
(Option.get (Sqlite.Table.get t2 key))
71
+
value2
96
72
97
-
(** Table roundtrip - table put/get must work like db put/get. *)
73
+
(** Table roundtrip. *)
98
74
let test_table_roundtrip key value =
99
75
let key = truncate key in
100
76
let value = truncate value in
101
-
with_temp_db @@ fun db ->
77
+
let db = Sqlite.in_memory () in
102
78
let t = Sqlite.Table.create db ~name:"test" in
103
79
Sqlite.Table.put t key value;
104
-
let result = Sqlite.Table.get t key in
105
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value
80
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
81
+
(Option.get (Sqlite.Table.get t key))
82
+
value
106
83
107
-
(* ============================================================ *)
108
-
(* Crash safety - operations must not crash on arbitrary input *)
109
-
(* ============================================================ *)
84
+
(* Crash safety *)
110
85
111
86
(** Put must not crash on arbitrary binary data. *)
112
-
let test_put_crash_safety key value =
87
+
let test_put_crash key value =
113
88
let key = truncate key in
114
89
let value = truncate value in
115
-
with_temp_db @@ fun db ->
116
-
(try Sqlite.put db key value with Eio.Io _ -> ());
117
-
check true
90
+
let db = Sqlite.in_memory () in
91
+
try Sqlite.put db key value with _ -> ()
118
92
119
93
(** Get must not crash on arbitrary key. *)
120
-
let test_get_crash_safety key =
94
+
let test_get_crash key =
121
95
let key = truncate key in
122
-
with_temp_db @@ fun db ->
123
-
(try ignore (Sqlite.get db key) with Eio.Io _ -> ());
124
-
check true
96
+
let db = Sqlite.in_memory () in
97
+
try ignore (Sqlite.get db key) with _ -> ()
125
98
126
99
(** Delete must not crash on arbitrary key. *)
127
-
let test_delete_crash_safety key =
100
+
let test_delete_crash key =
128
101
let key = truncate key in
129
-
with_temp_db @@ fun db ->
130
-
(try Sqlite.delete db key with Eio.Io _ -> ());
131
-
check true
102
+
let db = Sqlite.in_memory () in
103
+
try Sqlite.delete db key with _ -> ()
132
104
133
105
(** Mem must not crash on arbitrary key. *)
134
-
let test_mem_crash_safety key =
106
+
let test_mem_crash key =
135
107
let key = truncate key in
136
-
with_temp_db @@ fun db ->
137
-
(try ignore (Sqlite.mem db key) with Eio.Io _ -> ());
138
-
check true
108
+
let db = Sqlite.in_memory () in
109
+
try ignore (Sqlite.mem db key) with _ -> ()
139
110
140
-
(* ============================================================ *)
141
111
(* Boundary conditions *)
142
-
(* ============================================================ *)
143
112
144
113
(** Empty key must work. *)
145
114
let test_empty_key value =
146
115
let value = truncate value in
147
-
with_temp_db @@ fun db ->
116
+
let db = Sqlite.in_memory () in
148
117
Sqlite.put db "" value;
149
-
let result = Sqlite.get db "" in
150
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value
118
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
119
+
(Option.get (Sqlite.get db ""))
120
+
value
151
121
152
122
(** Empty value must work. *)
153
123
let test_empty_value key =
154
124
let key = truncate key in
155
-
with_temp_db @@ fun db ->
125
+
let db = Sqlite.in_memory () in
156
126
Sqlite.put db key "";
157
-
let result = Sqlite.get db key in
158
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) ""
127
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
128
+
(Option.get (Sqlite.get db key))
129
+
""
159
130
160
131
(** Both empty must work. *)
161
132
let test_both_empty () =
162
-
with_temp_db @@ fun db ->
133
+
let db = Sqlite.in_memory () in
163
134
Sqlite.put db "" "";
164
-
let result = Sqlite.get db "" in
165
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) ""
135
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
136
+
(Option.get (Sqlite.get db ""))
137
+
""
166
138
167
-
(* ============================================================ *)
168
-
(* Sequence of operations *)
169
-
(* ============================================================ *)
139
+
(* Sequence operations *)
170
140
171
141
(** Multiple puts to same key must always have last value. *)
172
142
let test_multiple_puts key values =
173
143
let key = truncate key in
174
144
let values = List.map truncate values in
175
145
if values = [] then check true
176
-
else
177
-
with_temp_db @@ fun db ->
146
+
else begin
147
+
let db = Sqlite.in_memory () in
178
148
List.iter (fun v -> Sqlite.put db key v) values;
179
-
let result = Sqlite.get db key in
180
149
let last = List.hd (List.rev values) in
181
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) last
150
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
151
+
(Option.get (Sqlite.get db key))
152
+
last
153
+
end
182
154
183
155
(** Put then delete then put must have second value. *)
184
156
let test_put_delete_put key value1 value2 =
185
157
let key = truncate key in
186
158
let value1 = truncate value1 in
187
159
let value2 = truncate value2 in
188
-
with_temp_db @@ fun db ->
160
+
let db = Sqlite.in_memory () in
189
161
Sqlite.put db key value1;
190
162
Sqlite.delete db key;
191
163
Sqlite.put db key value2;
192
-
let result = Sqlite.get db key in
193
-
check_eq ~pp:Format.pp_print_string ~eq:( = ) (Option.get result) value2
164
+
check_eq ~pp:Format.pp_print_string ~eq:( = )
165
+
(Option.get (Sqlite.get db key))
166
+
value2
194
167
195
-
(* ============================================================ *)
196
168
(* Register all tests *)
197
-
(* ============================================================ *)
198
169
199
170
let suite =
200
171
( "sqlite",
201
172
[
202
-
(* Core KV operations *)
203
173
test_case "roundtrip" [ bytes; bytes ] test_roundtrip;
204
174
test_case "delete removes" [ bytes; bytes ] test_delete_removes;
205
175
test_case "mem consistent" [ bytes; bytes ] test_mem_consistent;
206
176
test_case "overwrite" [ bytes; bytes; bytes ] test_overwrite;
207
-
(* Table operations *)
208
177
test_case "table isolation" [ bytes; bytes; bytes ] test_table_isolation;
209
178
test_case "table roundtrip" [ bytes; bytes ] test_table_roundtrip;
210
-
(* Crash safety *)
211
-
test_case "put crash safety" [ bytes; bytes ] test_put_crash_safety;
212
-
test_case "get crash safety" [ bytes ] test_get_crash_safety;
213
-
test_case "delete crash safety" [ bytes ] test_delete_crash_safety;
214
-
test_case "mem crash safety" [ bytes ] test_mem_crash_safety;
215
-
(* Boundary conditions *)
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;
216
183
test_case "empty key" [ bytes ] test_empty_key;
217
184
test_case "empty value" [ bytes ] test_empty_value;
218
185
test_case "both empty" [ const () ] test_both_empty;
219
-
(* Sequence operations *)
220
186
test_case "multiple puts" [ bytes; list bytes ] test_multiple_puts;
221
187
test_case "put delete put" [ bytes; bytes; bytes ] test_put_delete_put;
222
188
] )
+5
lib/sqlite.ml
+5
lib/sqlite.ml
···
80
80
let index = Btree.Index.v pager in
81
81
{ pager; index; tables = Hashtbl.create 8 }
82
82
83
+
let in_memory () =
84
+
let pager = Btree.Pager.mem ~page_size () in
85
+
let index = Btree.Index.v pager in
86
+
{ pager; index; tables = Hashtbl.create 8 }
87
+
83
88
let open_ ~sw path =
84
89
(* Open existing database file *)
85
90
let file =
+4
lib/sqlite.mli
+4
lib/sqlite.mli
···
16
16
at [path], it will be truncated. The switch [sw] controls the lifetime of
17
17
the underlying file handle. *)
18
18
19
+
val in_memory : unit -> t
20
+
(** [in_memory ()] creates a purely in-memory database. No file I/O is
21
+
performed. Useful for testing. *)
22
+
19
23
val open_ : sw:Eio.Switch.t -> Eio.Fs.dir_ty Eio.Path.t -> t
20
24
(** [open_ ~sw path] opens an existing database at [path]. The switch [sw]
21
25
controls the lifetime of the underlying file handle.