Merge pull request #60 from paurkedal/testsuite

paurkedal · web-flow · commit aa41c4a42075 · 2024-11-13T15:48:04.000+01:00
Add testsuite
diff --git a/examples/async/dune b/examples/async/dune
@@ -1,6 +1,3 @@
-(tests
- (names
-    nonblocking_async_example
-    nonblocking_async_stress_test)
- (libraries mariadb async nonblocking_tests)
- (enabled_if %{lib-available:lwt}))
+(executable
+ (name nonblocking_async_example)
+ (libraries mariadb async))
diff --git a/examples/blocking/blocking_stress_test.ml b/examples/blocking/blocking_stress_test.ml
diff --git a/examples/blocking/dune b/examples/blocking/dune
@@ -1,5 +1,3 @@
-(tests
- (names
-    blocking_example
-    blocking_stress_test)
+(executable
+ (name blocking_example)
  (libraries mariadb))
diff --git a/examples/lwt/dune b/examples/lwt/dune
@@ -1,6 +1,3 @@
-(tests
- (names
-    nonblocking_lwt_example
-    nonblocking_lwt_stress_test)
- (libraries mariadb lwt lwt.unix nonblocking_tests)
- (enabled_if %{lib-available:lwt}))
+(executable
+ (name nonblocking_lwt_example)
+ (libraries mariadb lwt lwt.unix))
diff --git a/examples/nonblocking/dune b/examples/nonblocking/dune
diff --git a/examples/select/dune b/examples/select/dune
@@ -1,5 +1,3 @@
-(tests
- (names
-    nonblocking_select_example
-    nonblocking_select_stress_test)
- (libraries mariadb unix nonblocking_tests))
+(executable
+ (name nonblocking_select_example)
+ (libraries mariadb unix))
diff --git a/tests/README.md b/tests/README.md
@@ -0,0 +1,20 @@
+This directory contains the test suite.  The main code split up according to
+whether the tests are using the blocking or non-blocking API, and for the
+latter there are instances depending on the concurrency library:
+
+| Directory           | Description
+| ---------           | -----------
+| nonblocking         | Abstract tests suite implementation.
+| blocking            | Tests the blocking and nonblocking APIs without concurrency.
+| nonblocking-async   | Tests the nonblocking API using async.
+| nonblocking-lwt     | Tests the nonblocking API using Lwt.
+
+Tests require access to a MariaDB instance to run.  You will likely need to
+set some environment variables to point the test suite to the right place:
+
+| Environment variable | Description
+| -------------------- | -----------
+| `OCAML_MARIADB_HOST` | Host to connect to.
+| `OCAML_MARIADB_USER` | Authenticate as the given user.
+| `OCAML_MARIADB_PASS` | Authenticate with the given password.
+| `OCAML_MARIADB_DB`   | Connect to the given database.
diff --git a/tests/blocking/blocking_testsuite.ml b/tests/blocking/blocking_testsuite.ml
@@ -1,6 +1,7 @@
 module S = Mariadb.Nonblocking.Status
 
-module Test = Nonblocking_stress_test.Make (struct
+module Wait = struct
+
   module IO = struct
     type 'a future = 'a
     let (>>=) x f = f x
@@ -28,6 +29,17 @@ module Test = Nonblocking_stress_test.Make (struct
           ()
     with Unix.Unix_error (_, _, _) ->
       return @@ S.create ~timeout: true ()
-end)
 
-let () = Test.main ()
+end
+
+(* Test for the blocking API. *)
+module Test_blocking =
+  Nonblocking_testsuite.Make (Wait.IO) (Mariadb.Blocking)
+
+(* Test for the non-blocking API without concurrency. *)
+module Test_nonblocking =
+  Nonblocking_testsuite.Make (Wait.IO) (Mariadb.Nonblocking.Make (Wait))
+
+let () =
+  Test_blocking.main ();
+  Test_nonblocking.main ()
diff --git a/tests/blocking/dune b/tests/blocking/dune
@@ -0,0 +1,3 @@
+(test
+ (name blocking_testsuite)
+ (libraries mariadb nonblocking_testsuite unix))
diff --git a/tests/nonblocking-async/dune b/tests/nonblocking-async/dune
@@ -0,0 +1,4 @@
+(test
+ (name nonblocking_testsuite_async)
+ (libraries mariadb async nonblocking_testsuite)
+ (enabled_if %{lib-available:lwt}))
diff --git a/tests/nonblocking-async/nonblocking_testsuite_async.ml b/tests/nonblocking-async/nonblocking_testsuite_async.ml
@@ -4,7 +4,7 @@ open Async
 
 module S = Mariadb.Nonblocking.Status
 
-module Test = Nonblocking_stress_test.Make (struct
+module Wait = struct
 
   module IO = struct
     type 'a future = 'a Deferred.t
@@ -45,8 +45,10 @@ module Test = Nonblocking_stress_test.Make (struct
     Fd.close ~file_descriptor_handling:Fd.Do_not_close_file_descriptor fd
     >>= fun () ->
     Deferred.return @@ S.create ~read ~write ~timeout ()
+end
 
-end)
+module Test =
+  Nonblocking_testsuite.Make (Wait.IO) (Mariadb.Nonblocking.Make (Wait))
 
 let _main : unit Deferred.t = Test.main () >>= fun () -> Shutdown.exit 0
 
diff --git a/tests/nonblocking-lwt/dune b/tests/nonblocking-lwt/dune
@@ -0,0 +1,4 @@
+(test
+ (name nonblocking_testsuite_lwt)
+ (libraries mariadb lwt lwt.unix nonblocking_testsuite)
+ (enabled_if %{lib-available:lwt}))
diff --git a/tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml b/tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml
@@ -2,7 +2,7 @@ open Lwt.Infix
 
 module S = Mariadb.Nonblocking.Status
 
-module Test = Nonblocking_stress_test.Make (struct
+module Wait = struct
 
   module IO = struct
     type 'a future = 'a Lwt.t
@@ -32,6 +32,10 @@ module Test = Nonblocking_stress_test.Make (struct
       (function
        | Lwt_unix.Timeout -> Lwt.return @@ S.create ~timeout:true ()
        | e -> Lwt.fail e)
-end)
+
+end
+
+module Test =
+  Nonblocking_testsuite.Make (Wait.IO) (Mariadb.Nonblocking.Make (Wait))
 
 let () = Lwt_main.run (Test.main ())
diff --git a/tests/nonblocking/dune b/tests/nonblocking/dune
@@ -0,0 +1,3 @@
+(library
+ (name nonblocking_testsuite)
+ (libraries mariadb))
diff --git a/tests/nonblocking/nonblocking_testsuite.ml b/tests/nonblocking/nonblocking_testsuite.ml
@@ -1,8 +1,16 @@
 open Printf
 
-module Make (W : Mariadb.Nonblocking.Wait) = struct
-  module M = Mariadb.Nonblocking.Make (W)
-  open W.IO
+module type IO = sig
+  type 'a future
+  val (>>=) : 'a future -> ('a -> 'b future) -> 'b future
+  val return : 'a -> 'a future
+end
+
+module Make
+    (IO : IO)
+    (M : Mariadb.Nonblocking.S with type 'a future := 'a IO.future) =
+struct
+  open IO
 
   let (>|=) m f = m >>= fun x -> return (f x)
 
@@ -12,6 +20,14 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
     | Ok r -> return r
     | Error (i, e) -> eprintf "%s: (%d) %s\n%!" where i e; exit 2
 
+  let rec iter_s_list f = function
+    | [] -> return ()
+    | x :: xs -> f x >>= fun () -> iter_s_list f xs
+
+  let rec map_s_list f = function
+    | [] -> return []
+    | x :: xs -> f x >>= fun y -> map_s_list f xs >|= fun ys -> y :: ys
+
   let connect () =
     M.connect
       ~host:(env "OCAML_MARIADB_HOST" "localhost")
@@ -106,6 +122,71 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
       exit 2
     end
 
+  let execute_no_data stmt =
+    M.Stmt.execute stmt [||] >>= or_die "execute" >|= fun res ->
+    assert (M.Res.num_rows res = 0)
+
+  let fetch_single_row res =
+    assert (M.Res.num_rows res = 1);
+    M.Res.fetch (module M.Row.Array) res >>= or_die "fetch" >|= fun row ->
+    (match row with
+     | None -> failwith "expecting one row, no rows returned"
+     | Some a -> a)
+
+  let test_insert_id () =
+    connect () >>= or_die "connect" >>= fun dbh ->
+    M.prepare dbh
+      "CREATE TEMPORARY TABLE ocaml_mariadb_test \
+        (id integer PRIMARY KEY AUTO_INCREMENT)"
+      >>= or_die "prepare"
+      >>= fun create_table_stmt ->
+    execute_no_data create_table_stmt >>= fun () ->
+    M.prepare dbh "INSERT INTO ocaml_mariadb_test VALUES (DEFAULT)"
+      >>= or_die "prepare"
+      >>= fun insert_stmt ->
+    let rec check_inserts_from expected_id =
+      if expected_id > 5 then return () else
+      M.Stmt.execute insert_stmt [||] >>= or_die "insert" >>= fun res ->
+      assert (M.Res.num_rows res = 0);
+      assert (M.Res.insert_id res = expected_id);
+      check_inserts_from (expected_id + 1)
+    in
+    check_inserts_from 1 >>= fun () ->
+    M.close dbh
+
+  let test_txn () =
+    connect () >>= or_die "connect" >>= fun dbh ->
+
+    M.prepare dbh
+      "CREATE TEMPORARY TABLE ocaml_mariadb_test (i integer PRIMARY KEY)"
+      >>= or_die "prepare create_table_stmt"
+      >>= fun create_table_stmt ->
+    execute_no_data create_table_stmt >>= fun () ->
+
+    map_s_list (fun s -> M.prepare dbh s >>= or_die "prepare")
+      ["INSERT INTO ocaml_mariadb_test VALUES (1), (2)";
+       "INSERT INTO ocaml_mariadb_test SELECT i + 10 FROM ocaml_mariadb_test"]
+      >>= fun insert_stmts ->
+    M.prepare dbh "SELECT CAST(sum(i) AS integer) FROM ocaml_mariadb_test"
+      >>= or_die "prepare sum"
+      >>= fun sum_stmt ->
+
+    M.start_txn dbh >>= or_die "start_txn" >>= fun () ->
+    iter_s_list execute_no_data insert_stmts >>= fun () ->
+    M.rollback dbh >>= or_die "rollback" >>= fun () ->
+    M.Stmt.execute sum_stmt [||] >>= or_die "execute" >>= fun res ->
+    fetch_single_row res >>= fun row ->
+    assert (Array.length row = 1 && M.Field.null_value row.(0));
+
+    M.start_txn dbh >>= or_die "start_txn" >>= fun () ->
+    iter_s_list execute_no_data insert_stmts >>= fun () ->
+    M.commit dbh >>= or_die "rollback" >>= fun () ->
+    M.Stmt.execute sum_stmt [||] >>= or_die "execute" >>= fun res ->
+    fetch_single_row res >>= fun row ->
+    assert (Array.length row = 1 && M.Field.int row.(0) = 26);
+
+    M.close dbh
+
   (* Make sure the conversion between timestamps and strings are consistent
    * between MariaDB and OCaml. By sending timestamps to be compared as binary
    * and as string, this also verifies the MYSQL_TIME encoding. *)
@@ -124,7 +205,7 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
         assert (s = M.Field.(string s'))
      | _ -> assert false)
 
-  let test () =
+  let test_random_select () =
     let stmt_cache = Hashtbl.create 7 in
     connect () >>= or_die "connect" >>= fun dbh ->
     test_datetime_and_string_conv dbh >>= fun () ->
@@ -163,5 +244,10 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
       stmt_cache (return ()) >>= fun () ->
     M.close dbh
 
-  let main () = repeat 500 test
+  let test_many_select () = repeat 500 test_random_select
+
+  let main () =
+    test_insert_id () >>= fun () ->
+    test_txn () >>= fun () ->
+    test_many_select ()
 end

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+(test`
	`2`	`+ (name blocking_testsuite)`
	`3`	`+ (libraries mariadb nonblocking_testsuite unix))`