From b24e80bcf2f1c53ffc5f65135bc3e8e71665b01f Mon Sep 17 00:00:00 2001
From: "Petter A. Urkedal" <urkedal@nbi.dk>
Date: Tue, 15 Oct 2024 15:07:37 +0200
Subject: [PATCH 1/5] Split out tests from examples, excluding the latter from
 @runtest.

The existing "stress tests" forms the initial test suite, while the
remaining executables, which takes an extra OCAML_MARIADB_QUERY
environment variable, are considered examples.
---
 examples/async/dune                           |  9 +++-----
 examples/blocking/dune                        |  6 ++----
 examples/lwt/dune                             |  9 +++-----
 examples/nonblocking/dune                     |  4 ----
 examples/select/dune                          |  8 +++----
 tests/README.md                               | 21 +++++++++++++++++++
 .../blocking/blocking_testsuite.ml            |  0
 tests/blocking/dune                           |  3 +++
 tests/nonblocking-async/dune                  |  4 ++++
 .../nonblocking_testsuite_async.ml            |  2 +-
 tests/nonblocking-block/dune                  |  3 +++
 .../nonblocking_testsuite_block.ml            |  2 +-
 tests/nonblocking-lwt/dune                    |  4 ++++
 .../nonblocking_testsuite_lwt.ml              |  2 +-
 tests/nonblocking/dune                        |  3 +++
 .../nonblocking/nonblocking_testsuite.ml      |  0
 16 files changed, 52 insertions(+), 28 deletions(-)
 delete mode 100644 examples/nonblocking/dune
 create mode 100644 tests/README.md
 rename examples/blocking/blocking_stress_test.ml => tests/blocking/blocking_testsuite.ml (100%)
 create mode 100644 tests/blocking/dune
 create mode 100644 tests/nonblocking-async/dune
 rename examples/async/nonblocking_async_stress_test.ml => tests/nonblocking-async/nonblocking_testsuite_async.ml (96%)
 create mode 100644 tests/nonblocking-block/dune
 rename examples/select/nonblocking_select_stress_test.ml => tests/nonblocking-block/nonblocking_testsuite_block.ml (94%)
 create mode 100644 tests/nonblocking-lwt/dune
 rename examples/lwt/nonblocking_lwt_stress_test.ml => tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml (95%)
 create mode 100644 tests/nonblocking/dune
 rename examples/nonblocking/nonblocking_stress_test.ml => tests/nonblocking/nonblocking_testsuite.ml (100%)

