src/test.ml

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