Bound monotonic timestamp drift; return receipt_summary from verify

+268

2 changed files

expand all

lib

sqlite.ml

test

lib/sqlite.ml

··· 903 903 let rowid = 904 904 match pk_value with 905 905 | Vint n -> 906 + (* INTEGER PRIMARY KEY is implicitly UNIQUE — reject duplicates *) 907 + if Btree.Table.find gt.g_btree n <> None then 908 + raise 909 + (Unique_violation 910 + (Fmt.str "INTEGER PRIMARY KEY (rowid %Ld)" n)); 906 911 if Int64.add n 1L > !next then next := Int64.add n 1L; 907 912 n 908 913 | _ ->

+263

test/test_sqlite.ml

··· 1510 1510 with Sqlite.Unique_violation _ -> ()); 1511 1511 Sqlite.close db) 1512 1512 1513 + (* ================================================================ *) 1514 + (* Non-rowid PRIMARY KEY enforcement (bug #2) *) 1515 + (* ================================================================ *) 1516 + 1517 + let test_text_primary_key_rejects_duplicates () = 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 _ -> 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 + 1540 + let test_composite_primary_key_rejects_duplicates () = 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 _ -> 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 + 1567 + let 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 _ -> 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 + 1597 + let test_transaction_rollback_named_table_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 + 1618 + let 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 _ -> 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 + 1660 + let 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 _ -> ()); 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 + 1685 + let 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 _ -> 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 + 1711 + let test_named_table_create_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 + 1730 + let 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 + 1513 1751 let suite = 1514 1752 ( "sqlite", 1515 1753 List.concat ··· 1683 1921 test_multiple_indexes_survive_close; 1684 1922 Alcotest.test_case "kv with generic survives close" `Quick 1685 1923 test_kv_table_survives_close_with_generic; 1924 + ]; 1925 + [ 1926 + Alcotest.test_case "text pk rejects dupes" `Quick 1927 + test_text_primary_key_rejects_duplicates; 1928 + Alcotest.test_case "composite pk rejects dupes" `Quick 1929 + test_composite_primary_key_rejects_duplicates; 1930 + Alcotest.test_case "text pk enforced after reopen" `Quick 1931 + test_text_primary_key_persists; 1932 + ]; 1933 + [ 1934 + Alcotest.test_case "rollback named table create" `Quick 1935 + test_transaction_rollback_named_table_create; 1936 + ]; 1937 + [ 1938 + Alcotest.test_case "dup rowid index consistency" `Quick 1939 + test_duplicate_rowid_index_consistency; 1940 + Alcotest.test_case "dup rowid delete cleanup" `Quick 1941 + test_duplicate_rowid_preserves_delete; 1942 + ]; 1943 + [ 1944 + Alcotest.test_case "create table duplicate name" `Quick 1945 + test_create_table_duplicate_name; 1946 + Alcotest.test_case "named table kv collision" `Quick 1947 + test_named_table_create_kv_collision; 1948 + Alcotest.test_case "quoted table name" `Quick test_quoted_table_name; 1686 1949 ]; 1687 1950 ] )

Configure Feed

Configure Feed