diff --git a/examples/async/dune b/examples/async/dune
index 156ab07..208e7a4 100644
--- 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/dune b/examples/blocking/dune
index 5687bb5..3f83b4f 100644
--- 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
index 4abcce5..43459a6 100644
--- 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
deleted file mode 100644
index 5bba944..0000000
--- a/examples/nonblocking/dune
+++ /dev/null
@@ -1,4 +0,0 @@
-(library
- (name nonblocking_tests)
- (wrapped false)
- (libraries mariadb))
diff --git a/examples/select/dune b/examples/select/dune
index 23f9e0b..798d021 100644
--- 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
new file mode 100644
index 0000000..d429046
--- /dev/null
+++ b/tests/README.md
@@ -0,0 +1,21 @@
+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
+| ---------           | -----------
+| blocking            | Tests using the blocking interface.
+| nonblocking         | Test library using the non-blocking interface.
+| nonblocking-block   | Blocking instance of nonblocking tests.
+| nonblocking-async   | Async instance of nonblocking tests.
+| nonblocking-lwt     | Lwt instance of nonblocking tests.
+
+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/examples/blocking/blocking_stress_test.ml b/tests/blocking/blocking_testsuite.ml
similarity index 100%
rename from examples/blocking/blocking_stress_test.ml
rename to tests/blocking/blocking_testsuite.ml
diff --git a/tests/blocking/dune b/tests/blocking/dune
new file mode 100644
index 0000000..bd1b617
--- /dev/null
+++ b/tests/blocking/dune
@@ -0,0 +1,3 @@
+(test
+ (name blocking_testsuite)
+ (libraries mariadb))
diff --git a/tests/nonblocking-async/dune b/tests/nonblocking-async/dune
new file mode 100644
index 0000000..d41a570
--- /dev/null
+++ 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/examples/async/nonblocking_async_stress_test.ml b/tests/nonblocking-async/nonblocking_testsuite_async.ml
similarity index 96%
rename from examples/async/nonblocking_async_stress_test.ml
rename to tests/nonblocking-async/nonblocking_testsuite_async.ml
index 5601566..373bac5 100644
--- a/examples/async/nonblocking_async_stress_test.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 Test = Nonblocking_testsuite.Make (struct
 
   module IO = struct
     type 'a future = 'a Deferred.t
diff --git a/tests/nonblocking-block/dune b/tests/nonblocking-block/dune
new file mode 100644
index 0000000..fb48bf5
--- /dev/null
+++ b/tests/nonblocking-block/dune
@@ -0,0 +1,3 @@
+(test
+ (name nonblocking_testsuite_block)
+ (libraries mariadb nonblocking_testsuite unix))
diff --git a/examples/select/nonblocking_select_stress_test.ml b/tests/nonblocking-block/nonblocking_testsuite_block.ml
similarity index 94%
rename from examples/select/nonblocking_select_stress_test.ml
rename to tests/nonblocking-block/nonblocking_testsuite_block.ml
index 0a341e1..203f6c5 100644
--- a/examples/select/nonblocking_select_stress_test.ml
+++ b/tests/nonblocking-block/nonblocking_testsuite_block.ml
@@ -1,6 +1,6 @@
 module S = Mariadb.Nonblocking.Status
 
-module Test = Nonblocking_stress_test.Make (struct
+module Test = Nonblocking_testsuite.Make (struct
   module IO = struct
     type 'a future = 'a
     let (>>=) x f = f x
diff --git a/tests/nonblocking-lwt/dune b/tests/nonblocking-lwt/dune
new file mode 100644
index 0000000..ab949ee
--- /dev/null
+++ 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/examples/lwt/nonblocking_lwt_stress_test.ml b/tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml
similarity index 95%
rename from examples/lwt/nonblocking_lwt_stress_test.ml
rename to tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml
index 147a12c..f1662d6 100644
--- a/examples/lwt/nonblocking_lwt_stress_test.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 Test = Nonblocking_testsuite.Make (struct
 
   module IO = struct
     type 'a future = 'a Lwt.t
diff --git a/tests/nonblocking/dune b/tests/nonblocking/dune
new file mode 100644
index 0000000..0ce257a
--- /dev/null
+++ b/tests/nonblocking/dune
@@ -0,0 +1,3 @@
+(library
+ (name nonblocking_testsuite)
+ (libraries mariadb))
diff --git a/examples/nonblocking/nonblocking_stress_test.ml b/tests/nonblocking/nonblocking_testsuite.ml
similarity index 100%
rename from examples/nonblocking/nonblocking_stress_test.ml
rename to tests/nonblocking/nonblocking_testsuite.ml

From 20febb0ef256167ceb48a75cadc301db285c2078 Mon Sep 17 00:00:00 2001
From: "Petter A. Urkedal" <urkedal@nbi.dk>
Date: Thu, 17 Oct 2024 10:57:31 +0200
Subject: [PATCH 2/5] Add tests for start_txn.

---
 tests/blocking/blocking_testsuite.ml       | 56 +++++++++++++++++++-
 tests/nonblocking/nonblocking_testsuite.ml | 60 +++++++++++++++++++++-
 2 files changed, 112 insertions(+), 4 deletions(-)

diff --git a/tests/blocking/blocking_testsuite.ml b/tests/blocking/blocking_testsuite.ml
index 9193330..d546a93 100644
--- a/tests/blocking/blocking_testsuite.ml
+++ b/tests/blocking/blocking_testsuite.ml
@@ -17,7 +17,55 @@ let connect () =
     ~pass:(env "OCAML_MARIADB_PASS" "")
     ~db:(env "OCAML_MARIADB_DB" "mysql") ()
 
-let test () =
+let execute_no_data stmt =
+  let res = M.Stmt.execute stmt [||] |> or_die "execute" in
+  assert (M.Res.num_rows res = 0)
+
+let fetch_single_row res =
+  assert (M.Res.num_rows res = 1);
+  let row = M.Res.fetch (module M.Row.Array) res |> or_die "fetch" in
+  (match row with
+   | None -> failwith "expecting one row, no rows returned"
+   | Some a -> a)
+
+let test_txn () =
+  let dbh = connect () |> or_die "connect" in
+
+  let create_table_stmt =
+    M.prepare dbh
+      "CREATE TEMPORARY TABLE ocaml_mariadb_test (i integer PRIMARY KEY)"
+    |> or_die "prepare create_table_stmt"
+  in
+  execute_no_data create_table_stmt;
+
+  let insert_stmts =
+    List.map (fun s -> M.prepare dbh s |> or_die "prepare insert") [
+      "INSERT INTO ocaml_mariadb_test VALUES (1), (2)";
+      "INSERT INTO ocaml_mariadb_test SELECT i + 10 FROM ocaml_mariadb_test";
+    ]
+  in
+  let sum_stmt =
+    M.prepare dbh "SELECT CAST(sum(i) AS integer) FROM ocaml_mariadb_test"
+    |> or_die "prepare sum"
+  in
+
+  M.start_txn dbh |> or_die "start_txn";
+  List.iter execute_no_data insert_stmts;
+  M.rollback dbh |> or_die "rollback";
+  let res = M.Stmt.execute sum_stmt [||] |> or_die "execute" in
+  let row = fetch_single_row res in
+  assert (Array.length row = 1 && M.Field.null_value row.(0));
+
+  M.start_txn dbh |> or_die "start_txn";
+  List.iter execute_no_data insert_stmts;
+  M.commit dbh |> or_die "rollback";
+  let res = M.Stmt.execute sum_stmt [||] |> or_die "execute" in
+  let row = fetch_single_row res in
+  assert (Array.length row = 1 && M.Field.int row.(0) = 26);
+
+  M.close dbh
+
+let test_random_select () =
   let dbh = connect () |> or_die "connect" in
   (* without CAST result is typed as NULL for some reason *)
   let mk_stmt () =  M.prepare dbh "SELECT CAST(? AS BINARY)" |> or_die "prepare" in
@@ -42,4 +90,8 @@ let test () =
   M.Stmt.close !stmt |> or_die "Stmt.close";
   M.close dbh
 
-let () = for _ = 1 to 500 do test () done
+let test_many_select () = for _ = 1 to 500 do test_random_select () done
+
+let () =
+  test_txn ();
+  test_many_select ()
diff --git a/tests/nonblocking/nonblocking_testsuite.ml b/tests/nonblocking/nonblocking_testsuite.ml
index c39aeb3..33f2fce 100644
--- a/tests/nonblocking/nonblocking_testsuite.ml
+++ b/tests/nonblocking/nonblocking_testsuite.ml
@@ -12,6 +12,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 +114,50 @@ 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_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 +176,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 +215,9 @@ 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_txn () >>= fun () ->
+    test_many_select ()
 end

From cd6d262cf888d61948e7327daaa3c3753f27fb17 Mon Sep 17 00:00:00 2001
From: "Petter A. Urkedal" <urkedal@nbi.dk>
Date: Thu, 17 Oct 2024 11:14:08 +0200
Subject: [PATCH 3/5] Add tests for insert_id.

---
 tests/blocking/blocking_testsuite.ml       | 21 +++++++++++++++++++++
 tests/nonblocking/nonblocking_testsuite.ml | 22 ++++++++++++++++++++++
 2 files changed, 43 insertions(+)

diff --git a/tests/blocking/blocking_testsuite.ml b/tests/blocking/blocking_testsuite.ml
index d546a93..b20a950 100644
--- a/tests/blocking/blocking_testsuite.ml
+++ b/tests/blocking/blocking_testsuite.ml
@@ -28,6 +28,26 @@ let fetch_single_row res =
    | None -> failwith "expecting one row, no rows returned"
    | Some a -> a)
 
+let test_insert_id () =
+  let dbh = connect () |> or_die "connect" in
+  let create_table_stmt =
+    M.prepare dbh
+      "CREATE TEMPORARY TABLE ocaml_mariadb_test \
+        (id integer PRIMARY KEY AUTO_INCREMENT)"
+    |> or_die "prepare"
+  in
+  execute_no_data create_table_stmt;
+  let insert_stmt =
+    M.prepare dbh "INSERT INTO ocaml_mariadb_test VALUES (DEFAULT)"
+    |> or_die "prepare"
+  in
+  for expected_id = 1 to 5 do
+    let res = M.Stmt.execute insert_stmt [||] |> or_die "insert" in
+    assert (M.Res.num_rows res = 0);
+    assert (M.Res.insert_id res = expected_id)
+  done;
+  M.close dbh
+
 let test_txn () =
   let dbh = connect () |> or_die "connect" in
 
@@ -93,5 +113,6 @@ let test_random_select () =
 let test_many_select () = for _ = 1 to 500 do test_random_select () done
 
 let () =
+  test_insert_id ();
   test_txn ();
   test_many_select ()
diff --git a/tests/nonblocking/nonblocking_testsuite.ml b/tests/nonblocking/nonblocking_testsuite.ml
index 33f2fce..095c447 100644
--- a/tests/nonblocking/nonblocking_testsuite.ml
+++ b/tests/nonblocking/nonblocking_testsuite.ml
@@ -125,6 +125,27 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
      | 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 ->
 
@@ -218,6 +239,7 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
   let test_many_select () = repeat 500 test_random_select
 
   let main () =
+    test_insert_id () >>= fun () ->
     test_txn () >>= fun () ->
     test_many_select ()
 end

From 88e9e0107e86ac84a2e13137ce05b96bc54b2c1b Mon Sep 17 00:00:00 2001
From: "Petter A. Urkedal" <urkedal@nbi.dk>
Date: Thu, 17 Oct 2024 13:38:23 +0200
Subject: [PATCH 4/5] Eliminate duplicate test code.

The blocking tests were duplicates of corresponding non-blocking tests.
This commit replaces it with a merged concurrency-less main which
instantiates the test suite twice, once using the blocking API and once
using the non-blocking API.
---
 tests/README.md                               |   9 +-
 tests/blocking/blocking_testsuite.ml          | 159 +++++-------------
 tests/blocking/dune                           |   2 +-
 .../nonblocking_testsuite_async.ml            |   6 +-
 tests/nonblocking-block/dune                  |   3 -
 .../nonblocking_testsuite_block.ml            |  33 ----
 .../nonblocking_testsuite_lwt.ml              |   8 +-
 tests/nonblocking/nonblocking_testsuite.ml    |  14 +-
 8 files changed, 69 insertions(+), 165 deletions(-)
 delete mode 100644 tests/nonblocking-block/dune
 delete mode 100644 tests/nonblocking-block/nonblocking_testsuite_block.ml

diff --git a/tests/README.md b/tests/README.md
index d429046..f297957 100644
--- a/tests/README.md
+++ b/tests/README.md
@@ -4,11 +4,10 @@ latter there are instances depending on the concurrency library:
 
 | Directory           | Description
 | ---------           | -----------
-| blocking            | Tests using the blocking interface.
-| nonblocking         | Test library using the non-blocking interface.
-| nonblocking-block   | Blocking instance of nonblocking tests.
-| nonblocking-async   | Async instance of nonblocking tests.
-| nonblocking-lwt     | Lwt instance of nonblocking tests.
+| 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:
diff --git a/tests/blocking/blocking_testsuite.ml b/tests/blocking/blocking_testsuite.ml
index b20a950..5ec7572 100644
--- a/tests/blocking/blocking_testsuite.ml
+++ b/tests/blocking/blocking_testsuite.ml
@@ -1,118 +1,45 @@
-open Printf
-
-module M = Mariadb.Blocking
-
-let env var def =
-  try Sys.getenv var
-  with Not_found -> def
-
-let or_die where = function
-  | Ok r -> r
-  | Error (i, e) -> ksprintf failwith "%s: (%d) %s" where i e
-
-let connect () =
-  M.connect
-    ~host:(env "OCAML_MARIADB_HOST" "localhost")
-    ~user:(env "OCAML_MARIADB_USER" "root")
-    ~pass:(env "OCAML_MARIADB_PASS" "")
-    ~db:(env "OCAML_MARIADB_DB" "mysql") ()
-
-let execute_no_data stmt =
-  let res = M.Stmt.execute stmt [||] |> or_die "execute" in
-  assert (M.Res.num_rows res = 0)
-
-let fetch_single_row res =
-  assert (M.Res.num_rows res = 1);
-  let row = M.Res.fetch (module M.Row.Array) res |> or_die "fetch" in
-  (match row with
-   | None -> failwith "expecting one row, no rows returned"
-   | Some a -> a)
-
-let test_insert_id () =
-  let dbh = connect () |> or_die "connect" in
-  let create_table_stmt =
-    M.prepare dbh
-      "CREATE TEMPORARY TABLE ocaml_mariadb_test \
-        (id integer PRIMARY KEY AUTO_INCREMENT)"
-    |> or_die "prepare"
-  in
-  execute_no_data create_table_stmt;
-  let insert_stmt =
-    M.prepare dbh "INSERT INTO ocaml_mariadb_test VALUES (DEFAULT)"
-    |> or_die "prepare"
-  in
-  for expected_id = 1 to 5 do
-    let res = M.Stmt.execute insert_stmt [||] |> or_die "insert" in
-    assert (M.Res.num_rows res = 0);
-    assert (M.Res.insert_id res = expected_id)
-  done;
-  M.close dbh
-
-let test_txn () =
-  let dbh = connect () |> or_die "connect" in
-
-  let create_table_stmt =
-    M.prepare dbh
-      "CREATE TEMPORARY TABLE ocaml_mariadb_test (i integer PRIMARY KEY)"
-    |> or_die "prepare create_table_stmt"
-  in
-  execute_no_data create_table_stmt;
-
-  let insert_stmts =
-    List.map (fun s -> M.prepare dbh s |> or_die "prepare insert") [
-      "INSERT INTO ocaml_mariadb_test VALUES (1), (2)";
-      "INSERT INTO ocaml_mariadb_test SELECT i + 10 FROM ocaml_mariadb_test";
-    ]
-  in
-  let sum_stmt =
-    M.prepare dbh "SELECT CAST(sum(i) AS integer) FROM ocaml_mariadb_test"
-    |> or_die "prepare sum"
-  in
-
-  M.start_txn dbh |> or_die "start_txn";
-  List.iter execute_no_data insert_stmts;
-  M.rollback dbh |> or_die "rollback";
-  let res = M.Stmt.execute sum_stmt [||] |> or_die "execute" in
-  let row = fetch_single_row res in
-  assert (Array.length row = 1 && M.Field.null_value row.(0));
-
-  M.start_txn dbh |> or_die "start_txn";
-  List.iter execute_no_data insert_stmts;
-  M.commit dbh |> or_die "rollback";
-  let res = M.Stmt.execute sum_stmt [||] |> or_die "execute" in
-  let row = fetch_single_row res in
-  assert (Array.length row = 1 && M.Field.int row.(0) = 26);
-
-  M.close dbh
-
-let test_random_select () =
-  let dbh = connect () |> or_die "connect" in
-  (* without CAST result is typed as NULL for some reason *)
-  let mk_stmt () =  M.prepare dbh "SELECT CAST(? AS BINARY)" |> or_die "prepare" in
-  let stmt = ref (mk_stmt ()) in
-  for _ = 1 to 100 do
-    let n = Random.int (1 lsl Random.int 8) in
-    let s = String.init n (fun _ -> "ACGT".[Random.int 4]) in
-    let res = M.Stmt.execute !stmt [|`String s|] |> or_die "Stmt.execute" in
-    assert (M.Res.num_rows res = 1);
-    (match M.Res.fetch (module M.Row.Array) res |> or_die "Res.fetch" with
-     | None -> assert false
-     | Some row ->
-         let s' = M.Field.string row.(0) in
-         if s <> s' then printf "@@@ <%s> <%s>\n%!" s s';
-         assert (s = s'));
-    if Random.bool () then begin
-      M.Stmt.close !stmt |> or_die "Stmt.close";
-      stmt := mk_stmt ()
-    end else
-      M.Stmt.reset !stmt |> or_die "Stmt.reset"
-  done;
-  M.Stmt.close !stmt |> or_die "Stmt.close";
-  M.close dbh
-
-let test_many_select () = for _ = 1 to 500 do test_random_select () done
+module S = Mariadb.Nonblocking.Status
+
+module Wait = struct
+
+  module IO = struct
+    type 'a future = 'a
+    let (>>=) x f = f x
+    let return x = x
+  end
+
+  let return = IO.return
+
+  let wait mariadb status =
+    let fd = Mariadb.Nonblocking.fd mariadb in
+    let rfd = if S.read status then [fd] else [] in
+    let wfd = if S.write status then [fd] else [] in
+    let efd = if S.except status then [fd] else [] in
+    let timeout =
+      if S.timeout status
+      then float @@ Mariadb.Nonblocking.timeout mariadb
+      else -1.0 in
+    try
+      let rfd, wfd, efd = Unix.select rfd wfd efd timeout in
+      return @@
+        S.create
+          ~read:(rfd <> [])
+          ~write:(wfd <> [])
+          ~except:(efd <> [])
+          ()
+    with Unix.Unix_error (_, _, _) ->
+      return @@ S.create ~timeout: true ()
+
+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_insert_id ();
-  test_txn ();
-  test_many_select ()
+  Test_blocking.main ();
+  Test_nonblocking.main ()
diff --git a/tests/blocking/dune b/tests/blocking/dune
index bd1b617..752d9ac 100644
--- a/tests/blocking/dune
+++ b/tests/blocking/dune
@@ -1,3 +1,3 @@
 (test
  (name blocking_testsuite)
- (libraries mariadb))
+ (libraries mariadb nonblocking_testsuite unix))
diff --git a/tests/nonblocking-async/nonblocking_testsuite_async.ml b/tests/nonblocking-async/nonblocking_testsuite_async.ml
index 373bac5..904a31c 100644
--- 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_testsuite.Make (struct
+module Wait = struct
 
   module IO = struct
     type 'a future = 'a Deferred.t
@@ -45,8 +45,10 @@ module Test = Nonblocking_testsuite.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-block/dune b/tests/nonblocking-block/dune
deleted file mode 100644
index fb48bf5..0000000
--- a/tests/nonblocking-block/dune
+++ /dev/null
@@ -1,3 +0,0 @@
-(test
- (name nonblocking_testsuite_block)
- (libraries mariadb nonblocking_testsuite unix))
diff --git a/tests/nonblocking-block/nonblocking_testsuite_block.ml b/tests/nonblocking-block/nonblocking_testsuite_block.ml
deleted file mode 100644
index 203f6c5..0000000
--- a/tests/nonblocking-block/nonblocking_testsuite_block.ml
+++ /dev/null
@@ -1,33 +0,0 @@
-module S = Mariadb.Nonblocking.Status
-
-module Test = Nonblocking_testsuite.Make (struct
-  module IO = struct
-    type 'a future = 'a
-    let (>>=) x f = f x
-    let return x = x
-  end
-
-  let return = IO.return
-
-  let wait mariadb status =
-    let fd = Mariadb.Nonblocking.fd mariadb in
-    let rfd = if S.read status then [fd] else [] in
-    let wfd = if S.write status then [fd] else [] in
-    let efd = if S.except status then [fd] else [] in
-    let timeout =
-      if S.timeout status
-      then float @@ Mariadb.Nonblocking.timeout mariadb
-      else -1.0 in
-    try
-      let rfd, wfd, efd = Unix.select rfd wfd efd timeout in
-      return @@
-        S.create
-          ~read:(rfd <> [])
-          ~write:(wfd <> [])
-          ~except:(efd <> [])
-          ()
-    with Unix.Unix_error (_, _, _) ->
-      return @@ S.create ~timeout: true ()
-end)
-
-let () = Test.main ()
diff --git a/tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml b/tests/nonblocking-lwt/nonblocking_testsuite_lwt.ml
index f1662d6..0ce6e0b 100644
--- 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_testsuite.Make (struct
+module Wait = struct
 
   module IO = struct
     type 'a future = 'a Lwt.t
@@ -32,6 +32,10 @@ module Test = Nonblocking_testsuite.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/nonblocking_testsuite.ml b/tests/nonblocking/nonblocking_testsuite.ml
index 095c447..3772ea2 100644
--- 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)
 

From 57a50ab54509bbc257f2fd4ba9e0aa363c3461cd Mon Sep 17 00:00:00 2001
From: Corentin Leruth <corentin.leruth@gmail.com>
Date: Tue, 29 Oct 2024 14:17:59 +0100
Subject: [PATCH 5/5] add integer and bigint tests

---
 .gitignore                                 |  1 +
 tests/nonblocking/nonblocking_testsuite.ml | 81 +++++++++++++++++++++-
 2 files changed, 80 insertions(+), 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index fee6d31..b6f3b93 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 /_build/
 *.swp
+_opam
diff --git a/tests/nonblocking/nonblocking_testsuite.ml b/tests/nonblocking/nonblocking_testsuite.ml
index 3772ea2..c186f9a 100644
--- a/tests/nonblocking/nonblocking_testsuite.ml
+++ b/tests/nonblocking/nonblocking_testsuite.ml
@@ -33,7 +33,8 @@ struct
       ~host:(env "OCAML_MARIADB_HOST" "localhost")
       ~user:(env "OCAML_MARIADB_USER" "root")
       ~pass:(env "OCAML_MARIADB_PASS" "")
-      ~db:(env "OCAML_MARIADB_DB" "mysql") ()
+      ~db:(env "OCAML_MARIADB_DB" "mysql")
+      ~port:(int_of_string (env "OCAML_MARIADB_PORT" "0")) ()
 
   let rec repeat n f =
     if n = 0 then return () else f () >>= fun () -> repeat (n - 1) f
@@ -246,8 +247,84 @@ struct
 
   let test_many_select () = repeat 500 test_random_select
 
+  let test_integer, test_bigint =
+    let make_check type_ =
+      connect () >>= or_die "connect" >>= fun dbh ->
+      M.prepare dbh
+        (Printf.sprintf
+           "CREATE TEMPORARY TABLE ocaml_mariadb_test (id integer PRIMARY KEY \
+            AUTO_INCREMENT, value %s, value_unsigned %s unsigned)"
+           type_ type_)
+      >>= or_die "prepare create"
+      >>= fun create_table_stmt ->
+      execute_no_data create_table_stmt >>= fun () ->
+      let check (value : [ `Signed of int | `Unsigned of int ]) =
+        let column =
+          match value with
+          | `Signed _ -> "value"
+          | `Unsigned _ -> "value_unsigned"
+        in
+        M.prepare dbh
+          (Printf.sprintf "INSERT INTO ocaml_mariadb_test (%s) VALUES (?)"
+             column)
+        >>= or_die "prepare insert"
+        >>= fun insert_stmt ->
+        let value_to_insert =
+          match value with `Signed n -> n | `Unsigned n -> n
+        in
+        M.Stmt.execute insert_stmt [| `Int value_to_insert |]
+        >>= or_die "insert"
+        >>= fun res ->
+        M.prepare dbh
+          (Printf.sprintf "SELECT %s FROM ocaml_mariadb_test WHERE id = (?)"
+             column)
+        >>= or_die "prepare select"
+        >>= fun select_stmt ->
+        M.Stmt.execute select_stmt [| `Int (M.Res.insert_id res) |]
+        >>= or_die "Stmt.execute"
+        >>= M.Res.fetch (module M.Row.Array)
+        >>= or_die "Res.fetch"
+        >|= function
+        | Some [| inserted_value |] ->
+            assert_field_equal (`Int value_to_insert)
+              (`Int (M.Field.int inserted_value))
+        | _ -> assert false
+      in
+      return (dbh, check)
+    in
+    let test_integer () =
+      make_check "integer" >>= fun (dbh, check) ->
+      let input =
+        [
+          `Signed
+            (Int32.max_int |> Int32.to_int (* max value for integer column *));
+          `Signed
+            (Int32.min_int |> Int32.to_int (* min value for integer column *));
+          `Unsigned (Unsigned.UInt32.max_int |> Unsigned.UInt32.to_int)
+          (* max value for unsgined integer column.
+             Produces the following error: insert: (1264) Out of range value for column 'value_unsigned' at row 1 *);
+        ]
+      in
+      iter_s_list check input >>= fun () -> M.close dbh
+    in
+    let test_bigint () =
+      make_check "bigint" >>= fun (dbh, check) ->
+      let input =
+        [
+          `Signed Int.max_int
+          (* [Int.max_int] is below the max value for bigint column (which is equivalent to [Int64.max_int])
+             Produces the following error: Parameter (4611686018427387903 : int) came back as (-1 : int) *);
+          `Unsigned Int.max_int
+          (* insert: (1264) Out of range value for column 'value_unsigned' at row 1 *);
+        ]
+      in
+      iter_s_list check input >>= fun () -> M.close dbh
+    in
+    (test_integer, test_bigint)
+
   let main () =
     test_insert_id () >>= fun () ->
     test_txn () >>= fun () ->
-    test_many_select ()
+    test_many_select () >>= fun () ->
+    test_integer () >>= fun () -> test_bigint ()
 end