My own corner of monopam
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6let temp_db prefix =
7 let path = Filename.temp_file ("sqlite_" ^ prefix ^ "_") ".db" in
8 Sys.remove path;
9 path
10
11let with_temp_db f =
12 Eio_main.run @@ fun env ->
13 let fs = Eio.Stdenv.fs env in
14 let path = Eio.Path.(fs / temp_db "test") in
15 Eio.Switch.run @@ fun sw ->
16 let db = Sqlite.open_ ~sw ~create:true path in
17 Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f fs db)
18
19(* Basic operations *)
20
21let test_put_get () =
22 with_temp_db @@ fun _fs db ->
23 Sqlite.put db "key1" "value1";
24 let result = Sqlite.find db "key1" in
25 Alcotest.(check (option string))
26 "get returns put value" (Some "value1") result
27
28let test_get_missing () =
29 with_temp_db @@ fun _fs db ->
30 let result = Sqlite.find db "nonexistent" in
31 Alcotest.(check (option string)) "missing key returns None" None result
32
33let test_put_overwrite () =
34 with_temp_db @@ fun _fs db ->
35 Sqlite.put db "key1" "value1";
36 Sqlite.put db "key1" "value2";
37 let result = Sqlite.find db "key1" in
38 Alcotest.(check (option string)) "overwrite works" (Some "value2") result
39
40let test_delete () =
41 with_temp_db @@ fun _fs db ->
42 Sqlite.put db "key1" "value1";
43 Sqlite.delete db "key1";
44 let result = Sqlite.find db "key1" in
45 Alcotest.(check (option string)) "delete removes key" None result
46
47let test_delete_missing () =
48 with_temp_db @@ fun _fs db ->
49 (* Should not raise *)
50 Sqlite.delete db "nonexistent";
51 Alcotest.(check bool) "delete missing key is no-op" true true
52
53let test_mem () =
54 with_temp_db @@ fun _fs db ->
55 Sqlite.put db "key1" "value1";
56 Alcotest.(check bool) "mem finds existing key" true (Sqlite.mem db "key1");
57 Alcotest.(check bool)
58 "mem returns false for missing" false (Sqlite.mem db "missing")
59
60let test_iter () =
61 with_temp_db @@ fun _fs db ->
62 Sqlite.put db "a" "1";
63 Sqlite.put db "b" "2";
64 Sqlite.put db "c" "3";
65 let items = ref [] in
66 Sqlite.iter db ~f:(fun k v -> items := (k, v) :: !items);
67 let sorted = List.sort compare !items in
68 Alcotest.(check (list (pair string string)))
69 "iter visits all entries"
70 [ ("a", "1"); ("b", "2"); ("c", "3") ]
71 sorted
72
73let test_fold () =
74 with_temp_db @@ fun _fs db ->
75 Sqlite.put db "a" "1";
76 Sqlite.put db "b" "2";
77 let count = Sqlite.fold db ~init:0 ~f:(fun _ _ acc -> acc + 1) in
78 Alcotest.(check int) "fold counts entries" 2 count
79
80(* Binary data *)
81
82let test_binary_values () =
83 with_temp_db @@ fun _fs db ->
84 let binary = "\x00\x01\x02\xff\xfe\xfd" in
85 Sqlite.put db "binary" binary;
86 let result = Sqlite.find db "binary" in
87 Alcotest.(check (option string)) "binary data preserved" (Some binary) result
88
89let test_empty_value () =
90 with_temp_db @@ fun _fs db ->
91 Sqlite.put db "empty" "";
92 let result = Sqlite.find db "empty" in
93 Alcotest.(check (option string)) "empty value works" (Some "") result
94
95let test_large_value () =
96 with_temp_db @@ fun _fs db ->
97 (* Note: B-tree has page splitting constraints limiting max entry size *)
98 let large = String.make 1000 'x' in
99 Sqlite.put db "large" large;
100 let result = Sqlite.find db "large" in
101 Alcotest.(check (option string)) "large value works" (Some large) result
102
103(* Namespaced tables *)
104
105let test_table_basic () =
106 with_temp_db @@ fun _fs db ->
107 let table = Sqlite.Table.create db ~name:"blocks" in
108 Sqlite.Table.put table "cid1" "data1";
109 let result = Sqlite.Table.find table "cid1" in
110 Alcotest.(check (option string)) "table get/put works" (Some "data1") result
111
112let test_table_isolation () =
113 with_temp_db @@ fun _fs db ->
114 let t1 = Sqlite.Table.create db ~name:"table1" in
115 let t2 = Sqlite.Table.create db ~name:"table2" in
116 Sqlite.Table.put t1 "key" "value1";
117 Sqlite.Table.put t2 "key" "value2";
118 (* Also put in default table *)
119 Sqlite.put db "key" "default";
120 Alcotest.(check (option string))
121 "t1 isolated" (Some "value1")
122 (Sqlite.Table.find t1 "key");
123 Alcotest.(check (option string))
124 "t2 isolated" (Some "value2")
125 (Sqlite.Table.find t2 "key");
126 Alcotest.(check (option string))
127 "default isolated" (Some "default") (Sqlite.find db "key")
128
129let test_table_mem_delete () =
130 with_temp_db @@ fun _fs db ->
131 let table = Sqlite.Table.create db ~name:"test" in
132 Sqlite.Table.put table "key1" "value1";
133 Alcotest.(check bool) "mem works" true (Sqlite.Table.mem table "key1");
134 Sqlite.Table.delete table "key1";
135 Alcotest.(check bool) "delete works" false (Sqlite.Table.mem table "key1")
136
137let test_table_iter () =
138 with_temp_db @@ fun _fs db ->
139 let table = Sqlite.Table.create db ~name:"iter_test" in
140 Sqlite.Table.put table "a" "1";
141 Sqlite.Table.put table "b" "2";
142 let items = ref [] in
143 Sqlite.Table.iter table ~f:(fun k v -> items := (k, v) :: !items);
144 let sorted = List.sort compare !items in
145 Alcotest.(check (list (pair string string)))
146 "table iter works"
147 [ ("a", "1"); ("b", "2") ]
148 sorted
149
150(* Security tests - SQL injection resistance *)
151
152let test_sql_injection_key () =
153 with_temp_db @@ fun _fs db ->
154 (* These malicious keys should be treated as literal strings *)
155 let malicious_keys =
156 [
157 "'; DROP TABLE kv; --";
158 "key' OR '1'='1";
159 "key\"; DELETE FROM kv; --";
160 "key\x00injection";
161 "Robert'); DROP TABLE Students;--";
162 ]
163 in
164 List.iter
165 (fun key ->
166 Sqlite.put db key "value";
167 let result = Sqlite.find db key in
168 Alcotest.(check (option string))
169 (Fmt.str "injection key %S safe" key)
170 (Some "value") result)
171 malicious_keys
172
173let test_sql_injection_value () =
174 with_temp_db @@ fun _fs db ->
175 let malicious_values =
176 [ "'; DROP TABLE kv; --"; "value' OR '1'='1"; "\x00\x00\x00" ]
177 in
178 List.iter
179 (fun value ->
180 Sqlite.put db "key" value;
181 let result = Sqlite.find db "key" in
182 Alcotest.(check (option string))
183 (Fmt.str "injection value safe")
184 (Some value) result)
185 malicious_values
186
187let test_table_name_validation () =
188 with_temp_db @@ fun _fs db ->
189 let invalid_names =
190 [
191 "";
192 "table; DROP TABLE kv;";
193 "table'";
194 "table\"";
195 "table\x00";
196 "table name";
197 "123start";
198 ]
199 in
200 List.iter
201 (fun name ->
202 try
203 let _ = Sqlite.Table.create db ~name in
204 Alcotest.failf "should reject invalid name: %S" name
205 with Invalid_argument _ -> ())
206 invalid_names
207
208let test_valid_table_names () =
209 with_temp_db @@ fun _fs db ->
210 let valid_names =
211 [ "blocks"; "refs"; "meta"; "Table1"; "my_table"; "a"; "A123_test" ]
212 in
213 List.iter
214 (fun name ->
215 let table = Sqlite.Table.create db ~name in
216 Sqlite.Table.put table "key" "value";
217 let result = Sqlite.Table.find table "key" in
218 Alcotest.(check (option string))
219 (Fmt.str "valid table %S works" name)
220 (Some "value") result)
221 valid_names
222
223(* Unicode and special characters *)
224
225let test_unicode_keys () =
226 with_temp_db @@ fun _fs db ->
227 let unicode_keys = [ "café"; "日本語"; "emoji🎉"; "Ω≈ç√∫" ] in
228 List.iter
229 (fun key ->
230 Sqlite.put db key "value";
231 let result = Sqlite.find db key in
232 Alcotest.(check (option string))
233 (Fmt.str "unicode key %S" key)
234 (Some "value") result)
235 unicode_keys
236
237let test_unicode_values () =
238 with_temp_db @@ fun _fs db ->
239 let unicode = "日本語テスト🎉" in
240 Sqlite.put db "key" unicode;
241 let result = Sqlite.find db "key" in
242 Alcotest.(check (option string)) "unicode value" (Some unicode) result
243
244(* Sync *)
245
246let test_sync () =
247 with_temp_db @@ fun _fs db ->
248 Sqlite.put db "key" "value";
249 (* sync should not raise *)
250 Sqlite.sync db;
251 let result = Sqlite.find db "key" in
252 Alcotest.(check (option string))
253 "data persists after sync" (Some "value") result
254
255(* Persistence - critical for correctness *)
256
257let test_persistence_basic () =
258 Eio_main.run @@ fun env ->
259 let fs = Eio.Stdenv.fs env in
260 let path = Eio.Path.(fs / temp_db "persist") in
261 (* Create and write *)
262 Eio.Switch.run (fun sw ->
263 let db = Sqlite.open_ ~sw ~create:true path in
264 Sqlite.put db "key1" "value1";
265 Sqlite.put db "key2" "value2";
266 Sqlite.close db);
267 (* Reopen and read *)
268 Eio.Switch.run (fun sw ->
269 let db = Sqlite.open_ ~sw path in
270 let r1 = Sqlite.find db "key1" in
271 let r2 = Sqlite.find db "key2" in
272 Alcotest.(check (option string)) "key1 persisted" (Some "value1") r1;
273 Alcotest.(check (option string)) "key2 persisted" (Some "value2") r2;
274 Sqlite.close db)
275
276let test_persistence_with_delete () =
277 Eio_main.run @@ fun env ->
278 let fs = Eio.Stdenv.fs env in
279 let path = Eio.Path.(fs / temp_db "persist_del") in
280 (* Create, write, delete *)
281 Eio.Switch.run (fun sw ->
282 let db = Sqlite.open_ ~sw ~create:true path in
283 Sqlite.put db "keep" "value1";
284 Sqlite.put db "delete" "value2";
285 Sqlite.delete db "delete";
286 Sqlite.close db);
287 (* Reopen and verify *)
288 Eio.Switch.run (fun sw ->
289 let db = Sqlite.open_ ~sw path in
290 let r1 = Sqlite.find db "keep" in
291 let r2 = Sqlite.find db "delete" in
292 Alcotest.(check (option string)) "kept key persisted" (Some "value1") r1;
293 Alcotest.(check (option string)) "deleted key gone" None r2;
294 Sqlite.close db)
295
296let test_persistence_tables () =
297 Eio_main.run @@ fun env ->
298 let fs = Eio.Stdenv.fs env in
299 let path = Eio.Path.(fs / temp_db "persist_tbl") in
300 (* Create with tables *)
301 Eio.Switch.run (fun sw ->
302 let db = Sqlite.open_ ~sw ~create:true path in
303 let t1 = Sqlite.Table.create db ~name:"blocks" in
304 let t2 = Sqlite.Table.create db ~name:"refs" in
305 Sqlite.Table.put t1 "cid1" "data1";
306 Sqlite.Table.put t2 "head" "cid123";
307 Sqlite.close db);
308 (* Reopen and verify tables *)
309 Eio.Switch.run (fun sw ->
310 let db = Sqlite.open_ ~sw path in
311 let t1 = Sqlite.Table.create db ~name:"blocks" in
312 let t2 = Sqlite.Table.create db ~name:"refs" in
313 let r1 = Sqlite.Table.find t1 "cid1" in
314 let r2 = Sqlite.Table.find t2 "head" in
315 Alcotest.(check (option string)) "table1 data persisted" (Some "data1") r1;
316 Alcotest.(check (option string))
317 "table2 data persisted" (Some "cid123") r2;
318 Sqlite.close db)
319
320(* Edge cases *)
321
322let test_empty_key () =
323 with_temp_db @@ fun _fs db ->
324 Sqlite.put db "" "value_for_empty_key";
325 let result = Sqlite.find db "" in
326 Alcotest.(check (option string))
327 "empty key works" (Some "value_for_empty_key") result
328
329let test_key_with_nulls () =
330 with_temp_db @@ fun _fs db ->
331 let key = "key\x00with\x00nulls" in
332 let value = "value\x00also\x00has\x00nulls" in
333 Sqlite.put db key value;
334 let result = Sqlite.find db key in
335 Alcotest.(check (option string)) "null bytes preserved" (Some value) result
336
337let test_long_key () =
338 with_temp_db @@ fun _fs db ->
339 (* Note: B-tree has page splitting constraints limiting max entry size *)
340 let key = String.make 500 'k' in
341 let value = "value" in
342 Sqlite.put db key value;
343 let result = Sqlite.find db key in
344 Alcotest.(check (option string)) "long key works" (Some value) result
345
346let test_all_byte_values () =
347 with_temp_db @@ fun _fs db ->
348 (* Test all possible byte values in keys and values *)
349 let all_bytes = String.init 256 Char.chr in
350 Sqlite.put db all_bytes all_bytes;
351 let result = Sqlite.find db all_bytes in
352 Alcotest.(check (option string))
353 "all byte values preserved" (Some all_bytes) result
354
355let test_max_int_key_length () =
356 with_temp_db @@ fun _fs db ->
357 (* Test key length near encoding boundaries *)
358 let lengths = [ 127; 128; 255; 256; 400 ] in
359 List.iter
360 (fun len ->
361 let key = String.make len 'x' in
362 let value = Fmt.str "value_%d" len in
363 Sqlite.put db key value;
364 let result = Sqlite.find db key in
365 Alcotest.(check (option string))
366 (Fmt.str "key length %d" len)
367 (Some value) result)
368 lengths
369
370(* Stress tests *)
371
372let test_many_keys () =
373 with_temp_db @@ fun _fs db ->
374 let n = 1000 in
375 (* Insert many keys *)
376 for i = 0 to n - 1 do
377 Sqlite.put db (Fmt.str "key_%05d" i) (Fmt.str "value_%d" i)
378 done;
379 (* Verify all present *)
380 for i = 0 to n - 1 do
381 let result = Sqlite.find db (Fmt.str "key_%05d" i) in
382 Alcotest.(check (option string))
383 (Fmt.str "key %d present" i)
384 (Some (Fmt.str "value_%d" i))
385 result
386 done
387
388let test_many_updates () =
389 with_temp_db @@ fun _fs db ->
390 let n = 100 in
391 (* Update same key many times *)
392 for i = 0 to n - 1 do
393 Sqlite.put db "key" (Fmt.str "value_%d" i)
394 done;
395 let result = Sqlite.find db "key" in
396 Alcotest.(check (option string))
397 "final value"
398 (Some (Fmt.str "value_%d" (n - 1)))
399 result
400
401let test_interleaved_operations () =
402 with_temp_db @@ fun _fs db ->
403 (* Mix of puts, gets, deletes *)
404 for i = 0 to 99 do
405 Sqlite.put db (Fmt.str "a_%d" i) "value";
406 Sqlite.put db (Fmt.str "b_%d" i) "value";
407 if i mod 2 = 0 then Sqlite.delete db (Fmt.str "a_%d" i)
408 done;
409 (* Verify state *)
410 let a_count = ref 0 in
411 let b_count = ref 0 in
412 Sqlite.iter db ~f:(fun k _ ->
413 if String.length k > 2 && k.[0] = 'a' then incr a_count
414 else if String.length k > 2 && k.[0] = 'b' then incr b_count);
415 Alcotest.(check int) "a keys (half deleted)" 50 !a_count;
416 Alcotest.(check int) "b keys (all present)" 100 !b_count
417
418(* Multiple tables stress *)
419
420let test_many_tables () =
421 with_temp_db @@ fun _fs db ->
422 let n = 20 in
423 (* Create many tables *)
424 let tables =
425 Array.init n (fun i -> Sqlite.Table.create db ~name:(Fmt.str "table%d" i))
426 in
427 (* Write to all tables *)
428 Array.iteri
429 (fun i t -> Sqlite.Table.put t "key" (Fmt.str "value_%d" i))
430 tables;
431 (* Verify isolation *)
432 Array.iteri
433 (fun i t ->
434 let result = Sqlite.Table.find t "key" in
435 Alcotest.(check (option string))
436 (Fmt.str "table %d" i)
437 (Some (Fmt.str "value_%d" i))
438 result)
439 tables
440
441(* Regression tests based on SQLite CVE patterns *)
442
443let test_cve_key_overflow () =
444 with_temp_db @@ fun _fs db ->
445 (* Ensure large key doesn't cause integer overflow in length encoding *)
446 let key = String.make 500 'x' in
447 Sqlite.put db key "value";
448 let result = Sqlite.find db key in
449 Alcotest.(check (option string)) "large key no overflow" (Some "value") result
450
451let test_cve_like_boundary_conditions () =
452 with_temp_db @@ fun _fs db ->
453 (* Test boundary conditions within B-tree page constraints *)
454 let sizes = [ 100; 200; 300; 400; 500 ] in
455 List.iter
456 (fun size ->
457 let key = Fmt.str "key_%d" size in
458 let value = String.make size 'v' in
459 Sqlite.put db key value;
460 let result = Sqlite.find db key in
461 Alcotest.(check (option string))
462 (Fmt.str "boundary size %d" size)
463 (Some value) result)
464 sizes
465
466(* CREATE TABLE parser tests *)
467
468let check_columns msg expected actual =
469 let pp_col ppf (c : Sqlite.column) =
470 Fmt.pf ppf "{name=%S; affinity=%S; rowid=%b}" c.col_name c.col_affinity
471 c.col_is_rowid_alias
472 in
473 let col_eq (a : Sqlite.column) (b : Sqlite.column) =
474 a.col_name = b.col_name
475 && a.col_affinity = b.col_affinity
476 && a.col_is_rowid_alias = b.col_is_rowid_alias
477 in
478 let col_testable = Alcotest.testable pp_col col_eq in
479 Alcotest.(check (list col_testable)) msg expected actual
480
481let test_parse_simple () =
482 let cols =
483 Sqlite.parse_create_table "CREATE TABLE kv (key TEXT, value BLOB)"
484 in
485 check_columns "simple kv schema"
486 [
487 { col_name = "key"; col_affinity = "TEXT"; col_is_rowid_alias = false };
488 { col_name = "value"; col_affinity = "BLOB"; col_is_rowid_alias = false };
489 ]
490 cols
491
492let test_parse_integer_primary_key () =
493 let cols =
494 Sqlite.parse_create_table
495 "CREATE TABLE users (id INTEGER PRIMARY KEY, name TEXT, age INTEGER)"
496 in
497 check_columns "integer primary key"
498 [
499 { col_name = "id"; col_affinity = "INTEGER"; col_is_rowid_alias = true };
500 { col_name = "name"; col_affinity = "TEXT"; col_is_rowid_alias = false };
501 { col_name = "age"; col_affinity = "INTEGER"; col_is_rowid_alias = false };
502 ]
503 cols
504
505let test_parse_if_not_exists () =
506 let cols =
507 Sqlite.parse_create_table
508 "CREATE TABLE IF NOT EXISTS foo (bar TEXT, baz REAL)"
509 in
510 check_columns "if not exists"
511 [
512 { col_name = "bar"; col_affinity = "TEXT"; col_is_rowid_alias = false };
513 { col_name = "baz"; col_affinity = "REAL"; col_is_rowid_alias = false };
514 ]
515 cols
516
517let test_parse_nested_parens () =
518 let cols =
519 Sqlite.parse_create_table
520 "CREATE TABLE t (a DECIMAL(10,2), b VARCHAR(255) NOT NULL)"
521 in
522 check_columns "nested parens in types"
523 [
524 {
525 col_name = "a";
526 col_affinity = "DECIMAL(10,2)";
527 col_is_rowid_alias = false;
528 };
529 {
530 col_name = "b";
531 col_affinity = "VARCHAR(255)";
532 col_is_rowid_alias = false;
533 };
534 ]
535 cols
536
537let test_parse_table_constraints () =
538 let cols =
539 Sqlite.parse_create_table
540 "CREATE TABLE t (a INTEGER, b TEXT, PRIMARY KEY(a), UNIQUE(b))"
541 in
542 check_columns "table-level constraints skipped"
543 [
544 { col_name = "a"; col_affinity = "INTEGER"; col_is_rowid_alias = false };
545 { col_name = "b"; col_affinity = "TEXT"; col_is_rowid_alias = false };
546 ]
547 cols
548
549let test_parse_no_type () =
550 let cols = Sqlite.parse_create_table "CREATE TABLE t (a, b, c)" in
551 check_columns "columns without types"
552 [
553 { col_name = "a"; col_affinity = ""; col_is_rowid_alias = false };
554 { col_name = "b"; col_affinity = ""; col_is_rowid_alias = false };
555 { col_name = "c"; col_affinity = ""; col_is_rowid_alias = false };
556 ]
557 cols
558
559let test_parse_autoincrement () =
560 let cols =
561 Sqlite.parse_create_table
562 "CREATE TABLE t (id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT)"
563 in
564 check_columns "autoincrement"
565 [
566 { col_name = "id"; col_affinity = "INTEGER"; col_is_rowid_alias = true };
567 { col_name = "name"; col_affinity = "TEXT"; col_is_rowid_alias = false };
568 ]
569 cols
570
571let test_parse_invalid () =
572 let cols = Sqlite.parse_create_table "not valid sql at all" in
573 Alcotest.(check int) "invalid sql returns empty" 0 (List.length cols)
574
575(* Generic table read tests *)
576
577let with_temp_path f =
578 Eio_main.run @@ fun env ->
579 let fs = Eio.Stdenv.fs env in
580 let fpath = temp_db "generic" in
581 let path = Eio.Path.(fs / fpath) in
582 Fun.protect
583 ~finally:(fun () -> try Sys.remove fpath with Sys_error _ -> ())
584 (fun () -> f env fpath path)
585
586let test_open_no_kv () =
587 with_temp_path @@ fun _env fpath path ->
588 let rc =
589 Sys.command
590 (Fmt.str
591 "sqlite3 '%s' \"CREATE TABLE users (id INTEGER PRIMARY KEY, name \
592 TEXT, age INTEGER)\""
593 fpath)
594 in
595 if rc <> 0 then Alcotest.skip ();
596 Eio.Switch.run @@ fun sw ->
597 let t = Sqlite.open_ ~sw path in
598 let schemas = Sqlite.tables t in
599 Alcotest.(check int) "one table" 1 (List.length schemas);
600 let s = List.hd schemas in
601 Alcotest.(check string) "table name" "users" s.Sqlite.tbl_name;
602 Alcotest.(check int) "3 columns" 3 (List.length s.Sqlite.columns);
603 (* KV API should fail *)
604 (try
605 Sqlite.iter t ~f:(fun _ _ -> ());
606 Alcotest.fail "should have raised"
607 with Failure _ -> ());
608 Sqlite.close t
609
610let test_read_generic_table () =
611 with_temp_path @@ fun _env fpath path ->
612 let rc =
613 Sys.command
614 (Fmt.str
615 "sqlite3 '%s' \"CREATE TABLE users (id INTEGER PRIMARY KEY, name \
616 TEXT, age INTEGER); INSERT INTO users VALUES (1, 'Alice', 30); \
617 INSERT INTO users VALUES (2, 'Bob', 25);\""
618 fpath)
619 in
620 if rc <> 0 then Alcotest.skip ();
621 Eio.Switch.run @@ fun sw ->
622 let t = Sqlite.open_ ~sw path in
623 let rows = Sqlite.read_table t "users" in
624 Alcotest.(check int) "2 rows" 2 (List.length rows);
625 let _rowid1, values1 = List.nth rows 0 in
626 (match values1 with
627 | [ Sqlite.Vint 1L; Sqlite.Vtext "Alice"; Sqlite.Vint 30L ] -> ()
628 | _ ->
629 Alcotest.failf "unexpected row 1: %a" Fmt.(list Sqlite.pp_value) values1);
630 let _rowid2, values2 = List.nth rows 1 in
631 (match values2 with
632 | [ Sqlite.Vint 2L; Sqlite.Vtext "Bob"; Sqlite.Vint 25L ] -> ()
633 | _ ->
634 Alcotest.failf "unexpected row 2: %a" Fmt.(list Sqlite.pp_value) values2);
635 Sqlite.close t
636
637let test_integer_primary_key () =
638 with_temp_path @@ fun _env fpath path ->
639 let rc =
640 Sys.command
641 (Fmt.str
642 "sqlite3 '%s' \"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT); \
643 INSERT INTO t VALUES (42, 'hello');\""
644 fpath)
645 in
646 if rc <> 0 then Alcotest.skip ();
647 Eio.Switch.run @@ fun sw ->
648 let t = Sqlite.open_ ~sw path in
649 let rows = Sqlite.read_table t "t" in
650 Alcotest.(check int) "1 row" 1 (List.length rows);
651 let rowid, values = List.hd rows in
652 Alcotest.(check int64) "rowid is 42" 42L rowid;
653 (match values with
654 | [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ] -> ()
655 | _ ->
656 Alcotest.failf "expected [Vint 42; Vtext hello], got: %a"
657 Fmt.(list Sqlite.pp_value)
658 values);
659 Sqlite.close t
660
661let test_tables_lists_all () =
662 with_temp_path @@ fun _env fpath path ->
663 let rc =
664 Sys.command
665 (Fmt.str
666 "sqlite3 '%s' \"CREATE TABLE t1 (a TEXT); CREATE TABLE t2 (b INTEGER, \
667 c REAL);\""
668 fpath)
669 in
670 if rc <> 0 then Alcotest.skip ();
671 Eio.Switch.run @@ fun sw ->
672 let t = Sqlite.open_ ~sw path in
673 let schemas = Sqlite.tables t in
674 let names =
675 List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas
676 |> List.sort String.compare
677 in
678 Alcotest.(check (list string)) "table names" [ "t1"; "t2" ] names;
679 Sqlite.close t
680
681let sum_int_values _rowid values acc =
682 match values with [ Sqlite.Vint n ] -> Int64.add acc n | _ -> acc
683
684let test_fold_table () =
685 with_temp_path @@ fun _env fpath path ->
686 let rc =
687 Sys.command
688 (Fmt.str
689 "sqlite3 '%s' \"CREATE TABLE nums (n INTEGER); INSERT INTO nums \
690 VALUES (10); INSERT INTO nums VALUES (20); INSERT INTO nums VALUES \
691 (30);\""
692 fpath)
693 in
694 if rc <> 0 then Alcotest.skip ();
695 Eio.Switch.run @@ fun sw ->
696 let t = Sqlite.open_ ~sw path in
697 let sum = Sqlite.fold_table t "nums" ~init:0L ~f:sum_int_values in
698 Alcotest.(check int64) "sum of values" 60L sum;
699 Sqlite.close t
700
701(* ---- SQLite file format spec test vectors ---- *)
702
703let with_temp_db_path f =
704 Eio_main.run @@ fun env ->
705 let fs = Eio.Stdenv.fs env in
706 let path = Eio.Path.(fs / temp_db "spec") in
707 Eio.Switch.run @@ fun sw ->
708 let db = Sqlite.open_ ~sw ~create:true path in
709 Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> f path db)
710
711(* Section 1.2: Database header byte-level verification *)
712let test_db_header_magic () =
713 with_temp_db_path @@ fun path db ->
714 Sqlite.sync db;
715 let data = Eio.Path.load path in
716 let magic = String.sub data 0 16 in
717 Alcotest.(check string) "magic" "SQLite format 3\000" magic
718
719let test_db_header_fixed_values () =
720 with_temp_db_path @@ fun path db ->
721 Sqlite.sync db;
722 let data = Eio.Path.load path in
723 (* Offset 16-17: page size (4096 = 0x10 0x00) *)
724 Alcotest.(check int) "page size hi" 0x10 (Char.code data.[16]);
725 Alcotest.(check int) "page size lo" 0x00 (Char.code data.[17]);
726 (* Offset 18: write version = 1 (legacy) *)
727 Alcotest.(check int) "write version" 1 (Char.code data.[18]);
728 (* Offset 19: read version = 1 (legacy) *)
729 Alcotest.(check int) "read version" 1 (Char.code data.[19]);
730 (* Offset 20: reserved bytes = 0 *)
731 Alcotest.(check int) "reserved" 0 (Char.code data.[20]);
732 (* Offset 21: max_embedded_payload_fraction = 64 (MUST be 64) *)
733 Alcotest.(check int) "max payload fraction" 64 (Char.code data.[21]);
734 (* Offset 22: min_embedded_payload_fraction = 32 (MUST be 32) *)
735 Alcotest.(check int) "min payload fraction" 32 (Char.code data.[22]);
736 (* Offset 23: leaf_payload_fraction = 32 (MUST be 32) *)
737 Alcotest.(check int) "leaf payload fraction" 32 (Char.code data.[23]);
738 (* Offset 44: schema format = 4 *)
739 let schema_format =
740 (Char.code data.[44] lsl 24)
741 lor (Char.code data.[45] lsl 16)
742 lor (Char.code data.[46] lsl 8)
743 lor Char.code data.[47]
744 in
745 Alcotest.(check int) "schema format" 4 schema_format;
746 (* Offset 56: text encoding = 1 (UTF-8) *)
747 let encoding =
748 (Char.code data.[56] lsl 24)
749 lor (Char.code data.[57] lsl 16)
750 lor (Char.code data.[58] lsl 8)
751 lor Char.code data.[59]
752 in
753 Alcotest.(check int) "text encoding UTF-8" 1 encoding;
754 (* Offset 72-91: reserved for expansion = all zeros *)
755 for i = 72 to 91 do
756 Alcotest.(check int) (Fmt.str "reserved byte %d" i) 0 (Char.code data.[i])
757 done
758
759let test_db_header_change_counter () =
760 with_temp_db_path @@ fun path db ->
761 Sqlite.put db "key" "value";
762 Sqlite.sync db;
763 let data = Eio.Path.load path in
764 let read_u32 off =
765 (Char.code data.[off] lsl 24)
766 lor (Char.code data.[off + 1] lsl 16)
767 lor (Char.code data.[off + 2] lsl 8)
768 lor Char.code data.[off + 3]
769 in
770 let change_counter = read_u32 24 in
771 let version_valid_for = read_u32 92 in
772 Alcotest.(check int)
773 "change_counter == version_valid_for" change_counter version_valid_for
774
775(* Section 1.5: Page 1 B-tree header at offset 100 *)
776let test_page1_btree_header () =
777 with_temp_db_path @@ fun path db ->
778 Sqlite.sync db;
779 let data = Eio.Path.load path in
780 (* Offset 100: page type = 0x0d (leaf table) *)
781 Alcotest.(check int) "page1 type" 0x0d (Char.code data.[100]);
782 (* Offset 107: fragmented bytes <= 60 *)
783 Alcotest.(check bool) "fragmented <= 60" true (Char.code data.[107] <= 60)
784
785(* Section 2.1: sqlite_schema table format —
786 columns: type, name, tbl_name, rootpage, sql *)
787let test_sqlite_schema_format () =
788 with_temp_db @@ fun _fs db ->
789 let table = Sqlite.Table.create db ~name:"test_table" in
790 Sqlite.Table.put table "key" "value";
791 let schemas = Sqlite.tables db in
792 let names =
793 List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas
794 |> List.sort String.compare
795 in
796 (* Should have both the default kv table and test_table *)
797 Alcotest.(check bool) "has test_table" true (List.mem "test_table" names)
798
799(* Overflow values in SQLite-compatible files *)
800let test_sqlite_overflow_values () =
801 with_temp_db @@ fun _fs db ->
802 (* Values larger than max_local (4061 for 4096-byte pages) *)
803 let large = String.make 5000 'X' in
804 Sqlite.put db "overflow_key" large;
805 let result = Sqlite.find db "overflow_key" in
806 Alcotest.(check (option string))
807 "overflow value roundtrip" (Some large) result
808
809let test_sqlite_overflow_persistence () =
810 Eio_main.run @@ fun env ->
811 let fs = Eio.Stdenv.fs env in
812 let path = Eio.Path.(fs / temp_db "overflow") in
813 let large = String.make 10000 'Y' in
814 (* Write *)
815 Eio.Switch.run (fun sw ->
816 let db = Sqlite.open_ ~sw ~create:true path in
817 Sqlite.put db "big" large;
818 Sqlite.close db);
819 (* Read back *)
820 Eio.Switch.run (fun sw ->
821 let db = Sqlite.open_ ~sw path in
822 let result = Sqlite.find db "big" in
823 Alcotest.(check (option string)) "overflow persists" (Some large) result;
824 Sqlite.close db)
825
826(* ---- INSERT tests ---- *)
827
828let test_create_and_insert () =
829 with_temp_db @@ fun _fs db ->
830 Sqlite.create_table db ~sql:"CREATE TABLE users (name TEXT, age INTEGER)";
831 let rowid =
832 Sqlite.insert db ~table:"users" [ Sqlite.Vtext "Alice"; Sqlite.Vint 30L ]
833 in
834 Alcotest.(check int64) "first rowid" 1L rowid;
835 let rows = Sqlite.read_table db "users" in
836 Alcotest.(check int) "1 row" 1 (List.length rows);
837 let rid, values = List.hd rows in
838 Alcotest.(check int64) "rowid matches" 1L rid;
839 match values with
840 | [ Sqlite.Vtext "Alice"; Sqlite.Vint 30L ] -> ()
841 | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values
842
843let test_insert_multiple_rows () =
844 with_temp_db @@ fun _fs db ->
845 Sqlite.create_table db ~sql:"CREATE TABLE t (x TEXT, y INTEGER)";
846 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "a"; Sqlite.Vint 1L ] in
847 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "b"; Sqlite.Vint 2L ] in
848 let r3 = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "c"; Sqlite.Vint 3L ] in
849 Alcotest.(check int64) "third rowid" 3L r3;
850 let rows = Sqlite.read_table db "t" in
851 Alcotest.(check int) "3 rows" 3 (List.length rows)
852
853let test_insert_all_types () =
854 with_temp_db @@ fun _fs db ->
855 Sqlite.create_table db
856 ~sql:"CREATE TABLE t (a INTEGER, b REAL, c TEXT, d BLOB)";
857 let _ =
858 Sqlite.insert db ~table:"t"
859 [
860 Sqlite.Vint 42L;
861 Sqlite.Vfloat 3.14;
862 Sqlite.Vtext "hello";
863 Sqlite.Vblob "\x00\x01\x02";
864 ]
865 in
866 let rows = Sqlite.read_table db "t" in
867 let _, values = List.hd rows in
868 match values with
869 | [ Sqlite.Vint 42L; Sqlite.Vfloat f; Sqlite.Vtext "hello"; Sqlite.Vblob b ]
870 ->
871 Alcotest.(check (float 1e-10)) "float" 3.14 f;
872 Alcotest.(check string) "blob" "\x00\x01\x02" b
873 | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values
874
875let test_insert_with_null () =
876 with_temp_db @@ fun _fs db ->
877 Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT, b INTEGER, c TEXT)";
878 let _ =
879 Sqlite.insert db ~table:"t"
880 [ Sqlite.Vtext "x"; Sqlite.Vnull; Sqlite.Vtext "z" ]
881 in
882 let rows = Sqlite.read_table db "t" in
883 let _, values = List.hd rows in
884 match values with
885 | [ Sqlite.Vtext "x"; Sqlite.Vnull; Sqlite.Vtext "z" ] -> ()
886 | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values
887
888let test_insert_fewer_values () =
889 with_temp_db @@ fun _fs db ->
890 Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT, b INTEGER, c TEXT)";
891 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "only_a" ] in
892 let rows = Sqlite.read_table db "t" in
893 let _, values = List.hd rows in
894 (* Trailing columns should be Vnull *)
895 match values with
896 | [ Sqlite.Vtext "only_a"; Sqlite.Vnull; Sqlite.Vnull ] -> ()
897 | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values
898
899let test_insert_integer_primary_key () =
900 with_temp_db @@ fun _fs db ->
901 Sqlite.create_table db
902 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, name TEXT)";
903 (* When inserting Vnull for INTEGER PRIMARY KEY, rowid is auto-assigned *)
904 let r1 = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "Alice" ] in
905 let r2 = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "Bob" ] in
906 Alcotest.(check int64) "first rowid" 1L r1;
907 Alcotest.(check int64) "second rowid" 2L r2;
908 let rows = Sqlite.read_table db "t" in
909 (* read_table substitutes rowid for INTEGER PRIMARY KEY *)
910 let _, v1 = List.nth rows 0 in
911 (match v1 with
912 | [ Sqlite.Vint 1L; Sqlite.Vtext "Alice" ] -> ()
913 | _ -> Alcotest.failf "row1: %a" Fmt.(list Sqlite.pp_value) v1);
914 let _, v2 = List.nth rows 1 in
915 match v2 with
916 | [ Sqlite.Vint 2L; Sqlite.Vtext "Bob" ] -> ()
917 | _ -> Alcotest.failf "row2: %a" Fmt.(list Sqlite.pp_value) v2
918
919let test_insert_explicit_rowid () =
920 with_temp_db @@ fun _fs db ->
921 Sqlite.create_table db
922 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT)";
923 (* Explicit integer value for INTEGER PRIMARY KEY sets the rowid *)
924 let r =
925 Sqlite.insert db ~table:"t" [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ]
926 in
927 Alcotest.(check int64) "explicit rowid" 42L r;
928 let rows = Sqlite.read_table db "t" in
929 let rowid, values = List.hd rows in
930 Alcotest.(check int64) "stored rowid" 42L rowid;
931 match values with
932 | [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ] -> ()
933 | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values
934
935let test_insert_persistence () =
936 Eio_main.run @@ fun env ->
937 let fs = Eio.Stdenv.fs env in
938 let path = Eio.Path.(fs / temp_db "insert") in
939 (* Write *)
940 Eio.Switch.run (fun sw ->
941 let db = Sqlite.open_ ~sw ~create:true path in
942 Sqlite.create_table db ~sql:"CREATE TABLE items (name TEXT, qty INTEGER)";
943 let _ =
944 Sqlite.insert db ~table:"items"
945 [ Sqlite.Vtext "widget"; Sqlite.Vint 100L ]
946 in
947 let _ =
948 Sqlite.insert db ~table:"items"
949 [ Sqlite.Vtext "gadget"; Sqlite.Vint 50L ]
950 in
951 Sqlite.close db);
952 (* Read back *)
953 Eio.Switch.run (fun sw ->
954 let db = Sqlite.open_ ~sw path in
955 let rows = Sqlite.read_table db "items" in
956 Alcotest.(check int) "2 rows persisted" 2 (List.length rows);
957 let _, v1 = List.nth rows 0 in
958 (match v1 with
959 | [ Sqlite.Vtext "widget"; Sqlite.Vint 100L ] -> ()
960 | _ -> Alcotest.failf "row1: %a" Fmt.(list Sqlite.pp_value) v1);
961 Sqlite.close db)
962
963let test_insert_tables_lists_created () =
964 with_temp_db @@ fun _fs db ->
965 Sqlite.create_table db ~sql:"CREATE TABLE foo (a TEXT)";
966 Sqlite.create_table db ~sql:"CREATE TABLE bar (b INTEGER, c REAL)";
967 let schemas = Sqlite.tables db in
968 let names =
969 List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas
970 |> List.sort String.compare
971 in
972 (* "kv" is the default table, plus our two *)
973 Alcotest.(check (list string)) "all tables" [ "bar"; "foo"; "kv" ] names
974
975let test_insert_coexists_with_kv () =
976 with_temp_db @@ fun _fs db ->
977 (* KV operations still work alongside create_table/insert *)
978 Sqlite.put db "k1" "v1";
979 Sqlite.create_table db ~sql:"CREATE TABLE t (x TEXT)";
980 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "hello" ] in
981 Alcotest.(check (option string))
982 "kv still works" (Some "v1") (Sqlite.find db "k1");
983 let rows = Sqlite.read_table db "t" in
984 Alcotest.(check int) "insert works" 1 (List.length rows)
985
986let test_insert_nonexistent_table () =
987 with_temp_db @@ fun _fs db ->
988 try
989 let _ = Sqlite.insert db ~table:"nope" [ Sqlite.Vtext "x" ] in
990 Alcotest.fail "should have raised"
991 with Failure _ -> ()
992
993(* ── Unique constraint tests ─────────────────────────────────────── *)
994
995let test_unique_column_level () =
996 with_temp_db @@ fun _fs db ->
997 Sqlite.create_table db
998 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE)";
999 let _ =
1000 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1001 in
1002 (try
1003 let _ =
1004 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1005 in
1006 Alcotest.fail "should have raised Unique_violation"
1007 with Sqlite.Unique_violation cols ->
1008 Alcotest.(check string) "column name" "email" cols);
1009 (* Different email should succeed *)
1010 let _ =
1011 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "c@d.com" ]
1012 in
1013 ()
1014
1015let test_unique_table_level () =
1016 with_temp_db @@ fun _fs db ->
1017 Sqlite.create_table db
1018 ~sql:
1019 "CREATE TABLE t (id INTEGER PRIMARY KEY, provider TEXT, uid TEXT, \
1020 UNIQUE(provider, uid))";
1021 let _ =
1022 Sqlite.insert db ~table:"t"
1023 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "123" ]
1024 in
1025 (try
1026 let _ =
1027 Sqlite.insert db ~table:"t"
1028 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "123" ]
1029 in
1030 Alcotest.fail "should have raised Unique_violation"
1031 with Sqlite.Unique_violation cols ->
1032 Alcotest.(check string) "columns" "provider, uid" cols);
1033 (* Same provider, different uid should succeed *)
1034 let _ =
1035 Sqlite.insert db ~table:"t"
1036 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "456" ]
1037 in
1038 (* Different provider, same uid should succeed *)
1039 let _ =
1040 Sqlite.insert db ~table:"t"
1041 [ Sqlite.Vnull; Sqlite.Vtext "google"; Sqlite.Vtext "123" ]
1042 in
1043 ()
1044
1045let test_unique_composite () =
1046 with_temp_db @@ fun _fs db ->
1047 Sqlite.create_table db
1048 ~sql:"CREATE TABLE t (a TEXT, b TEXT, c TEXT, UNIQUE(a, b))";
1049 let _ =
1050 Sqlite.insert db ~table:"t"
1051 [ Sqlite.Vtext "x"; Sqlite.Vtext "y"; Sqlite.Vtext "z1" ]
1052 in
1053 try
1054 let _ =
1055 Sqlite.insert db ~table:"t"
1056 [ Sqlite.Vtext "x"; Sqlite.Vtext "y"; Sqlite.Vtext "z2" ]
1057 in
1058 Alcotest.fail "should have raised Unique_violation"
1059 with Sqlite.Unique_violation _ -> ()
1060
1061let test_unique_allows_distinct () =
1062 with_temp_db @@ fun _fs db ->
1063 Sqlite.create_table db ~sql:"CREATE TABLE t (name TEXT UNIQUE, age INTEGER)";
1064 let _ =
1065 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "alice"; Sqlite.Vint 30L ]
1066 in
1067 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "bob"; Sqlite.Vint 30L ] in
1068 let rows = Sqlite.read_table db "t" in
1069 Alcotest.(check int) "two rows" 2 (List.length rows)
1070
1071let test_unique_allows_multiple_nulls () =
1072 with_temp_db @@ fun _fs db ->
1073 Sqlite.create_table db
1074 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE)";
1075 (* Two NULLs should both succeed — NULL is never equal to NULL *)
1076 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vnull ] in
1077 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vnull ] in
1078 let rows = Sqlite.read_table db "t" in
1079 Alcotest.(check int) "two rows with NULL" 2 (List.length rows);
1080 (* But a non-NULL duplicate still fails *)
1081 let _ =
1082 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1083 in
1084 try
1085 let _ =
1086 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1087 in
1088 Alcotest.fail "should have raised Unique_violation"
1089 with Sqlite.Unique_violation _ -> ()
1090
1091let test_unique_composite_null () =
1092 with_temp_db @@ fun _fs db ->
1093 Sqlite.create_table db
1094 ~sql:"CREATE TABLE t (a TEXT, b TEXT, c TEXT, UNIQUE(a, b))";
1095 (* If any column in the composite key is NULL, duplicates are allowed *)
1096 let _ =
1097 Sqlite.insert db ~table:"t"
1098 [ Sqlite.Vnull; Sqlite.Vtext "y"; Sqlite.Vtext "z1" ]
1099 in
1100 let _ =
1101 Sqlite.insert db ~table:"t"
1102 [ Sqlite.Vnull; Sqlite.Vtext "y"; Sqlite.Vtext "z2" ]
1103 in
1104 let rows = Sqlite.read_table db "t" in
1105 Alcotest.(check int) "both rows with partial NULL" 2 (List.length rows)
1106
1107let test_unique_persists () =
1108 Eio_main.run @@ fun env ->
1109 let fs = Eio.Stdenv.fs env in
1110 let path = Eio.Path.(fs / temp_db "unique") in
1111 (* Create and insert *)
1112 Eio.Switch.run (fun sw ->
1113 let db = Sqlite.open_ ~sw ~create:true path in
1114 Sqlite.create_table db
1115 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE)";
1116 let _ =
1117 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1118 in
1119 Sqlite.close db);
1120 (* Reopen and verify constraint is enforced *)
1121 Eio.Switch.run (fun sw ->
1122 let db = Sqlite.open_ ~sw ~create:false path in
1123 (try
1124 let _ =
1125 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1126 in
1127 Alcotest.fail "should have raised Unique_violation after reopen"
1128 with Sqlite.Unique_violation _ -> ());
1129 Sqlite.close db)
1130
1131let test_unique_named_constraint () =
1132 with_temp_db @@ fun _fs db ->
1133 Sqlite.create_table db
1134 ~sql:
1135 "CREATE TABLE t (id INTEGER PRIMARY KEY, provider TEXT, uid TEXT, \
1136 CONSTRAINT uq_identity UNIQUE(provider, uid))";
1137 let _ =
1138 Sqlite.insert db ~table:"t"
1139 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "123" ]
1140 in
1141 (try
1142 let _ =
1143 Sqlite.insert db ~table:"t"
1144 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "123" ]
1145 in
1146 Alcotest.fail "should have raised Unique_violation"
1147 with Sqlite.Unique_violation cols ->
1148 Alcotest.(check string) "columns" "provider, uid" cols);
1149 (* Different values should succeed *)
1150 let _ =
1151 Sqlite.insert db ~table:"t"
1152 [ Sqlite.Vnull; Sqlite.Vtext "github"; Sqlite.Vtext "456" ]
1153 in
1154 ()
1155
1156(* ================================================================ *)
1157(* Transactions *)
1158(* ================================================================ *)
1159
1160let test_transaction_commit () =
1161 with_temp_db @@ fun _fs db ->
1162 Sqlite.with_transaction db (fun () ->
1163 Sqlite.put db "a" "1";
1164 Sqlite.put db "b" "2");
1165 Alcotest.(check (option string)) "a" (Some "1") (Sqlite.find db "a");
1166 Alcotest.(check (option string)) "b" (Some "2") (Sqlite.find db "b")
1167
1168let test_transaction_rollback () =
1169 with_temp_db @@ fun _fs db ->
1170 Sqlite.put db "x" "before";
1171 (try
1172 Sqlite.with_transaction db (fun () ->
1173 Sqlite.put db "x" "during";
1174 Sqlite.put db "y" "new";
1175 Alcotest.(check (option string))
1176 "x during" (Some "during") (Sqlite.find db "x");
1177 failwith "abort")
1178 with Failure _ -> ());
1179 Alcotest.(check (option string))
1180 "x restored" (Some "before") (Sqlite.find db "x");
1181 Alcotest.(check (option string)) "y gone" None (Sqlite.find db "y")
1182
1183let test_transaction_rollback_kv () =
1184 with_temp_db @@ fun _fs db ->
1185 Sqlite.put db "keep" "v1";
1186 (try
1187 Sqlite.with_transaction db (fun () ->
1188 Sqlite.put db "keep" "v2";
1189 Sqlite.delete db "keep";
1190 Sqlite.put db "tmp" "val";
1191 failwith "abort")
1192 with Failure _ -> ());
1193 Alcotest.(check (option string))
1194 "keep restored" (Some "v1") (Sqlite.find db "keep");
1195 Alcotest.(check bool) "tmp absent" false (Sqlite.mem db "tmp")
1196
1197let test_transaction_rollback_unique () =
1198 with_temp_db @@ fun _fs db ->
1199 Sqlite.create_table db
1200 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE)";
1201 let _ =
1202 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "a@b.com" ]
1203 in
1204 (try
1205 Sqlite.with_transaction db (fun () ->
1206 let _ =
1207 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "c@d.com" ]
1208 in
1209 failwith "abort")
1210 with Failure _ -> ());
1211 (* The rolled-back insert should not block a new insert with the same value *)
1212 let _ =
1213 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "c@d.com" ]
1214 in
1215 let rows = Sqlite.read_table db "t" in
1216 Alcotest.(check int) "two rows" 2 (List.length rows)
1217
1218let test_transaction_nested_failure () =
1219 with_temp_db @@ fun _fs db ->
1220 Sqlite.put db "a" "original";
1221 (try
1222 Sqlite.with_transaction db (fun () ->
1223 Sqlite.put db "a" "outer";
1224 Sqlite.with_transaction db (fun () ->
1225 Sqlite.put db "a" "inner";
1226 failwith "inner abort"))
1227 with Failure _ -> ());
1228 (* Both inner and outer changes should be rolled back *)
1229 Alcotest.(check (option string))
1230 "a original" (Some "original") (Sqlite.find db "a")
1231
1232(* ================================================================ *)
1233(* Non-rowid primary keys *)
1234(* ================================================================ *)
1235
1236let test_text_pk_not_alias () =
1237 with_temp_db @@ fun _fs db ->
1238 (* TEXT PRIMARY KEY is NOT a rowid alias — only INTEGER PRIMARY KEY is.
1239 The value must be stored in the record, not as the B-tree rowid. *)
1240 Sqlite.create_table db
1241 ~sql:"CREATE TABLE t (code TEXT PRIMARY KEY, label TEXT)";
1242 let r1 =
1243 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "ABC"; Sqlite.Vtext "Alpha" ]
1244 in
1245 let r2 =
1246 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "DEF"; Sqlite.Vtext "Delta" ]
1247 in
1248 (* Rowids should be auto-assigned (1, 2), not derived from the TEXT value *)
1249 Alcotest.(check int64) "first rowid auto" 1L r1;
1250 Alcotest.(check int64) "second rowid auto" 2L r2;
1251 (* Both TEXT values must appear in the record *)
1252 let rows = Sqlite.read_table db "t" in
1253 Alcotest.(check int) "2 rows" 2 (List.length rows);
1254 let _, v1 = List.nth rows 0 in
1255 (match v1 with
1256 | [ Sqlite.Vtext "ABC"; Sqlite.Vtext "Alpha" ] -> ()
1257 | _ -> Alcotest.failf "row1: %a" Fmt.(list Sqlite.pp_value) v1);
1258 let _, v2 = List.nth rows 1 in
1259 match v2 with
1260 | [ Sqlite.Vtext "DEF"; Sqlite.Vtext "Delta" ] -> ()
1261 | _ -> Alcotest.failf "row2: %a" Fmt.(list Sqlite.pp_value) v2
1262
1263let test_text_primary_key_persistence () =
1264 Eio_main.run @@ fun env ->
1265 let fs = Eio.Stdenv.fs env in
1266 let path = Eio.Path.(fs / temp_db "text_pk") in
1267 (* Write *)
1268 Eio.Switch.run (fun sw ->
1269 let db = Sqlite.open_ ~sw ~create:true path in
1270 Sqlite.create_table db
1271 ~sql:"CREATE TABLE t (code TEXT PRIMARY KEY, label TEXT)";
1272 let _ =
1273 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "X1"; Sqlite.Vtext "first" ]
1274 in
1275 Sqlite.close db);
1276 (* Read back — TEXT PK values must survive round-trip *)
1277 Eio.Switch.run (fun sw ->
1278 let db = Sqlite.open_ ~sw path in
1279 let rows = Sqlite.read_table db "t" in
1280 Alcotest.(check int) "1 row" 1 (List.length rows);
1281 let _, v = List.hd rows in
1282 (match v with
1283 | [ Sqlite.Vtext "X1"; Sqlite.Vtext "first" ] -> ()
1284 | _ -> Alcotest.failf "persisted: %a" Fmt.(list Sqlite.pp_value) v);
1285 Sqlite.close db)
1286
1287let test_real_pk_not_alias () =
1288 with_temp_db @@ fun _fs db ->
1289 (* REAL PRIMARY KEY is NOT a rowid alias either *)
1290 Sqlite.create_table db
1291 ~sql:"CREATE TABLE t (score REAL PRIMARY KEY, name TEXT)";
1292 let r =
1293 Sqlite.insert db ~table:"t" [ Sqlite.Vfloat 3.14; Sqlite.Vtext "pi" ]
1294 in
1295 Alcotest.(check int64) "auto rowid" 1L r;
1296 let rows = Sqlite.read_table db "t" in
1297 let _, v = List.hd rows in
1298 match v with
1299 | [ Sqlite.Vfloat f; Sqlite.Vtext "pi" ] ->
1300 Alcotest.(check (float 1e-10)) "float preserved" 3.14 f
1301 | _ -> Alcotest.failf "row: %a" Fmt.(list Sqlite.pp_value) v
1302
1303(* ================================================================ *)
1304(* Schema rollback *)
1305(* ================================================================ *)
1306
1307let test_transaction_rollback_create_table () =
1308 with_temp_db @@ fun _fs db ->
1309 (* A CREATE TABLE inside a rolled-back transaction should not leave
1310 the table visible. *)
1311 (try
1312 Sqlite.with_transaction db (fun () ->
1313 Sqlite.create_table db ~sql:"CREATE TABLE ghost (x TEXT)";
1314 let _ = Sqlite.insert db ~table:"ghost" [ Sqlite.Vtext "boo" ] in
1315 failwith "abort")
1316 with Failure _ -> ());
1317 let names =
1318 Sqlite.tables db
1319 |> List.map (fun (s : Sqlite.schema) -> s.tbl_name)
1320 |> List.sort String.compare
1321 in
1322 Alcotest.(check (list string))
1323 "ghost table absent after rollback" [ "kv" ] names
1324
1325let test_transaction_rollback_insert_generic () =
1326 with_temp_db @@ fun _fs db ->
1327 (* Create a table outside the transaction, then insert+rollback *)
1328 Sqlite.create_table db ~sql:"CREATE TABLE t (val TEXT)";
1329 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "keep" ] in
1330 (try
1331 Sqlite.with_transaction db (fun () ->
1332 let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "discard" ] in
1333 failwith "abort")
1334 with Failure _ -> ());
1335 let rows = Sqlite.read_table db "t" in
1336 Alcotest.(check int) "only pre-txn row" 1 (List.length rows);
1337 let _, v = List.hd rows in
1338 match v with
1339 | [ Sqlite.Vtext "keep" ] -> ()
1340 | _ -> Alcotest.failf "row: %a" Fmt.(list Sqlite.pp_value) v
1341
1342let test_transaction_rollback_schema_persistence () =
1343 Eio_main.run @@ fun env ->
1344 let fs = Eio.Stdenv.fs env in
1345 let path = Eio.Path.(fs / temp_db "schema_rb") in
1346 Eio.Switch.run (fun sw ->
1347 let db = Sqlite.open_ ~sw ~create:true path in
1348 (* Rolled-back schema must not appear in the persisted file *)
1349 (try
1350 Sqlite.with_transaction db (fun () ->
1351 Sqlite.create_table db ~sql:"CREATE TABLE phantom (z INTEGER)";
1352 failwith "abort")
1353 with Failure _ -> ());
1354 Sqlite.close db);
1355 Eio.Switch.run (fun sw ->
1356 let db = Sqlite.open_ ~sw path in
1357 let names =
1358 Sqlite.tables db
1359 |> List.map (fun (s : Sqlite.schema) -> s.tbl_name)
1360 |> List.sort String.compare
1361 in
1362 Alcotest.(check (list string))
1363 "phantom absent after reopen" [ "kv" ] names;
1364 Sqlite.close db)
1365
1366(* ================================================================ *)
1367(* Duplicate explicit rowids *)
1368(* ================================================================ *)
1369
1370let test_duplicate_explicit_rowid () =
1371 with_temp_db @@ fun _fs db ->
1372 Sqlite.create_table db
1373 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, name TEXT)";
1374 let _ =
1375 Sqlite.insert db ~table:"t" [ Sqlite.Vint 10L; Sqlite.Vtext "Alice" ]
1376 in
1377 (* Inserting with the same explicit rowid should fail, not silently
1378 overwrite. INTEGER PRIMARY KEY is implicitly UNIQUE per the spec. *)
1379 let raised =
1380 try
1381 let _ =
1382 Sqlite.insert db ~table:"t" [ Sqlite.Vint 10L; Sqlite.Vtext "Bob" ]
1383 in
1384 false
1385 with Sqlite.Unique_violation _ | Failure _ -> true
1386 in
1387 Alcotest.(check bool) "duplicate rowid rejected" true raised;
1388 (* Original row must be intact *)
1389 let rows = Sqlite.read_table db "t" in
1390 Alcotest.(check int) "still 1 row" 1 (List.length rows);
1391 let _, v = List.hd rows in
1392 match v with
1393 | [ Sqlite.Vint 10L; Sqlite.Vtext "Alice" ] -> ()
1394 | _ -> Alcotest.failf "original: %a" Fmt.(list Sqlite.pp_value) v
1395
1396let test_explicit_rowid_next_auto () =
1397 with_temp_db @@ fun _fs db ->
1398 (* After an explicit rowid, auto-assigned rowids should continue
1399 past the highest used value *)
1400 Sqlite.create_table db
1401 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT)";
1402 let _ =
1403 Sqlite.insert db ~table:"t" [ Sqlite.Vint 100L; Sqlite.Vtext "high" ]
1404 in
1405 let r2 = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "auto" ] in
1406 Alcotest.(check bool) "auto rowid > 100" true (r2 > 100L);
1407 let rows = Sqlite.read_table db "t" in
1408 Alcotest.(check int) "2 rows" 2 (List.length rows)
1409
1410(* ================================================================ *)
1411(* Preservation of indexes on close/reopen *)
1412(* ================================================================ *)
1413
1414let test_unique_index_survives_close () =
1415 Eio_main.run @@ fun env ->
1416 let fs = Eio.Stdenv.fs env in
1417 let path = Eio.Path.(fs / temp_db "idx_close") in
1418 (* Create table with UNIQUE, insert data, close *)
1419 Eio.Switch.run (fun sw ->
1420 let db = Sqlite.open_ ~sw ~create:true path in
1421 Sqlite.create_table db
1422 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, code TEXT UNIQUE)";
1423 let _ =
1424 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "AAA" ]
1425 in
1426 Sqlite.close db);
1427 (* Reopen — the UNIQUE index must be present in sqlite_master and enforced *)
1428 Eio.Switch.run (fun sw ->
1429 let db = Sqlite.open_ ~sw path in
1430 (* Duplicate must still be rejected *)
1431 (try
1432 let _ =
1433 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "AAA" ]
1434 in
1435 Alcotest.fail "unique violation expected after reopen"
1436 with Sqlite.Unique_violation _ -> ());
1437 (* Non-duplicate must succeed *)
1438 let _ =
1439 Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "BBB" ]
1440 in
1441 let rows = Sqlite.read_table db "t" in
1442 Alcotest.(check int) "2 rows after reopen" 2 (List.length rows);
1443 Sqlite.close db)
1444
1445let test_multiple_indexes_survive_close () =
1446 Eio_main.run @@ fun env ->
1447 let fs = Eio.Stdenv.fs env in
1448 let path = Eio.Path.(fs / temp_db "multi_idx") in
1449 Eio.Switch.run (fun sw ->
1450 let db = Sqlite.open_ ~sw ~create:true path in
1451 Sqlite.create_table db
1452 ~sql:
1453 "CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE, handle \
1454 TEXT UNIQUE)";
1455 let _ =
1456 Sqlite.insert db ~table:"t"
1457 [ Sqlite.Vnull; Sqlite.Vtext "a@b.com"; Sqlite.Vtext "@alice" ]
1458 in
1459 Sqlite.close db);
1460 Eio.Switch.run (fun sw ->
1461 let db = Sqlite.open_ ~sw path in
1462 (* Both UNIQUE constraints must be enforced after reopen *)
1463 (try
1464 let _ =
1465 Sqlite.insert db ~table:"t"
1466 [ Sqlite.Vnull; Sqlite.Vtext "a@b.com"; Sqlite.Vtext "@bob" ]
1467 in
1468 Alcotest.fail "email unique violation expected"
1469 with Sqlite.Unique_violation cols ->
1470 Alcotest.(check string) "email col" "email" cols);
1471 (try
1472 let _ =
1473 Sqlite.insert db ~table:"t"
1474 [ Sqlite.Vnull; Sqlite.Vtext "b@c.com"; Sqlite.Vtext "@alice" ]
1475 in
1476 Alcotest.fail "handle unique violation expected"
1477 with Sqlite.Unique_violation cols ->
1478 Alcotest.(check string) "handle col" "handle" cols);
1479 Sqlite.close db)
1480
1481let test_kv_survives_close_generic () =
1482 Eio_main.run @@ fun env ->
1483 let fs = Eio.Stdenv.fs env in
1484 let path = Eio.Path.(fs / temp_db "kv_generic") in
1485 Eio.Switch.run (fun sw ->
1486 let db = Sqlite.open_ ~sw ~create:true path in
1487 (* Mix KV data with generic tables that have indexes *)
1488 Sqlite.put db "mykey" "myval";
1489 Sqlite.create_table db
1490 ~sql:"CREATE TABLE items (id INTEGER PRIMARY KEY, sku TEXT UNIQUE)";
1491 let _ =
1492 Sqlite.insert db ~table:"items" [ Sqlite.Vnull; Sqlite.Vtext "W-001" ]
1493 in
1494 Sqlite.close db);
1495 Eio.Switch.run (fun sw ->
1496 let db = Sqlite.open_ ~sw path in
1497 (* KV data still present *)
1498 Alcotest.(check (option string))
1499 "kv survives" (Some "myval") (Sqlite.find db "mykey");
1500 (* Generic table data still present *)
1501 let rows = Sqlite.read_table db "items" in
1502 Alcotest.(check int) "items row" 1 (List.length rows);
1503 (* Index still enforced *)
1504 (try
1505 let _ =
1506 Sqlite.insert db ~table:"items"
1507 [ Sqlite.Vnull; Sqlite.Vtext "W-001" ]
1508 in
1509 Alcotest.fail "sku unique violation expected"
1510 with Sqlite.Unique_violation _ -> ());
1511 Sqlite.close db)
1512
1513(* ================================================================ *)
1514(* Non-rowid PRIMARY KEY enforcement (bug #2) *)
1515(* ================================================================ *)
1516
1517let test_text_pk_rejects_dups () =
1518 with_temp_db @@ fun _fs db ->
1519 (* TEXT PRIMARY KEY should enforce uniqueness, same as UNIQUE.
1520 Per SQLite spec, PRIMARY KEY implies UNIQUE for non-rowid tables. *)
1521 Sqlite.create_table db
1522 ~sql:"CREATE TABLE t (code TEXT PRIMARY KEY, label TEXT)";
1523 let _ =
1524 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "ABC"; Sqlite.Vtext "first" ]
1525 in
1526 let raised =
1527 try
1528 let _ =
1529 Sqlite.insert db ~table:"t"
1530 [ Sqlite.Vtext "ABC"; Sqlite.Vtext "second" ]
1531 in
1532 false
1533 with Sqlite.Unique_violation _ | Failure _ -> true
1534 in
1535 Alcotest.(check bool) "TEXT PK rejects duplicate" true raised;
1536 (* Original row must be intact *)
1537 let rows = Sqlite.read_table db "t" in
1538 Alcotest.(check int) "still 1 row" 1 (List.length rows)
1539
1540let test_composite_pk_rejects_dups () =
1541 with_temp_db @@ fun _fs db ->
1542 (* PRIMARY KEY (a, b) should enforce uniqueness on the tuple *)
1543 Sqlite.create_table db
1544 ~sql:"CREATE TABLE t (a TEXT, b TEXT, c TEXT, PRIMARY KEY (a, b))";
1545 let _ =
1546 Sqlite.insert db ~table:"t"
1547 [ Sqlite.Vtext "x"; Sqlite.Vtext "y"; Sqlite.Vtext "z1" ]
1548 in
1549 let raised =
1550 try
1551 let _ =
1552 Sqlite.insert db ~table:"t"
1553 [ Sqlite.Vtext "x"; Sqlite.Vtext "y"; Sqlite.Vtext "z2" ]
1554 in
1555 false
1556 with Sqlite.Unique_violation _ | Failure _ -> true
1557 in
1558 Alcotest.(check bool) "composite PK rejects duplicate" true raised;
1559 (* Different tuple should succeed *)
1560 let _ =
1561 Sqlite.insert db ~table:"t"
1562 [ Sqlite.Vtext "x"; Sqlite.Vtext "w"; Sqlite.Vtext "z3" ]
1563 in
1564 let rows = Sqlite.read_table db "t" in
1565 Alcotest.(check int) "2 rows" 2 (List.length rows)
1566
1567let test_text_primary_key_persists () =
1568 Eio_main.run @@ fun env ->
1569 let fs = Eio.Stdenv.fs env in
1570 let path = Eio.Path.(fs / temp_db "text_pk_enforce") in
1571 Eio.Switch.run (fun sw ->
1572 let db = Sqlite.open_ ~sw ~create:true path in
1573 Sqlite.create_table db
1574 ~sql:"CREATE TABLE t (code TEXT PRIMARY KEY, val TEXT)";
1575 let _ =
1576 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "A"; Sqlite.Vtext "v1" ]
1577 in
1578 Sqlite.close db);
1579 (* After reopen, the PK constraint must still be enforced *)
1580 Eio.Switch.run (fun sw ->
1581 let db = Sqlite.open_ ~sw path in
1582 let raised =
1583 try
1584 let _ =
1585 Sqlite.insert db ~table:"t" [ Sqlite.Vtext "A"; Sqlite.Vtext "v2" ]
1586 in
1587 false
1588 with Sqlite.Unique_violation _ | Failure _ -> true
1589 in
1590 Alcotest.(check bool) "TEXT PK enforced after reopen" true raised;
1591 Sqlite.close db)
1592
1593(* ================================================================ *)
1594(* Transaction rollback for named tables (bug #3 extended) *)
1595(* ================================================================ *)
1596
1597let test_rollback_named_create () =
1598 with_temp_db @@ fun _fs db ->
1599 (* Table.create inside a rolled-back transaction should not
1600 leave the named table visible. *)
1601 (try
1602 Sqlite.with_transaction db (fun () ->
1603 let t = Sqlite.Table.create db ~name:"temp_tbl" in
1604 Sqlite.Table.put t "k" "v";
1605 failwith "abort")
1606 with Failure _ -> ());
1607 let names =
1608 Sqlite.tables db
1609 |> List.map (fun (s : Sqlite.schema) -> s.tbl_name)
1610 |> List.sort String.compare
1611 in
1612 Alcotest.(check (list string)) "temp_tbl absent after rollback" [ "kv" ] names
1613
1614(* ================================================================ *)
1615(* Duplicate rowid + secondary index consistency (bug #4 extended) *)
1616(* ================================================================ *)
1617
1618let test_duplicate_rowid_index_consistency () =
1619 with_temp_db @@ fun _fs db ->
1620 (* If duplicate rowid silently succeeds (current bug), the secondary
1621 UNIQUE index should still be consistent — not contain stale entries. *)
1622 Sqlite.create_table db
1623 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, email TEXT UNIQUE)";
1624 let _ =
1625 Sqlite.insert db ~table:"t" [ Sqlite.Vint 1L; Sqlite.Vtext "a@b.com" ]
1626 in
1627 (* This should fail (duplicate rowid), but if it doesn't, the index
1628 must not allow the old email to become a ghost *)
1629 let dup_ok =
1630 try
1631 let _ =
1632 Sqlite.insert db ~table:"t" [ Sqlite.Vint 1L; Sqlite.Vtext "c@d.com" ]
1633 in
1634 true
1635 with Sqlite.Unique_violation _ | Failure _ -> false
1636 in
1637 if dup_ok then begin
1638 (* Bug: duplicate was accepted. Verify index consistency. *)
1639 let rows = Sqlite.read_table db "t" in
1640 (* There should be exactly 1 row at rowid 1, not 2 *)
1641 let at_rowid_1 = List.filter (fun (rid, _) -> rid = 1L) rows in
1642 Alcotest.(check int) "only 1 row at rowid 1" 1 (List.length at_rowid_1);
1643 (* The old email should be insertable if overwritten *)
1644 let old_email_ok =
1645 try
1646 let _ =
1647 Sqlite.insert db ~table:"t" [ Sqlite.Vint 2L; Sqlite.Vtext "a@b.com" ]
1648 in
1649 true
1650 with Sqlite.Unique_violation _ -> false
1651 in
1652 (* If the row was overwritten, "a@b.com" should be free.
1653 If both rows exist, "a@b.com" is still taken.
1654 Either way the index must be consistent. *)
1655 ignore old_email_ok
1656 end;
1657 (* The correct behavior: duplicate rowid must be rejected *)
1658 Alcotest.(check bool) "duplicate rowid should be rejected" false dup_ok
1659
1660let test_duplicate_rowid_preserves_delete () =
1661 with_temp_db @@ fun _fs db ->
1662 (* If duplicate rowids exist (bug), delete_row should remove all
1663 copies, not just one — otherwise the table is corrupted. *)
1664 Sqlite.create_table db
1665 ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT)";
1666 let _ =
1667 Sqlite.insert db ~table:"t" [ Sqlite.Vint 5L; Sqlite.Vtext "first" ]
1668 in
1669 (* Attempt duplicate — may or may not raise *)
1670 (try
1671 let _ =
1672 Sqlite.insert db ~table:"t" [ Sqlite.Vint 5L; Sqlite.Vtext "second" ]
1673 in
1674 ()
1675 with Sqlite.Unique_violation _ | Failure _ -> ());
1676 (* Delete rowid 5 *)
1677 Sqlite.delete_row db ~table:"t" 5L;
1678 let rows = Sqlite.read_table db "t" in
1679 Alcotest.(check int) "no rows after delete" 0 (List.length rows)
1680
1681(* ================================================================ *)
1682(* Table name handling (bug #5) *)
1683(* ================================================================ *)
1684
1685let test_create_table_duplicate_name () =
1686 with_temp_db @@ fun _fs db ->
1687 (* Creating a table with the same name twice should not silently
1688 create a second entry. *)
1689 Sqlite.create_table db ~sql:"CREATE TABLE dup (a TEXT)";
1690 let _ = Sqlite.insert db ~table:"dup" [ Sqlite.Vtext "v1" ] in
1691 let raised =
1692 try
1693 Sqlite.create_table db ~sql:"CREATE TABLE dup (b INTEGER)";
1694 false
1695 with Sqlite.Unique_violation _ | Failure _ -> true
1696 in
1697 (* Either it raises, or IF NOT EXISTS is required *)
1698 if not raised then begin
1699 (* If it didn't raise, at least the original table should still work *)
1700 let rows = Sqlite.read_table db "dup" in
1701 Alcotest.(check int) "original data intact" 1 (List.length rows)
1702 end;
1703 (* The table list should have exactly one "dup" *)
1704 let dup_count =
1705 Sqlite.tables db
1706 |> List.filter (fun (s : Sqlite.schema) -> s.tbl_name = "dup")
1707 |> List.length
1708 in
1709 Alcotest.(check int) "exactly one 'dup' table" 1 dup_count
1710
1711let test_named_kv_collision () =
1712 with_temp_db @@ fun _fs db ->
1713 (* Table.create ~name:"kv" should not silently collide with the
1714 default kv table. *)
1715 Sqlite.put db "existing" "data";
1716 let t = Sqlite.Table.create db ~name:"kv" in
1717 Sqlite.Table.put t "other" "val";
1718 (* The default kv API must still see "existing" *)
1719 Alcotest.(check (option string))
1720 "default kv intact" (Some "data")
1721 (Sqlite.find db "existing");
1722 (* There should be exactly one "kv" in the table list *)
1723 let kv_count =
1724 Sqlite.tables db
1725 |> List.filter (fun (s : Sqlite.schema) -> s.tbl_name = "kv")
1726 |> List.length
1727 in
1728 Alcotest.(check int) "exactly one 'kv' table" 1 kv_count
1729
1730let test_quoted_table_name () =
1731 with_temp_db @@ fun _fs db ->
1732 (* Quoted table names should be handled correctly.
1733 CREATE TABLE "my table" should produce name "my table", not
1734 "\"my table\"" *)
1735 Sqlite.create_table db ~sql:"CREATE TABLE \"my table\" (x TEXT)";
1736 let names =
1737 Sqlite.tables db
1738 |> List.map (fun (s : Sqlite.schema) -> s.tbl_name)
1739 |> List.sort String.compare
1740 in
1741 (* The name should be unquoted *)
1742 Alcotest.(check bool)
1743 "quoted name is unquoted" true
1744 (List.mem "my table" names || List.mem "\"my table\"" names);
1745 (* Should be able to insert and read back *)
1746 let name = if List.mem "my table" names then "my table" else "\"my table\"" in
1747 let _ = Sqlite.insert db ~table:name [ Sqlite.Vtext "hello" ] in
1748 let rows = Sqlite.read_table db name in
1749 Alcotest.(check int) "1 row in quoted table" 1 (List.length rows)
1750
1751(* {1 Hostile-input cases (formerly test_hostile.ml)} *)
1752
1753let page_size = 4096
1754let magic = "SQLite format 3\000"
1755
1756(* -- Helpers -- *)
1757
1758let write_u16_be buf off v =
1759 Bytes.set_uint8 buf off ((v lsr 8) land 0xff);
1760 Bytes.set_uint8 buf (off + 1) (v land 0xff)
1761
1762let write_u32_be buf off v =
1763 Bytes.set_uint8 buf off ((v lsr 24) land 0xff);
1764 Bytes.set_uint8 buf (off + 1) ((v lsr 16) land 0xff);
1765 Bytes.set_uint8 buf (off + 2) ((v lsr 8) land 0xff);
1766 Bytes.set_uint8 buf (off + 3) (v land 0xff)
1767
1768(* Minimal valid DB header (100 bytes) *)
1769let db_header ~page_count =
1770 let buf = Bytes.make 100 '\000' in
1771 Bytes.blit_string magic 0 buf 0 16;
1772 write_u16_be buf 16 page_size;
1773 Bytes.set_uint8 buf 18 1;
1774 (* write version *)
1775 Bytes.set_uint8 buf 19 1;
1776 (* read version *)
1777 Bytes.set_uint8 buf 21 64;
1778 (* max embedded payload fraction *)
1779 Bytes.set_uint8 buf 22 32;
1780 (* min embedded payload fraction *)
1781 Bytes.set_uint8 buf 23 32;
1782 (* leaf payload fraction *)
1783 write_u32_be buf 28 page_count;
1784 Bytes.unsafe_to_string buf
1785
1786(* Write a file with the given pages (page 1 starts at offset 0) *)
1787let write_db path pages =
1788 let data =
1789 String.concat ""
1790 (List.map
1791 (fun page ->
1792 let s = page in
1793 let padded = Bytes.make page_size '\000' in
1794 Bytes.blit_string s 0 padded 0 (min (String.length s) page_size);
1795 Bytes.unsafe_to_string padded)
1796 pages)
1797 in
1798 Eio.Path.save ~create:(`Or_truncate 0o644) path data
1799
1800let with_temp_hostile f =
1801 Eio_main.run @@ fun env ->
1802 let cwd = Eio.Stdenv.cwd env in
1803 let tmp = Eio.Path.(cwd / "_build" / "test_hostile") in
1804 (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp with Eio.Io _ -> ());
1805 let name = Fmt.str "hostile_%d.db" (Random.int 1_000_000) in
1806 let path = Eio.Path.(tmp / name) in
1807 Eio.Switch.run @@ fun sw -> f sw path
1808
1809(* Hostile-input tests assert "must not hang or crash". Sqlite's documented
1810 failure modes are [Failure], [Invalid_argument], [Sys_error] (file-system
1811 errors), [End_of_file] (truncated databases) and [Sqlite.Unique_violation].
1812 Anything else (asserts, fatal errors) is a bug we want to surface. *)
1813let safe_exn = function
1814 | Failure _ | Invalid_argument _ | Sys_error _ | End_of_file
1815 | Sqlite.Unique_violation _ ->
1816 true
1817 | _ -> false
1818
1819let try_safely f = try ignore (f ()) with e when safe_exn e -> ()
1820
1821(* Try to open and do basic operations; must not hang or crash *)
1822let must_fail_or_succeed_safely sw path =
1823 match Sqlite.open_ ~sw path with
1824 | exception e when safe_exn e -> () (* clean failure on open *)
1825 | db ->
1826 (* If open succeeded, basic operations must not hang *)
1827 try_safely (fun () -> Sqlite.tables db);
1828 try_safely (fun () -> Sqlite.find db "nonexistent");
1829 Sqlite.close db
1830
1831(* -- CVE-2019-19646 inspired: cyclic/self-referential pages -- *)
1832
1833let test_self_referential_page () =
1834 with_temp_hostile @@ fun sw path ->
1835 (* Page 1: sqlite_master with a table whose root points to itself *)
1836 let page1 = Bytes.make page_size '\000' in
1837 let hdr = db_header ~page_count:2 in
1838 Bytes.blit_string hdr 0 page1 0 100;
1839 (* sqlite_master leaf header at offset 100 *)
1840 Bytes.set_uint8 page1 100 0x0d;
1841 (* leaf table *)
1842 write_u16_be page1 103 0;
1843 (* 0 cells — empty master *)
1844 write_u16_be page1 105 page_size;
1845 (* Page 2: interior table page pointing to itself *)
1846 let page2 = Bytes.make page_size '\000' in
1847 Bytes.set_uint8 page2 0 0x05;
1848 (* interior table *)
1849 write_u16_be page2 3 1;
1850 (* 1 cell *)
1851 write_u16_be page2 5 (page_size - 12);
1852 write_u32_be page2 8 2;
1853 (* right child = self *)
1854 (* Cell at end: left_child=2 (self), rowid=1 *)
1855 let cell_off = page_size - 12 in
1856 write_u32_be page2 cell_off 2;
1857 (* left child = page 2 = self *)
1858 Bytes.set_uint8 page2 (cell_off + 4) 1;
1859 (* rowid varint = 1 *)
1860 write_u16_be page2 12 (page_size - 12);
1861 (* cell pointer *)
1862 write_db path [ Bytes.unsafe_to_string page1; Bytes.unsafe_to_string page2 ];
1863 must_fail_or_succeed_safely sw path
1864
1865(* -- CVE-2022-35737 inspired: oversized payload/varint -- *)
1866
1867let test_oversized_varint () =
1868 with_temp_hostile @@ fun sw path ->
1869 let page1 = Bytes.make page_size '\000' in
1870 let hdr = db_header ~page_count:1 in
1871 Bytes.blit_string hdr 0 page1 0 100;
1872 (* sqlite_master: leaf with 1 cell containing a huge payload_size varint *)
1873 Bytes.set_uint8 page1 100 0x0d;
1874 write_u16_be page1 103 1;
1875 (* 1 cell *)
1876 write_u16_be page1 105 200;
1877 write_u16_be page1 108 200;
1878 (* cell pointer at offset 200 *)
1879 (* Cell at 200: payload_size = 9-byte varint (max value) *)
1880 let cell_off = 200 in
1881 for i = 0 to 7 do
1882 Bytes.set_uint8 page1 (cell_off + i) 0xff
1883 done;
1884 Bytes.set_uint8 page1 (cell_off + 8) 0x01;
1885 (* 9th varint byte *)
1886 write_db path [ Bytes.unsafe_to_string page1 ];
1887 must_fail_or_succeed_safely sw path
1888
1889(* -- CVE-2020-13434 inspired: size overflow in record encoding -- *)
1890
1891let test_record_header_overflow () =
1892 with_temp_hostile @@ fun sw path ->
1893 let page1 = Bytes.make page_size '\000' in
1894 let hdr = db_header ~page_count:1 in
1895 Bytes.blit_string hdr 0 page1 0 100;
1896 Bytes.set_uint8 page1 100 0x0d;
1897 write_u16_be page1 103 1;
1898 write_u16_be page1 105 300;
1899 write_u16_be page1 108 300;
1900 (* Cell: small payload_size (20), rowid=1, then a record header claiming
1901 huge header_size *)
1902 let off = 300 in
1903 Bytes.set_uint8 page1 off 20;
1904 (* payload_size varint = 20 *)
1905 Bytes.set_uint8 page1 (off + 1) 1;
1906 (* rowid varint = 1 *)
1907 (* Record: header_size varint = 255 (way bigger than 20-byte payload) *)
1908 Bytes.set_uint8 page1 (off + 2) 0x81;
1909 (* varint high byte *)
1910 Bytes.set_uint8 page1 (off + 3) 0x7f;
1911 (* varint low = 255 *)
1912 write_db path [ Bytes.unsafe_to_string page1 ];
1913 must_fail_or_succeed_safely sw path
1914
1915(* -- CVE-2025-7709 inspired: malformed index B-tree -- *)
1916
1917let test_wrong_root_page_kind () =
1918 with_temp_hostile @@ fun sw path ->
1919 (* Page 2 is supposed to be a table but has index page kind *)
1920 let page1 = Bytes.make page_size '\000' in
1921 let hdr = db_header ~page_count:2 in
1922 Bytes.blit_string hdr 0 page1 0 100;
1923 Bytes.set_uint8 page1 100 0x0d;
1924 write_u16_be page1 103 0;
1925 write_u16_be page1 105 page_size;
1926 let page2 = Bytes.make page_size '\000' in
1927 (* Set page kind to leaf_index (0x0a) instead of leaf_table (0x0d) *)
1928 Bytes.set_uint8 page2 0 0x0a;
1929 write_u16_be page2 3 0;
1930 write_u16_be page2 5 page_size;
1931 write_db path [ Bytes.unsafe_to_string page1; Bytes.unsafe_to_string page2 ];
1932 must_fail_or_succeed_safely sw path
1933
1934(* -- Root page beyond file -- *)
1935
1936let test_root_page_oob () =
1937 with_temp_hostile @@ fun sw path ->
1938 let page1 = Bytes.make page_size '\000' in
1939 let hdr = db_header ~page_count:1 in
1940 Bytes.blit_string hdr 0 page1 0 100;
1941 (* sqlite_master: leaf with a table entry pointing to page 999 *)
1942 Bytes.set_uint8 page1 100 0x0d;
1943 write_u16_be page1 103 1;
1944 let cell_start = 200 in
1945 write_u16_be page1 105 cell_start;
1946 write_u16_be page1 108 cell_start;
1947 (* Build a sqlite_master record: type=table, name=t, tbl=t, root=999, sql *)
1948 let sql = "CREATE TABLE t (x TEXT)" in
1949 let payload =
1950 Btree.Record.encode
1951 [
1952 Btree.Record.Vtext "table";
1953 Btree.Record.Vtext "t";
1954 Btree.Record.Vtext "t";
1955 Btree.Record.Vint 999L;
1956 Btree.Record.Vtext sql;
1957 ]
1958 in
1959 let payload_len = String.length payload in
1960 (* Cell: payload_size varint + rowid varint + payload *)
1961 Bytes.set_uint8 page1 cell_start payload_len;
1962 (* payload_size *)
1963 Bytes.set_uint8 page1 (cell_start + 1) 1;
1964 (* rowid = 1 *)
1965 Bytes.blit_string payload 0 page1 (cell_start + 2) payload_len;
1966 write_db path [ Bytes.unsafe_to_string page1 ];
1967 (* Open should succeed (just reads master), but accessing the table
1968 should fail — not crash *)
1969 match Sqlite.open_ ~sw path with
1970 | exception _ -> ()
1971 | db ->
1972 try_safely (fun () ->
1973 Sqlite.fold_table db "t" ~init:() ~f:(fun _ _ () -> ()));
1974 Sqlite.close db
1975
1976(* -- Empty/garbage file -- *)
1977
1978let test_empty_file () =
1979 with_temp_hostile @@ fun sw path ->
1980 Eio.Path.save ~create:(`Or_truncate 0o644) path "";
1981 must_fail_or_succeed_safely sw path
1982
1983let test_garbage_file () =
1984 with_temp_hostile @@ fun sw path ->
1985 Eio.Path.save ~create:(`Or_truncate 0o644) path
1986 (String.init 4096 (fun _ -> Char.chr (Random.int 256)));
1987 must_fail_or_succeed_safely sw path
1988
1989(* -- Cell pointer pointing into header -- *)
1990
1991let test_cell_pointer_in_header () =
1992 with_temp_hostile @@ fun sw path ->
1993 let page1 = Bytes.make page_size '\000' in
1994 let hdr = db_header ~page_count:1 in
1995 Bytes.blit_string hdr 0 page1 0 100;
1996 Bytes.set_uint8 page1 100 0x0d;
1997 write_u16_be page1 103 1;
1998 (* 1 cell *)
1999 write_u16_be page1 105 50;
2000 (* content starts inside header! *)
2001 write_u16_be page1 108 50;
2002 (* cell pointer into header area *)
2003 write_db path [ Bytes.unsafe_to_string page1 ];
2004 must_fail_or_succeed_safely sw path
2005
2006(* -- Page count = 0 -- *)
2007
2008let test_zero_page_count () =
2009 with_temp_hostile @@ fun sw path ->
2010 let page1 = Bytes.make page_size '\000' in
2011 let hdr = db_header ~page_count:0 in
2012 Bytes.blit_string hdr 0 page1 0 100;
2013 write_db path [ Bytes.unsafe_to_string page1 ];
2014 must_fail_or_succeed_safely sw path
2015
2016let hostile_cases =
2017 [
2018 Alcotest.test_case "hostile: self-referential page" `Quick
2019 test_self_referential_page;
2020 Alcotest.test_case "hostile: oversized varint" `Quick test_oversized_varint;
2021 Alcotest.test_case "hostile: record header overflow" `Quick
2022 test_record_header_overflow;
2023 Alcotest.test_case "hostile: wrong root page kind" `Quick
2024 test_wrong_root_page_kind;
2025 Alcotest.test_case "hostile: root page oob" `Quick test_root_page_oob;
2026 Alcotest.test_case "hostile: empty file" `Quick test_empty_file;
2027 Alcotest.test_case "hostile: garbage file" `Quick test_garbage_file;
2028 Alcotest.test_case "hostile: cell pointer in header" `Quick
2029 test_cell_pointer_in_header;
2030 Alcotest.test_case "hostile: zero page count" `Quick test_zero_page_count;
2031 ]
2032
2033let suite =
2034 ( "sqlite",
2035 List.concat
2036 [
2037 [
2038 Alcotest.test_case "put/get" `Quick test_put_get;
2039 Alcotest.test_case "get missing" `Quick test_get_missing;
2040 Alcotest.test_case "put overwrite" `Quick test_put_overwrite;
2041 Alcotest.test_case "delete" `Quick test_delete;
2042 Alcotest.test_case "delete missing" `Quick test_delete_missing;
2043 Alcotest.test_case "mem" `Quick test_mem;
2044 Alcotest.test_case "iter" `Quick test_iter;
2045 Alcotest.test_case "fold" `Quick test_fold;
2046 ];
2047 [
2048 Alcotest.test_case "binary values" `Quick test_binary_values;
2049 Alcotest.test_case "empty value" `Quick test_empty_value;
2050 Alcotest.test_case "large value" `Quick test_large_value;
2051 ];
2052 [
2053 Alcotest.test_case "table basic" `Quick test_table_basic;
2054 Alcotest.test_case "table isolation" `Quick test_table_isolation;
2055 Alcotest.test_case "table mem/delete" `Quick test_table_mem_delete;
2056 Alcotest.test_case "table iter" `Quick test_table_iter;
2057 ];
2058 [
2059 Alcotest.test_case "sql injection key" `Quick test_sql_injection_key;
2060 Alcotest.test_case "sql injection value" `Quick
2061 test_sql_injection_value;
2062 Alcotest.test_case "table name validation" `Quick
2063 test_table_name_validation;
2064 Alcotest.test_case "valid table names" `Quick test_valid_table_names;
2065 ];
2066 [
2067 Alcotest.test_case "unicode keys" `Quick test_unicode_keys;
2068 Alcotest.test_case "unicode values" `Quick test_unicode_values;
2069 ];
2070 [
2071 Alcotest.test_case "sync" `Quick test_sync;
2072 Alcotest.test_case "persistence basic" `Quick test_persistence_basic;
2073 Alcotest.test_case "persistence with delete" `Quick
2074 test_persistence_with_delete;
2075 Alcotest.test_case "persistence tables" `Quick test_persistence_tables;
2076 ];
2077 [
2078 Alcotest.test_case "empty key" `Quick test_empty_key;
2079 Alcotest.test_case "key with nulls" `Quick test_key_with_nulls;
2080 Alcotest.test_case "long key" `Quick test_long_key;
2081 Alcotest.test_case "all byte values" `Quick test_all_byte_values;
2082 Alcotest.test_case "max int key length" `Quick test_max_int_key_length;
2083 ];
2084 [
2085 Alcotest.test_case "many keys" `Slow test_many_keys;
2086 Alcotest.test_case "many updates" `Quick test_many_updates;
2087 Alcotest.test_case "interleaved ops" `Quick
2088 test_interleaved_operations;
2089 Alcotest.test_case "many tables" `Quick test_many_tables;
2090 ];
2091 [
2092 Alcotest.test_case "overflow key length" `Quick test_cve_key_overflow;
2093 Alcotest.test_case "boundary conditions" `Quick
2094 test_cve_like_boundary_conditions;
2095 ];
2096 [
2097 Alcotest.test_case "parse simple" `Quick test_parse_simple;
2098 Alcotest.test_case "parse integer pk" `Quick
2099 test_parse_integer_primary_key;
2100 Alcotest.test_case "parse if not exists" `Quick
2101 test_parse_if_not_exists;
2102 Alcotest.test_case "parse nested parens" `Quick
2103 test_parse_nested_parens;
2104 Alcotest.test_case "parse table constraints" `Quick
2105 test_parse_table_constraints;
2106 Alcotest.test_case "parse no type" `Quick test_parse_no_type;
2107 Alcotest.test_case "parse autoincrement" `Quick
2108 test_parse_autoincrement;
2109 Alcotest.test_case "parse invalid" `Quick test_parse_invalid;
2110 Alcotest.test_case "open no kv" `Quick test_open_no_kv;
2111 Alcotest.test_case "read generic table" `Quick test_read_generic_table;
2112 Alcotest.test_case "integer primary key" `Quick
2113 test_integer_primary_key;
2114 Alcotest.test_case "tables lists all" `Quick test_tables_lists_all;
2115 Alcotest.test_case "fold table" `Quick test_fold_table;
2116 ];
2117 [
2118 Alcotest.test_case "spec header magic" `Quick test_db_header_magic;
2119 Alcotest.test_case "spec header values" `Quick
2120 test_db_header_fixed_values;
2121 Alcotest.test_case "spec change counter" `Quick
2122 test_db_header_change_counter;
2123 Alcotest.test_case "spec page1 btree" `Quick test_page1_btree_header;
2124 Alcotest.test_case "spec schema format" `Quick
2125 test_sqlite_schema_format;
2126 Alcotest.test_case "spec overflow values" `Quick
2127 test_sqlite_overflow_values;
2128 Alcotest.test_case "spec overflow persist" `Quick
2129 test_sqlite_overflow_persistence;
2130 ];
2131 [
2132 Alcotest.test_case "create and insert" `Quick test_create_and_insert;
2133 Alcotest.test_case "insert multiple rows" `Quick
2134 test_insert_multiple_rows;
2135 Alcotest.test_case "insert all types" `Quick test_insert_all_types;
2136 Alcotest.test_case "insert with null" `Quick test_insert_with_null;
2137 Alcotest.test_case "insert fewer values" `Quick
2138 test_insert_fewer_values;
2139 Alcotest.test_case "insert integer pk" `Quick
2140 test_insert_integer_primary_key;
2141 Alcotest.test_case "insert explicit rowid" `Quick
2142 test_insert_explicit_rowid;
2143 Alcotest.test_case "insert persistence" `Quick test_insert_persistence;
2144 Alcotest.test_case "insert tables listed" `Quick
2145 test_insert_tables_lists_created;
2146 Alcotest.test_case "insert with kv" `Quick
2147 test_insert_coexists_with_kv;
2148 Alcotest.test_case "insert nonexistent" `Quick
2149 test_insert_nonexistent_table;
2150 ];
2151 [
2152 Alcotest.test_case "unique column-level" `Quick
2153 test_unique_column_level;
2154 Alcotest.test_case "unique table-level" `Quick test_unique_table_level;
2155 Alcotest.test_case "unique composite" `Quick test_unique_composite;
2156 Alcotest.test_case "unique allows distinct" `Quick
2157 test_unique_allows_distinct;
2158 Alcotest.test_case "unique persists" `Quick test_unique_persists;
2159 Alcotest.test_case "unique named constraint" `Quick
2160 test_unique_named_constraint;
2161 Alcotest.test_case "unique allows multiple NULLs" `Quick
2162 test_unique_allows_multiple_nulls;
2163 Alcotest.test_case "unique composite NULL" `Quick
2164 test_unique_composite_null;
2165 ];
2166 [
2167 Alcotest.test_case "transaction commit" `Quick test_transaction_commit;
2168 Alcotest.test_case "transaction rollback" `Quick
2169 test_transaction_rollback;
2170 Alcotest.test_case "transaction rollback kv" `Quick
2171 test_transaction_rollback_kv;
2172 Alcotest.test_case "transaction rollback unique" `Quick
2173 test_transaction_rollback_unique;
2174 Alcotest.test_case "transaction nested failure" `Quick
2175 test_transaction_nested_failure;
2176 ];
2177 [
2178 Alcotest.test_case "text pk not rowid alias" `Quick
2179 test_text_pk_not_alias;
2180 Alcotest.test_case "text pk persistence" `Quick
2181 test_text_primary_key_persistence;
2182 Alcotest.test_case "real pk not rowid alias" `Quick
2183 test_real_pk_not_alias;
2184 ];
2185 [
2186 Alcotest.test_case "rollback create table" `Quick
2187 test_transaction_rollback_create_table;
2188 Alcotest.test_case "rollback insert generic" `Quick
2189 test_transaction_rollback_insert_generic;
2190 Alcotest.test_case "rollback schema persistence" `Quick
2191 test_transaction_rollback_schema_persistence;
2192 ];
2193 [
2194 Alcotest.test_case "duplicate explicit rowid" `Quick
2195 test_duplicate_explicit_rowid;
2196 Alcotest.test_case "explicit rowid next auto" `Quick
2197 test_explicit_rowid_next_auto;
2198 ];
2199 [
2200 Alcotest.test_case "unique index survives close" `Quick
2201 test_unique_index_survives_close;
2202 Alcotest.test_case "multi index survives close" `Quick
2203 test_multiple_indexes_survive_close;
2204 Alcotest.test_case "kv with generic survives close" `Quick
2205 test_kv_survives_close_generic;
2206 ];
2207 [
2208 Alcotest.test_case "text pk rejects dupes" `Quick
2209 test_text_pk_rejects_dups;
2210 Alcotest.test_case "composite pk rejects dupes" `Quick
2211 test_composite_pk_rejects_dups;
2212 Alcotest.test_case "text pk enforced after reopen" `Quick
2213 test_text_primary_key_persists;
2214 ];
2215 [
2216 Alcotest.test_case "rollback named table create" `Quick
2217 test_rollback_named_create;
2218 ];
2219 [
2220 Alcotest.test_case "dup rowid index consistency" `Quick
2221 test_duplicate_rowid_index_consistency;
2222 Alcotest.test_case "dup rowid delete cleanup" `Quick
2223 test_duplicate_rowid_preserves_delete;
2224 ];
2225 [
2226 Alcotest.test_case "create table duplicate name" `Quick
2227 test_create_table_duplicate_name;
2228 Alcotest.test_case "named table kv collision" `Quick
2229 test_named_kv_collision;
2230 Alcotest.test_case "quoted table name" `Quick test_quoted_table_name;
2231 ];
2232 hostile_cases;
2233 ] )