Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
13 kB · 320 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321(*--------------------------------------------------------------------------- Copyright (c) 2025 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
(** Tests for {!Sql.Render}: rendering the query AST back to SQL text. Expression rendering is fully parenthesised, and rendering a parsed SELECT is stable under a re-parse. *)
module R = Sql.Rendermodule A = Sql.Ast
let select sql = match Sql.Lexer.parse_statements sql with | Ok [ A.Select s ] -> s | Ok _ -> Fmt.failwith "not a single SELECT: %s" sql | Error e -> Fmt.failwith "parse error: %s" e
let test_expr () = Alcotest.(check string) "arithmetic is fully parenthesised" "(1 + 2)" (R.expr (A.Binary (A.Add, A.Lit (A.Int 1L), A.Lit (A.Int 2L)))); Alcotest.(check string) "a text literal is single-quoted" "'hi'" (R.expr (A.Lit (A.Text "hi"))); Alcotest.(check string) "a qualified column" "t.c" (R.expr (A.Col (Some "t", "c"))); Alcotest.(check string) "IS NULL" "(x IS NULL)" (R.expr (A.Is_null (A.Col (None, "x"))))
let test_expr_signs () = Alcotest.(check string) "unary minus is a minus, not a subtraction from zero" "-1" (R.expr (A.negate (A.Lit (A.Int 1L)))); Alcotest.(check string) "unary plus is a plus" "+5" (R.expr (A.Unary_plus (A.Lit (A.Int 5L)))); Alcotest.(check string) "a minus over a compound operand keeps the operand's own parentheses" "-(1 + 2)" (R.expr (A.negate (A.Binary (A.Add, A.Lit (A.Int 1L), A.Lit (A.Int 2L))))); Alcotest.(check string) "two minuses do not open a comment" "- -1" (R.expr (A.negate (A.negate (A.Lit (A.Int 1L))))); Alcotest.(check string) "nor does a minus over a negative literal" "- -1" (R.expr (A.negate (A.Lit (A.Int (-1L))))); (* what the elision must not cost: the text still parses to what it rendered *) let reparsed sql = match Fmt.kstr select "SELECT %s" sql with | { A.cols = [ { A.expr = e; _ } ]; _ } -> e | _ -> Alcotest.failf "%s: not a one-column SELECT" sql in List.iter (fun e -> let text = R.expr e in Alcotest.(check bool) (Fmt.str "%s re-parses to itself" text) true (A.equal_expr e (reparsed text))) [ A.negate (A.Lit (A.Int 1L)); A.Unary_plus (A.Lit (A.Int 5L)); A.negate (A.negate (A.Lit (A.Int 1L))); A.negate (A.Binary (A.Add, A.Lit (A.Int 1L), A.Lit (A.Int 2L))); ]
let test_select_roundtrip () = (* Rendering a parsed SELECT yields SQL that re-parses to the same AST, so a second render is byte-identical. *) let sql = "SELECT a, b FROM t WHERE a = 1 ORDER BY b" in let r1 = R.select (select sql) in let r2 = R.select (select r1) in Alcotest.(check string) "render is stable under re-parse" r1 r2
(* The expression a rendered one-column SELECT projects. *)let projected sql = match Fmt.kstr select "SELECT %s" sql with | { A.cols = [ { A.expr = e; _ } ]; _ } -> e | _ -> Alcotest.failf "%s: not a one-column SELECT" sql
let test_float_literal_reparses () = (* The double the rendered text denotes. A sign is an operator and not part of the literal ({!test_expr_signs} pins that spelling), so a negative double comes back as a minus over its magnitude. *) let denotes text = match projected text with | A.Lit (A.Float f) -> f | A.Unary_minus (A.Lit (A.Float f)) -> -.f | e -> Alcotest.failf "%s re-parsed as %s, which is not a REAL" text (R.expr e) in let same f = let text = R.expr (A.Lit (A.Float f)) in Alcotest.(check string) (Fmt.str "%h renders as %s, which reads back as itself" f text) (Fmt.str "%h" f) (Fmt.str "%h" (denotes text)) in List.iter same [ 0.1; 1.0; -0.5; 3.141592653589793; 1.0000000000000002; 1e308; 4.9406564584124654e-324; Float.infinity; Float.neg_infinity; ]; Alcotest.(check string) "an infinity is spelled as sqlite3's own literal for one" "9.0e+999" (R.expr (A.Lit (A.Float Float.infinity))); Alcotest.(check string) "and so is a negative one" "-9.0e+999" (R.expr (A.Lit (A.Float Float.neg_infinity)))
let test_param_keeps_its_number () = Alcotest.(check string) "the first parameter is ?1" "?1" (R.expr (A.Param 0)); Alcotest.(check string) "and the third is ?3" "?3" (R.expr (A.Param 2)); (* the round trip: two placeholders read in the reverse of the order they are written still read in that order after a render *) let numbered sql = match Sql.Lexer.parse_statements sql with | Ok [ s ] -> ( match Sql.Param_number.number_params s with | A.Select s -> s | _ -> Alcotest.failf "%s: not a SELECT" sql) | Ok _ -> Alcotest.failf "%s: not a single statement" sql | Error e -> Alcotest.failf "%s: %s" sql e in let indices (s : A.select) = List.map (fun (c : A.result_col) -> match c.A.expr with A.Param i -> i | _ -> -1) s.A.cols in let s = numbered "SELECT ?, ?" in Alcotest.(check (list int)) "the parser numbers them in source order" [ 0; 1 ] (indices s); let swapped = { s with A.cols = List.rev s.A.cols } in Alcotest.(check (list int)) "and a render keeps the numbers the swap gave them" [ 1; 0 ] (indices (numbered (R.select swapped)))
let test_default_clause_reparses () = let declared e = let sql = Fmt.str "CREATE TABLE t (a INT, b DEFAULT %s)" (R.default_clause e) in match Sql.Lexer.parse_statements sql with | Ok [ A.Create_table { defaults = [ ("b", d) ]; _ } ] -> d | Ok _ -> Alcotest.failf "%s: not a CREATE TABLE declaring one default" sql | Error msg -> Alcotest.failf "%s: %s" sql msg in let same name e = Alcotest.(check bool) name true (A.equal_expr e (declared e)) in same "a literal" (A.Lit (A.Int 5L)); same "a negative literal" (A.Lit (A.Int (-5L))); same "a text literal" (A.Lit (A.Text "it's")); same "a blob" (A.Lit (A.Blob "\xff")); same "NULL" (A.Lit A.Null); same "an integer no int64 holds" (A.Big_int "9223372036854775808"); same "CURRENT_TIMESTAMP" (A.Func ("current_timestamp", [])); same "CURRENT_DATE" (A.Func ("current_date", [])); same "CURRENT_TIME" (A.Func ("current_time", [])); same "arithmetic" (A.Binary (A.Add, A.Lit (A.Int 1L), A.Lit (A.Int 2L))); same "a call" (A.Func ("abs", [ A.Lit (A.Int 5L) ])); same "a CAST" (A.Cast (A.Lit (A.Int 5L), "TEXT")); same "a COLLATE" (A.Collate (A.Lit (A.Text "x"), "NOCASE")); same "a CASE" (A.Case (None, [ (A.Lit (A.Int 1L), A.Lit (A.Int 2L)) ], Some (A.Lit A.Null))); same "an explicit plus" (A.Unary_plus (A.Lit (A.Int 5L))); same "an explicit minus" (A.negate (A.Lit (A.Int 5L))); Alcotest.(check string) "a minus keeps its parentheses after DEFAULT" "(-5)" (R.default_clause (A.negate (A.Lit (A.Int 5L)))); Alcotest.(check string) "and so does a plus" "(+6)" (R.default_clause (A.Unary_plus (A.Lit (A.Int 6L)))); (* the two spellings the grammar takes bare are written bare, since a parenthesis around them would be text no reader asked for *) Alcotest.(check string) "a literal stands bare" "5" (R.default_clause (A.Lit (A.Int 5L))); Alcotest.(check string) "and so does the keyword" "CURRENT_TIMESTAMP" (R.default_clause (A.Func ("current_timestamp", []))); Alcotest.(check string) "a call is parenthesised" "(abs(5))" (R.default_clause (A.Func ("abs", [ A.Lit (A.Int 5L) ])))
let test_window_frame_reparses () = (* the AST round trip: each frame shape the AST spells, rendered and read again *) let roundtrips sql = let e = projected sql in let text = R.expr e in Alcotest.(check bool) (Fmt.str "%s renders as %s, which re-parses to itself" sql text) true (A.equal_expr e (projected text)) in List.iter roundtrips [ "sum(a) OVER (ORDER BY a ROWS BETWEEN 1 PRECEDING AND CURRENT ROW)"; "sum(a) OVER (ORDER BY a ROWS BETWEEN UNBOUNDED PRECEDING AND 1 \ FOLLOWING)"; "sum(a) OVER (ORDER BY a ROWS BETWEEN CURRENT ROW AND UNBOUNDED \ FOLLOWING)"; "sum(a) OVER (ORDER BY a RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT \ ROW)"; "sum(a) OVER (ORDER BY a RANGE UNBOUNDED PRECEDING)"; "sum(a) OVER (PARTITION BY b ORDER BY a ROWS BETWEEN 1 PRECEDING AND 1 \ FOLLOWING)"; "sum(a) OVER (ROWS BETWEEN 1 PRECEDING AND CURRENT ROW)"; ]; (* and the answer: the same query, run over the reference store as written and as rendered, against the oracle above *) let cat = Catalog.of_mem [] in ignore (Sql.Engine.exec cat "CREATE TABLE w (a INTEGER)"); ignore (Sql.Engine.exec cat "INSERT INTO w VALUES (1), (2), (3), (4)"); let sums sql = match Sql.Engine.exec cat sql with | Sql.Engine.Rows rs -> List.map (function | [ _; Catalog.Value.Int n ] -> Int64.to_int n | r -> Alcotest.failf "%s: unexpected row %a" sql (Fmt.Dump.list Catalog.Value.pp) r) rs | Sql.Engine.Done -> Alcotest.failf "%s: no rows" sql in let answers name expected over = let source = Fmt.str "SELECT a, sum(a) OVER (%s) FROM w ORDER BY a" over in Alcotest.(check (list int)) (name ^ ", as written") expected (sums source); Alcotest.(check (list int)) (name ^ ", as rendered") expected (sums (R.select (select source))) in answers "the default frame" [ 1; 3; 6; 10 ] "ORDER BY a"; answers "one row back" [ 1; 3; 5; 7 ] "ORDER BY a ROWS BETWEEN 1 PRECEDING AND CURRENT ROW"; answers "one row either side" [ 3; 6; 9; 7 ] "ORDER BY a ROWS BETWEEN 1 PRECEDING AND 1 FOLLOWING"; answers "the rest of the partition" [ 10; 9; 7; 4 ] "ORDER BY a ROWS BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING"; answers "and the same by peer" [ 10; 9; 7; 4 ] "ORDER BY a RANGE BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING"
let test_ident_has_no_nul () = Alcotest.(check string) "a name needing quotes is quoted" "\"a b\"" (R.ident "a b"); Alcotest.(check string) "a quote in a name is doubled" "\"a\"\"b\"" (R.ident "a\"b"); let refused = Invalid_argument "Render.ident: SQL text ends at a 0x00, so a name cannot hold one" in Alcotest.check_raises "a 0x00 inside a name" refused (fun () -> ignore (R.ident "a\000b")); Alcotest.check_raises "a 0x00 ending a name" refused (fun () -> ignore (R.ident "ab\000")); (* every name in a statement is written by that one renderer, so a table's goes the same way *) let s = select "SELECT a FROM t" in let from : A.from_clause = A.Table { A.name = "t\000x"; alias = None; subquery = None } in Alcotest.check_raises "a table name in a rendered SELECT" refused (fun () -> ignore (R.select { s with A.from })); (* and a column alias, which the parser reads from a quoted identifier *) Alcotest.check_raises "an alias in a rendered SELECT" refused (fun () -> ignore (R.select (select "SELECT a AS \"b\000c\" FROM t")))
let test_collate_and_cast_names_are_names () = let reparses sql = let e = projected sql in let text = R.expr e in Alcotest.(check bool) (Fmt.str "%s re-parses to itself" text) true (A.equal_expr e (projected text)) in reparses "x COLLATE BINARY"; reparses "x COLLATE \"a b\""; reparses "CAST(x AS TEXT)"; reparses "CAST(x AS \"a b\")"; let refused = Invalid_argument "Render.ident: SQL text ends at a 0x00, so a name cannot hold one" in Alcotest.check_raises "a 0x00 in a collation name" refused (fun () -> ignore (R.expr (A.Collate (A.Col (None, "x"), "a\000b")))); Alcotest.check_raises "a 0x00 in a type name" refused (fun () -> ignore (R.expr (A.Cast (A.Col (None, "x"), "a\000b"))))
let suite = ( "render", [ Alcotest.test_case "expression rendering" `Quick test_expr; Alcotest.test_case "a sign renders as a sign" `Quick test_expr_signs; Alcotest.test_case "select render is stable" `Quick test_select_roundtrip; Alcotest.test_case "a rendered REAL re-parses" `Quick test_float_literal_reparses; Alcotest.test_case "a parameter keeps its number" `Quick test_param_keeps_its_number; Alcotest.test_case "a rendered DEFAULT re-parses" `Quick test_default_clause_reparses; Alcotest.test_case "a rendered window keeps its frame" `Quick test_window_frame_reparses; Alcotest.test_case "a name holds no 0x00" `Quick test_ident_has_no_nul; Alcotest.test_case "a collation and a type name are names" `Quick test_collate_and_cast_names_are_names; ] )