Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
14 kB · 326 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327(*--------------------------------------------------------------------------- Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
module Ast = Sql.Ast
let parse sql = match Sql.Lexer.parse_statements sql with | Ok stmts -> stmts | Error e -> Fmt.failwith "parse error in %S: %s" sql e
let test_desc_is_a_column_reference () = let col q name sql = match parse sql with | [ Ast.Select { cols = [ { expr; _ } ]; _ } ] -> Alcotest.(check bool) sql true (Ast.equal_expr expr (Ast.Col (q, name))) | _ -> Alcotest.failf "not a single-column SELECT: %s" sql in col None "desc" "SELECT desc FROM t"; col (Some "t") "desc" "SELECT t.desc FROM t"; col None "desc" "SELECT desc FROM pragma_index_xinfo('i')"; (* the direction still parses after the name, and after the name alone *) let direction sql expected = match parse sql with | [ Ast.Select { order_by = [ (key, dir) ]; _ } ] -> Alcotest.(check bool) (sql ^ ": key") true (Ast.equal_expr key (Ast.Col (None, "desc"))); Alcotest.(check bool) sql expected (dir = Ast.Desc) | _ -> Alcotest.failf "not a one-key ORDER BY: %s" sql in direction "SELECT desc FROM t ORDER BY desc" false; direction "SELECT desc FROM t ORDER BY desc DESC" true
(* [sql] does not parse, as it does not parse in sqlite3. *)let refuses sql = match Sql.Lexer.parse_statements sql with | Error _ -> () | Ok _ -> Alcotest.failf "%S parsed; expected a syntax error" sql
let test_a_pragma_value_is_a_bare_keyword () = let takes sql word = match parse sql with | [ Ast.Pragma { value = Some v; _ } ] -> Alcotest.(check bool) sql true (Catalog.Value.equal v (Catalog.Value.Text word)) | _ -> Alcotest.failf "not a PRAGMA with a value: %s" sql in takes "PRAGMA journal_mode=delete" "delete"; takes "PRAGMA journal_mode(delete)" "delete"; takes "PRAGMA temp_store=default" "default"; takes "PRAGMA synchronous=full" "full"; takes "PRAGMA locking_mode=exclusive" "exclusive"; takes "PRAGMA journal_mode=row" "row"; takes "PRAGMA journal_mode=cast" "cast"; takes "PRAGMA journal_mode=unbounded" "unbounded"; takes "PRAGMA journal_mode=column" "column"; takes "PRAGMA journal_mode=current_timestamp" "current_timestamp"; (* the words already taken, which stay taken *) takes "PRAGMA journal_mode=wal" "wal"; takes "PRAGMA foreign_keys=on" "on"; refuses "PRAGMA journal_mode=select"; refuses "PRAGMA journal_mode=from"; refuses "PRAGMA journal_mode=not"
let test_a_pragma_value_is_a_signed_number () = let takes sql v = match parse sql with | [ Ast.Pragma { value = Some got; _ } ] -> Alcotest.(check bool) sql true (Catalog.Value.equal got v) | _ -> Alcotest.failf "not a PRAGMA with a value: %s" sql in takes "PRAGMA journal_mode=-1" (Catalog.Value.Int (-1L)); takes "PRAGMA cache_size=-2000" (Catalog.Value.Int (-2000L)); takes "PRAGMA cache_size(-2000)" (Catalog.Value.Int (-2000L)); takes "PRAGMA cache_size=+2000" (Catalog.Value.Int 2000L); takes "PRAGMA journal_mode=-1.5" (Catalog.Value.Float (-1.5)); (* the unsigned forms already taken, which stay taken *) takes "PRAGMA journal_mode=1" (Catalog.Value.Int 1L); takes "PRAGMA journal_mode='wal'" (Catalog.Value.Text "wal"); (* NULL and a blob are no PRAGMA value *) refuses "PRAGMA journal_mode=NULL"; refuses "PRAGMA journal_mode=null"; refuses "PRAGMA journal_mode=x'00'"; refuses "PRAGMA journal_mode=X'00'"; refuses "PRAGMA journal_mode(NULL)"; refuses "PRAGMA journal_mode(x'00')"; (* and the sign is a number's, not the position's *) refuses "PRAGMA journal_mode=-wal"; refuses "PRAGMA journal_mode=-'wal'"
let test_a_bare_default_is_a_string () = let default sql expected = match parse sql with | [ Ast.Create_table { defaults = [ (col, e) ]; _ } ] -> Alcotest.(check string) (sql ^ ": column") "b" col; Alcotest.(check bool) sql true (Ast.equal_expr e expected) | _ -> Alcotest.failf "not a CREATE TABLE with one default: %s" sql in let text s = Ast.Lit (Catalog.Value.Text s) in default "CREATE TABLE t(a, b DEFAULT c)" (text "c"); default "CREATE TABLE t(a, b DEFAULT asc)" (text "asc"); default "CREATE TABLE t(a, b DEFAULT unbounded)" (text "unbounded"); default "CREATE TABLE t(a, b DEFAULT cast)" (text "cast"); default "CREATE TABLE t(a, b DEFAULT row)" (text "row"); (* the clause is still read left to right, so what follows it is the column's own, not part of the default *) default "CREATE TABLE t(a, b TEXT DEFAULT c NOT NULL)" (text "c"); (* a literal still wins where one is written: NULL is a [term] *) default "CREATE TABLE t(a, b DEFAULT null)" (Ast.Lit Catalog.Value.Null); default "CREATE TABLE t(a, b DEFAULT 'c')" (text "c"); refuses "CREATE TABLE t(a, b DEFAULT select)"; (* and ADD COLUMN takes the same clause *) match parse "ALTER TABLE t ADD COLUMN d DEFAULT e" with | [ Ast.Alter_table { op = Add_column { column = { col_default = Some e; _ }; _ }; _ }; ] -> Alcotest.(check bool) "ADD COLUMN" true (Ast.equal_expr e (text "e")) | _ -> Alcotest.fail "not an ADD COLUMN with a default"
let test_a_keyword_names_a_written_column () = let assigns sql cols = match parse sql with | [ Ast.Update { sets; _ } ] -> Alcotest.(check (list string)) sql cols (List.map fst sets) | _ -> Alcotest.failf "not an UPDATE: %s" sql in let inserts sql cols = match parse sql with | [ Ast.Insert { columns; _ } ] -> Alcotest.(check (list string)) sql cols columns | _ -> Alcotest.failf "not an INSERT: %s" sql in List.iter (fun w -> assigns (Fmt.str "UPDATE t SET %s = 1" w) [ w ]; inserts (Fmt.str "INSERT INTO t(%s) VALUES(1)" w) [ w ]) [ "row"; "rows"; "desc"; "asc"; "key"; "cast"; "unbounded"; "column"; "action"; "current_timestamp"; "with"; "replace"; ]; assigns "UPDATE t SET row = 1, desc = 2" [ "row"; "desc" ]; inserts "INSERT INTO t(row, desc) VALUES(1, 2)" [ "row"; "desc" ]; (* the upsert names the same two positions *) (match parse "INSERT INTO t(row) VALUES(1) ON CONFLICT(row) DO UPDATE SET row = 2" with | [ Ast.Insert { upsert = Some { target; action = Update (sets, _); _ }; _ } ] -> Alcotest.(check (list string)) "conflict target" [ "row" ] target; Alcotest.(check (list string)) "upsert assignment" [ "row" ] (List.map fst sets) | _ -> Alcotest.fail "not an INSERT with a DO UPDATE upsert"); (* and so does a foreign key's column list *) (match parse "CREATE TABLE t(a, FOREIGN KEY(row) REFERENCES u(row))" with | [ Ast.Create_table { foreign_keys = [ fk ]; _ } ] -> Alcotest.(check (list string)) "child columns" [ "row" ] fk.cols; Alcotest.(check (list string)) "parent columns" [ "row" ] fk.parent_cols | _ -> Alcotest.fail "not a CREATE TABLE with one foreign key"); refuses "UPDATE t SET select = 1"; refuses "INSERT INTO t(select) VALUES(1)"
let test_a_keyword_names_an_object () = let created sql name = match parse sql with | [ Ast.Create_table { tbl_name; _ } ] -> Alcotest.(check string) sql name tbl_name | _ -> Alcotest.failf "not a CREATE TABLE: %s" sql in let indexed sql name table = match parse sql with | [ Ast.Create_index i ] -> Alcotest.(check string) (sql ^ ": index") name i.name; Alcotest.(check string) (sql ^ ": table") table i.table | _ -> Alcotest.failf "not a CREATE INDEX: %s" sql in let renamed sql old_name new_name = match parse sql with | [ Ast.Alter_table { op = Rename_column (o, n); _ } ] -> Alcotest.(check string) (sql ^ ": old") old_name o; Alcotest.(check string) (sql ^ ": new") new_name n | _ -> Alcotest.failf "not a RENAME COLUMN: %s" sql in let dropped sql name = match parse sql with | [ Ast.Drop { object_ = Table; name = n; if_exists = false } ] -> Alcotest.(check string) sql name n | _ -> Alcotest.failf "not a DROP TABLE: %s" sql in let triggered sql name table = match parse sql with | [ Ast.Create_trigger tg ] -> Alcotest.(check string) (sql ^ ": trigger") name tg.name; Alcotest.(check string) (sql ^ ": table") table tg.table | _ -> Alcotest.failf "not a CREATE TRIGGER: %s" sql in let inserted sql table = match parse sql with | [ Ast.Insert { table = t; _ } ] -> Alcotest.(check string) sql table t | _ -> Alcotest.failf "not an INSERT: %s" sql in let scanned sql name = match parse sql with | [ Ast.Select { from = Table tr; _ } ] -> Alcotest.(check string) sql name tr.name | _ -> Alcotest.failf "not a SELECT over one named table: %s" sql in (* parse.y's [%fallback ID] lists DEFERRED, IMMEDIATE and EXCLUSIVE: the transaction types BEGIN takes name objects too *) List.iter (fun w -> created (Fmt.str "CREATE TABLE %s(a)" w) w; indexed (Fmt.str "CREATE INDEX %s ON t(a)" w) w "t"; indexed (Fmt.str "CREATE INDEX i ON %s(a)" w) "i" w; renamed (Fmt.str "ALTER TABLE t RENAME COLUMN a TO %s" w) "a" w; dropped (Fmt.str "DROP TABLE %s" w) w; triggered (Fmt.str "CREATE TRIGGER %s AFTER INSERT ON t BEGIN SELECT 1; END" w) w "t"; inserted (Fmt.str "INSERT INTO %s VALUES (1)" w) w; scanned (Fmt.str "SELECT * FROM %s" w) w) [ "row"; "after"; "replace"; "deferred"; "immediate"; "exclusive" ]; (* the table a trigger guards is the same position, and so is a rename's target: an object created under the word is reachable under it *) triggered "CREATE TRIGGER g AFTER INSERT ON row BEGIN SELECT 1; END" "g" "row"; (match parse "ALTER TABLE row RENAME TO after" with | [ Ast.Alter_table { table; op = Rename_table n } ] -> Alcotest.(check string) "ALTER TABLE: table" "row" table; Alcotest.(check string) "RENAME TO: new name" "after" n | _ -> Alcotest.fail "not an ALTER TABLE ... RENAME TO"); (* a reserved word names no object, here as there *) refuses "CREATE TABLE select(a)"; refuses "CREATE TABLE from(a)"; refuses "CREATE INDEX select ON t(a)"; refuses "SELECT * FROM select"
(* lang_transaction.html: [BEGIN [DEFERRED | IMMEDIATE | EXCLUSIVE] [TRANSACTION]]; parse.y, [cmd ::= BEGIN transtype trans_opt]. Each form is one statement, and keywords are case-insensitive (lang_keywords.html). *)let test_begin_takes_a_transaction_type () = let one sql = match parse sql with | [ _ ] -> () | _ -> Alcotest.failf "not one statement: %s" sql in List.iter (fun ty -> List.iter one [ Fmt.str "BEGIN %s" ty; Fmt.str "BEGIN %s TRANSACTION" ty; Fmt.str "begin %s" (String.lowercase_ascii ty); Fmt.str "begin %s transaction" (String.lowercase_ascii ty); ]) [ "DEFERRED"; "IMMEDIATE"; "EXCLUSIVE" ]; List.iter one [ "BEGIN"; "BEGIN TRANSACTION"; "begin"; "begin transaction" ]
(* parse.y: [transtype] is one optional token of DEFERRED, IMMEDIATE and EXCLUSIVE; sqlite3 refuses any other word there, and two of them. *)let test_begin_refuses_another_transaction_type () = refuses "BEGIN SOON"; refuses "begin soon"; refuses "BEGIN SOON TRANSACTION"; refuses "BEGIN DEFERRED IMMEDIATE"; refuses "BEGIN IMMEDIATE EXCLUSIVE TRANSACTION"
(* parse.y: [transtype ::= .] is [TK_DEFERRED], and each of DEFERRED, IMMEDIATE and EXCLUSIVE is its own [transtype]: three statements, and a plain BEGIN is BEGIN DEFERRED. *)let test_begin_names_its_transaction_type () = let begins sql = match parse sql with | [ Ast.Begin Ast.Deferred ] -> "DEFERRED" | [ Ast.Begin Ast.Immediate ] -> "IMMEDIATE" | [ Ast.Begin Ast.Exclusive ] -> "EXCLUSIVE" | _ -> Alcotest.failf "not one BEGIN: %s" sql in let is expected sql = Alcotest.(check string) sql expected (begins sql) in List.iter (is "DEFERRED") [ "BEGIN"; "BEGIN TRANSACTION"; "BEGIN DEFERRED"; "BEGIN DEFERRED TRANSACTION"; "begin deferred"; ]; List.iter (is "IMMEDIATE") [ "BEGIN IMMEDIATE"; "BEGIN IMMEDIATE TRANSACTION"; "begin immediate" ]; List.iter (is "EXCLUSIVE") [ "BEGIN EXCLUSIVE"; "BEGIN EXCLUSIVE TRANSACTION"; "begin exclusive" ]
let suite = ( "parser", [ Alcotest.test_case "desc is a column reference" `Quick test_desc_is_a_column_reference; Alcotest.test_case "a PRAGMA value is a bare keyword" `Quick test_a_pragma_value_is_a_bare_keyword; Alcotest.test_case "a PRAGMA value is a signed number" `Quick test_a_pragma_value_is_a_signed_number; Alcotest.test_case "a bare DEFAULT word is a string" `Quick test_a_bare_default_is_a_string; Alcotest.test_case "a keyword names a written column" `Quick test_a_keyword_names_a_written_column; Alcotest.test_case "a keyword names an object" `Quick test_a_keyword_names_an_object; Alcotest.test_case "BEGIN takes a transaction type" `Quick test_begin_takes_a_transaction_type; Alcotest.test_case "BEGIN refuses another transaction type" `Quick test_begin_refuses_another_transaction_type; Alcotest.test_case "BEGIN names its transaction type" `Quick test_begin_names_its_transaction_type; ] )