Fix bottler: skip git pull on empty tap repos · gazagnaire.org/ocaml-sqlite@e35845f

+380 -5

2 changed files

expand all

lib

sqlite.ml

test

test_sqlite.ml

+69 -5

lib/sqlite.ml

··· 58 58 mutable g_unique_indexes : unique_index list; 59 59 } 60 60 61 + (* Raw sqlite_master entry for schema objects we don't manage (views, 62 + triggers, explicit indexes). Preserved across open/close. *) 63 + type raw_master_entry = { 64 + rm_type : string; 65 + rm_name : string; 66 + rm_tbl_name : string; 67 + rm_root_page : int; 68 + rm_sql : Btree.Record.value; 69 + } 70 + 61 71 type t = { 62 72 pager : Btree.Pager.t; 63 73 file : Eio.File.rw_ty Eio.Resource.t option; ··· 66 76 mutable data : kv_table option; 67 77 mutable named_tables : (string * kv_table) list; 68 78 mutable all_tables : generic_table list; 79 + mutable extra_master : raw_master_entry list; 69 80 insert_rowids : (string, int64 ref) Hashtbl.t; 70 81 } 71 82 ··· 302 313 let rowid_varint = Btree.Varint.encode rowid in 303 314 payload_varint ^ rowid_varint ^ record 304 315 305 - (* Collect all sqlite_master entries: tables then indexes *) 316 + (* Collect all sqlite_master entries: tables, autoindexes, then extras *) 306 317 let master_entries t = 307 318 let entries = ref [] in 308 319 let rowid = ref 1 in ··· 330 341 incr rowid) 331 342 gt.g_unique_indexes) 332 343 t.all_tables; 344 + (* Preserve explicit indexes, views, triggers *) 345 + List.iter 346 + (fun rm -> 347 + entries := 348 + ( !rowid, 349 + rm.rm_name, 350 + rm.rm_tbl_name, 351 + rm.rm_root_page, 352 + rm.rm_sql, 353 + rm.rm_type ) 354 + :: !entries; 355 + incr rowid) 356 + t.extra_master; 333 357 List.rev !entries 334 358 335 359 (* Write page 1: db header + sqlite_master leaf table *) ··· 401 425 data = Some kv; 402 426 named_tables = []; 403 427 all_tables = [ gt ]; 428 + extra_master = []; 404 429 insert_rowids = Hashtbl.create 8; 405 430 } 406 431 in ··· 441 466 data = Some kv; 442 467 named_tables = []; 443 468 all_tables = [ gt ]; 469 + extra_master = []; 444 470 insert_rowids = Hashtbl.create 8; 445 471 } 446 472 in 447 473 rebuild_page1 t; 448 474 t 449 475 450 - (* Parse sqlite_master into raw table and index entries *) 476 + (* Parse sqlite_master into raw table, index, and other entries *) 451 477 let read_master page1 = 452 478 let header = Btree.Page.parse_header page1 100 in 453 479 let ptrs = Btree.Page.cell_pointers page1 100 header in 454 480 let raw_tables = ref [] in 455 481 let raw_indexes = ref [] in 482 + let raw_extra = ref [] in 456 483 for i = 0 to header.Btree.Page.cell_count - 1 do 457 484 let cell, _ = 458 485 Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size ··· 471 498 Btree.Record.Vtext idx_name; 472 499 Btree.Record.Vtext tbl_name; 473 500 Btree.Record.Vint root; 474 - _; 501 + Btree.Record.Vtext idx_sql; 502 + ] -> 503 + if String.starts_with ~prefix:"sqlite_autoindex_" idx_name then 504 + raw_indexes := (idx_name, tbl_name, Int64.to_int root) :: !raw_indexes 505 + else 506 + raw_extra := 507 + { 508 + rm_type = "index"; 509 + rm_name = idx_name; 510 + rm_tbl_name = tbl_name; 511 + rm_root_page = Int64.to_int root; 512 + rm_sql = Btree.Record.Vtext idx_sql; 513 + } 514 + :: !raw_extra 515 + | [ 516 + Btree.Record.Vtext "index"; 517 + Btree.Record.Vtext idx_name; 518 + Btree.Record.Vtext tbl_name; 519 + Btree.Record.Vint root; 520 + Btree.Record.Vnull; 475 521 ] -> 476 522 raw_indexes := (idx_name, tbl_name, Int64.to_int root) :: !raw_indexes 523 + | [ 524 + Btree.Record.Vtext type_; 525 + Btree.Record.Vtext name; 526 + Btree.Record.Vtext tbl_name; 527 + Btree.Record.Vint root; 528 + sql; 529 + ] 530 + when type_ = "view" || type_ = "trigger" -> 531 + raw_extra := 532 + { 533 + rm_type = type_; 534 + rm_name = name; 535 + rm_tbl_name = tbl_name; 536 + rm_root_page = Int64.to_int root; 537 + rm_sql = sql; 538 + } 539 + :: !raw_extra 477 540 | _ -> () 478 541 done; 479 - (List.rev !raw_tables, List.rev !raw_indexes) 542 + (List.rev !raw_tables, List.rev !raw_indexes, List.rev !raw_extra) 480 543 481 544 (* Reconnect or create unique indexes for a table *) 482 545 let open_unique_indexes pager ~btree ~schema ~constraints ~raw_indexes = ··· 532 595 if String.sub page1 0 16 <> magic then failwith "Not a SQLite database"; 533 596 let ps = Btree.Page.u16_be page1 16 in 534 597 if ps <> page_size then Fmt.failwith "Unsupported page size: %d" ps; 535 - let raw_tables, raw_indexes = read_master page1 in 598 + let raw_tables, raw_indexes, raw_extra = read_master page1 in 536 599 let all_tables = 537 600 List.map 538 601 (fun (name, root, sql) -> ··· 564 627 data; 565 628 named_tables = named; 566 629 all_tables; 630 + extra_master = raw_extra; 567 631 insert_rowids = Hashtbl.create 8; 568 632 } 569 633 with Eio.Io _ when create -> init ~sw path

+311

test/test_sqlite.ml

··· 1229 1229 Alcotest.(check (option string)) 1230 1230 "a original" (Some "original") (Sqlite.find db "a") 1231 1231 1232 + (* ================================================================ *) 1233 + (* Non-rowid primary keys *) 1234 + (* ================================================================ *) 1235 + 1236 + let test_text_primary_key_not_rowid_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 + 1263 + let 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 + 1287 + let test_real_primary_key_not_rowid_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 + 1307 + let 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 + 1325 + let 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 + 1342 + let 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 + 1370 + let 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 _ -> 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 + 1396 + let 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 + 1414 + let 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 + 1445 + let 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 + 1481 + let test_kv_table_survives_close_with_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 + 1232 1513 let suite = 1233 1514 ( "sqlite", 1234 1515 List.concat ··· 1372 1653 test_transaction_rollback_unique; 1373 1654 Alcotest.test_case "transaction nested failure" `Quick 1374 1655 test_transaction_nested_failure; 1656 + ]; 1657 + [ 1658 + Alcotest.test_case "text pk not rowid alias" `Quick 1659 + test_text_primary_key_not_rowid_alias; 1660 + Alcotest.test_case "text pk persistence" `Quick 1661 + test_text_primary_key_persistence; 1662 + Alcotest.test_case "real pk not rowid alias" `Quick 1663 + test_real_primary_key_not_rowid_alias; 1664 + ]; 1665 + [ 1666 + Alcotest.test_case "rollback create table" `Quick 1667 + test_transaction_rollback_create_table; 1668 + Alcotest.test_case "rollback insert generic" `Quick 1669 + test_transaction_rollback_insert_generic; 1670 + Alcotest.test_case "rollback schema persistence" `Quick 1671 + test_transaction_rollback_schema_persistence; 1672 + ]; 1673 + [ 1674 + Alcotest.test_case "duplicate explicit rowid" `Quick 1675 + test_duplicate_explicit_rowid; 1676 + Alcotest.test_case "explicit rowid next auto" `Quick 1677 + test_explicit_rowid_next_auto; 1678 + ]; 1679 + [ 1680 + Alcotest.test_case "unique index survives close" `Quick 1681 + test_unique_index_survives_close; 1682 + Alcotest.test_case "multi index survives close" `Quick 1683 + test_multiple_indexes_survive_close; 1684 + Alcotest.test_case "kv with generic survives close" `Quick 1685 + test_kv_table_survives_close_with_generic; 1375 1686 ]; 1376 1687 ] )

Configure Feed

Configure Feed