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