src/test.ml

   1 open Printf
   2 open OUnit
   3 open Sqlgg
   4 open Sql
   5 open Sql.Type
   6 open Stmt
   7
   8 let named s t = new_param { label = Some s; pos = (0,0) } t
   9 let param t = new_param { label = None; pos = (0,0) } t
  10
  11 let cmp_params p1 p2 =
  12   try
  13     List.for_all2 (fun p1 p2 ->
  14       p1.id.label = p2.id.label && p1.typ = p2.typ && p1.id.pos = (0,0) && snd p2.id.pos > fst p2.id.pos)
  15     p1 p2
  16   with
  17     _ -> false
  18
  19 let parse sql =
  20   match Main.parse_one (sql,[]) with
  21   | exception exn -> assert_failure @@ sprintf "failed : %s : %s" (Printexc.to_string exn) sql
  22   | None -> assert_failure @@ sprintf "Failed to parse : %s" sql
  23   | Some stmt -> stmt
  24
  25 let do_test sql ?kind schema params =
  26   let stmt = parse sql in
  27   assert_equal ~msg:"schema" ~printer:Sql.Schema.to_string schema stmt.schema;
  28   assert_equal ~msg:"params" ~cmp:cmp_params ~printer:Sql.show_params params
  29     (List.map (function Single p -> p | SingleIn _ | Choice _ | ChoiceIn _ -> assert false) stmt.vars);
  30   match kind with
  31   | Some k -> assert_equal ~msg:"kind" ~printer:[%derive.show: Stmt.kind] k stmt.kind
  32   | None -> ()
  33
  34 let tt sql ?kind schema params =
  35   let test () = do_test sql ?kind schema params in
  36   sql >:: test
  37
  38 let wrong sql =
  39   sql >:: (fun () -> ("Expected error in : " ^ sql) @? (try ignore (Main.parse_one' (sql,[])); false with _ -> true))
  40
  41 let attr ?(extra=[]) n d = make_attribute n d (Constraints.of_list extra)
  42
  43 let test = [
  44   tt "CREATE TABLE test (id INT, str TEXT, name TEXT)" [] [];
  45   tt "SELECT str FROM test WHERE id=?"
  46      [attr "str" Text]
  47      [param  Int];
  48   tt "SELECT x,y+? AS z FROM (SELECT id AS y,CONCAT(str,name) AS x FROM test WHERE id=@id*2) ORDER BY x,x+z LIMIT @lim"
  49      [attr "x" Text; attr "z" Int]
  50      [param Int; named "id" Int; named "lim" Int; ];
  51   tt "select test.name,other.name as other_name from test, test as other where test.id=other.id + @delta"
  52      [attr "name" Text; attr "other_name" Text]
  53      [named "delta" Int];
  54   tt "select test.name from test where test.id + @x = ? or test.id - @x = ?"
  55      [attr "name" Text;]
  56      [named "x" Int; param Int; named "x" Int; param Int;];
  57   tt "insert into test values"
  58      []
  59      [named "id" Int; named "str" Text; named "name" Text];
  60   tt "insert into test (str,name) values"
  61      []
  62      [named "str" Text; named "name" Text];
  63   tt "insert into test values (2,'hello' || ' world',@name)"
  64      []
  65      [named "name" Text];
  66   tt "insert or replace into test values (2,?,?)" [] [param Text; param Text;];
  67   tt "replace into test values (2,?,?)" [] [param Text; param Text;];
  68   tt "select str, case when id > @id then name when id < @id then 'qqq' else @def end as q from test"
  69     [attr "str" Text; attr "q" Text]
  70     [named "id" Int; named "id" Int; named "def" Text];
  71   wrong "insert into test values (1,2)";
  72   wrong "insert into test (str,name) values (1,'str','name')";
  73   (* check precedence of boolean and arithmetic operators *)
  74   tt "select str from test where id>=@id and id-@x<@id"
  75     [attr "str" Text;]
  76     [named "id" Int; named "x" Int; named "id" Int];
  77   tt "select 3/5"
  78     [attr "" Float;]
  79     [];
  80 ]
  81
  82 let test2 = [
  83   tt "CREATE TABLE test2 (id INT, str TEXT)" [] [];
  84   tt    "update test, (select * from test2) as x set str = x.str where test.id=x.id" [] [];
  85   tt    "update test, (select * from test2) as x set name = x.str where test.id=x.id" [] [];
  86   tt    "update test, (select * from test2) as x set test.str = x.str where test.id=x.id" [] [];
  87   wrong "update test, (select * from test2) as x set test.name = x.name where test.id=x.id";
  88   wrong "update test, (select * from test2) as x set test.str = str where test.id=x.id";
  89 ]
  90
  91 let test3 = [
  92   tt "SELECT id FROM test WHERE str IN ( SELECT str FROM test2 )" [attr "id" Int] [];
  93   "tuples" >:: (fun () -> todo "tuples");
  94   (* from http://stackoverflow.com/questions/1063866/sql-portability-gotchas/1063946#1063946 *)
  95 (*   tt "SELECT id FROM test WHERE (id, str) IN ( SELECT id, str FROM test2)" [attr "id" Int] []; *)
  96 ]
  97
  98 let test4 =
  99   let a = [attr "" Int] in
 100   [
 101   tt "CREATE TABLE test4 (x INT, y INT)" [] [];
 102   tt "select max(x) as q from test4" [attr "q" Int] [] ~kind:(Select `One);
 103   tt "select max(x) from test4" a [] ~kind:(Select `One);
 104   tt "select max(x) from test4" a [] ~kind:(Select `One);
 105   tt "select max(x+y) from test4 limit 1" a [] ~kind:(Select `One);
 106   tt "select max(y) from test4 limit 2" a [] ~kind:(Select `One);
 107   tt "select max(x,y) from test4" a [] ~kind:(Select `Nat);
 108   tt "select max(x,y) from test4" a [] ~kind:(Select `Nat);
 109   tt "select max(x,y) from test4 limit 1" a [] ~kind:(Select `Zero_one);
 110   tt "select max(x,y) from test4 limit 2" a [] ~kind:(Select `Nat);
 111   tt "select 1" a [] ~kind:(Select `One);
 112   tt "select greatest(1+2,10)" a [] ~kind:(Select `One);
 113   tt "select greatest(1+2,10) where 1 = 2" a [] ~kind:(Select `Zero_one);
 114   tt "select 1 from test4" a [] ~kind:(Select `Nat);
 115   tt "select 1+2 from test4" a [] ~kind:(Select `Nat);
 116   tt "select least(10+unix_timestamp(),random()), concat('test',upper('qqqq')) from test"
 117     [attr "" Int; attr "" Text] [] ~kind:(Select `Nat);
 118   tt "select greatest(10,x) from test4" a [] ~kind:(Select `Nat);
 119   tt "select 1+2 from test4 where x=y" a [] ~kind:(Select `Nat);
 120   tt "select max(x) as q from test4 where y = x + @n" [attr "q" Int] [named "n" Int] ~kind:(Select `One);
 121   tt "select coalesce(max(x),0) as q from test4 where y = x + @n" [attr "q" Int] [named "n" Int] ~kind:(Select `One);
 122 ]
 123
 124 let test_parsing = [
 125   tt "CREATE TABLE test5_1 (x INT NOT NULL, y INT DEFAULT -1) ENGINE=MEMORY" [] [];
 126   tt "SELECT 2+3, 2+-3, -10 FROM test5_1" [attr "" Int; attr "" Int; attr "" Int] [];
 127 ]
 128
 129 (*
 130   see MySQL 5.4 refman -- 12.2.8.1. JOIN Syntax
 131   see SQL:2008 -- 7.7 <joined table>
 132 *)
 133 let test_join_result_cols () =
 134   Tables.reset ();
 135   let ints = List.map (fun name -> attr name Int) in
 136   do_test "CREATE TABLE t1 (i INT, j INT)" [] [];
 137   do_test "CREATE TABLE t2 (k INT, j INT)" [] [];
 138   do_test "SELECT * FROM t1 JOIN t2 ON i=t1.j" (ints ["i";"j";"k";"j"]) [];
 139   do_test "SELECT * FROM t1 NATURAL JOIN t2" (ints ["j";"i";"k"]) [];
 140   do_test "SELECT * FROM t1 JOIN t2 USING (j)" (ints ["j";"i";"k"]) [];
 141 (*   NATURAL JOIN with common column in WHERE *)
 142   do_test
 143     "SELECT * FROM t1 NATURAL JOIN t2 WHERE j > @x"
 144     (ints ["j";"i";"k"])
 145     [named "x" Int];
 146 (*   NATURAL JOIN with common column qualified in WHERE *)
 147   do_test
 148     "SELECT * FROM t1 NATURAL JOIN t2 WHERE t2.j > @x"
 149     (ints ["j";"i";"k"])
 150     [named "x" Int];
 151   ()
 152
 153 let test_misc () =
 154   let test =
 155     let printer = [%derive.show: int list] in
 156     fun x y z -> assert_equal ~printer (Schema.natural_ x y) z
 157   in
 158   test [1;2;3;4] [1;2;5;6] [1;2;3;4;5;6];
 159   test [1;2;3;4] [4;3;2;1] [1;2;3;4];
 160   test [1;2;3;4] [5;4;3;7;5;7] [3;4;1;2;5;7;5;7];
 161   test [1;2;3;4] [5;2;2] [2;1;3;4;5]; (* ?! *)
 162   ()
 163
 164 let test_enum = [
 165   tt "CREATE TABLE test6 (x enum('true','false') COLLATE utf8_bin NOT NULL, y INT DEFAULT 0) ENGINE=MyISAM DEFAULT CHARSET=utf8" [] [];
 166   tt "SELECT * FROM test6" [attr "x" Text ~extra:[NotNull]; attr "y" Int] [];
 167   tt "SELECT x, y+10 FROM test6" [attr "x" Text ~extra:[NotNull]; attr "" Int] [];
 168 ]
 169
 170 let run () =
 171   Gen.params_mode := Some Named;
 172   let tests =
 173   [
 174     "simple" >::: test;
 175     "multi-table UPDATE" >::: test2;
 176     "gotchas" >::: test3;
 177     "single-row SELECT" >::: test4;
 178     "parsing" >::: test_parsing;
 179     "JOIN result columns" >:: test_join_result_cols;
 180     "misc" >:: test_misc;
 181     "enum" >::: test_enum;
 182   ]
 183   in
 184   let test_suite = "main" >::: tests in
 185   let results = run_test_tt test_suite in
 186   exit @@ if List.exists (function RFailure _ | RError _ -> true | _ -> false) results then 1 else 0