test.ml

   1
   2 open OUnit
   3 open RA
   4 open Sql.Type
   5 open Stmt
   6 open ListMore
   7
   8 let named s = (Some s,(0,0))
   9 let param = (None,(0,0))
  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 tt ?msg stmt schema params =
  20   let print_schema = RA.Schema.to_string in
  21   let print_params = Stmt.params_to_string in
  22   let (s1,p1,_) =
  23     try
  24       Parser.parse_stmt stmt
  25     with
  26     | _ -> assert_failure "tt failed"
  27   in
  28   assert_equal ?msg ~printer:print_schema schema s1;
  29   assert_equal ?msg ~cmp:cmp_params ~printer:print_params params p1
  30
  31 let test () =
  32   tt "CREATE TABLE test (id INT, str TEXT, name TEXT)"
  33      []
  34      [];
  35   tt "SELECT str FROM test WHERE id=?"
  36      [attr "str" Text]
  37      [param,Some Int];
  38   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"
  39      [attr "x" Text; attr "z" Int]
  40      [param,Some Int; named "id", Some Int; named "lim",Some Int; ];
  41   tt "select test.name,other.name as other_name from test, test as other where test.id=other.id + @delta"
  42      [attr "name" Text; attr "other_name" Text]
  43      [named "delta", Some Int];
  44   tt "select test.name from test where test.id + @x = ? or test.id - @x = ?"
  45      [attr "name" Text;]
  46      [named "x", Some Int; param, Some Int; named "x", Some Int; param, Some Int;];
  47   ()
  48
  49 (*
  50   see MySQL 5.4 refman -- 12.2.8.1. JOIN Syntax
  51   see SQL:2008 -- 7.7 <joined table>
  52 *)
  53 let test_join_result_cols () =
  54   Tables.reset ();
  55   let ints = List.map (fun name -> attr name Int) in
  56   tt "CREATE TABLE t1 (i INT, j INT)" [] [];
  57   tt "CREATE TABLE t2 (k INT, j INT)" [] [];
  58   tt "SELECT * FROM t1 JOIN t2 ON i=t1.j" (ints ["i";"j";"k";"j"]) [];
  59   tt ~msg:"NATURAL JOIN"
  60     "SELECT * FROM t1 NATURAL JOIN t2" (ints ["j";"i";"k"]) [];
  61   tt ~msg:"JOIN USING"
  62     "SELECT * FROM t1 JOIN t2 USING (j)" (ints ["j";"i";"k"]) [];
  63   tt ~msg:"NATURAL JOIN with common column in WHERE"
  64     "SELECT * FROM t1 NATURAL JOIN t2 WHERE j > @x"
  65     (ints ["j";"i";"k"])
  66     [named "x",Some Int];
  67   tt ~msg:"NATURAL JOIN with common column qualified in WHERE"
  68     "SELECT * FROM t1 NATURAL JOIN t2 WHERE t2.j > @x"
  69     (ints ["j";"i";"k"])
  70     [named "x",Some Int];
  71   ()
  72
  73 let test_misc () =
  74   let test =
  75     let printer = Show.show<int list> in
  76     fun x y z -> assert_equal ~printer (RA.Schema.natural_ x y) z
  77   in
  78   test [1;2;3;4] [1;2;5;6] [1;2;3;4;5;6];
  79   test [1;2;3;4] [4;3;2;1] [1;2;3;4];
  80   test [1;2;3;4] [5;4;3;7;5;7] [3;4;1;2;5;7;5;7];
  81   test [1;2;3;4] [5;2;2] [2;1;3;4;5]; (* ?! *)
  82   ()
  83
  84 let run () =
  85   let tests =
  86   [
  87     "simple" >:: test;
  88     "JOIN result columns" >:: test_join_result_cols;
  89     "misc" >:: test_misc;
  90   ]
  91   in
  92   let test_suite = "main" >::: tests in
  93   ignore (run_test_tt test_suite)