Support 64-bit unsigned fields.

Author: mfp

README.md

@@ -203,6 +203,7 @@ function.
 type value =
   [ `Int of int
   | `Int64 of Int64.t
+  | `UInt64 of Unsigned.UInt64.t
   | `Float of float
   | `String of string
   | `Bytes of bytes
@@ -220,6 +221,7 @@ provided to extract the OCaml types directly from a field:
 ```ocaml
 val int : Field.t -> int
 val int64 : Field.t -> Int64.t
+val uint64 : Field.t -> Unsigned.Int64.t
 val float : Field.t -> float
 val string : Field.t -> string
 val bytes : Field.t -> bytes
@@ -234,6 +236,7 @@ For nullable fields, the following analogous functions are also provided:
 ```ocaml
 val int_opt : Field.t -> int option
 val int64_opt : Field.t -> Int64.t option
+val uint64_opt : Field.t -> Unsigned.UInt64.t option
 val float_opt : Field.t -> float option
 val string_opt : Field.t -> string option
 val bytes_opt : Field.t -> bytes option

_oasis

@@ -172,3 +172,13 @@ Executable "blocking_stress_test"
   NativeOpt:        -warn-error +1..45
   CompiledObject:   best
   BuildDepends:     mariadb
+
+Executable "nonblocking_stress_test"
+  Build$:           flag(lwt)
+  Install:          false
+  Path:             examples/nonblocking
+  MainIs:           nonblocking_stress_test.ml
+  ByteOpt:          -warn-error +1..45
+  NativeOpt:        -warn-error +1..45
+  CompiledObject:   best
+  BuildDepends:     mariadb

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: fc4f1def45cd9de0092739442e8a8081)
+# DO NOT EDIT (digest: a8014746fe4d0fecde6592853a3e34bc)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -159,4 +159,17 @@ true: annot, bin_annot
 <examples/blocking/*.ml{,i,y}>: package(unix)
 <examples/blocking/*.ml{,i,y}>: use_mariadb
 <examples/blocking/*.ml{,i,y}>: use_mariadb_bindings
+# Executable nonblocking_stress_test
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: oasis_executable_nonblocking_stress_test_byte
+<examples/nonblocking/*.ml{,i,y}>: oasis_executable_nonblocking_stress_test_byte
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: oasis_executable_nonblocking_stress_test_native
+<examples/nonblocking/*.ml{,i,y}>: oasis_executable_nonblocking_stress_test_native
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: package(ctypes.stubs)
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: package(unix)
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: use_mariadb
+<examples/nonblocking/nonblocking_stress_test.{native,byte}>: use_mariadb_bindings
+<examples/nonblocking/*.ml{,i,y}>: package(ctypes.stubs)
+<examples/nonblocking/*.ml{,i,y}>: package(unix)
+<examples/nonblocking/*.ml{,i,y}>: use_mariadb
+<examples/nonblocking/*.ml{,i,y}>: use_mariadb_bindings
 # OASIS_STOP

examples/async/nonblocking_async_example.ml

@@ -67,6 +67,7 @@ let print_row row =
       match M.Field.value field with
       | `Int i -> printf "%d\n%!" i
       | `Int64 i -> printf "%Ld\n%!" i
+      | `UInt64 i -> printf "%s\n%!" (Unsigned.UInt64.to_string i)
       | `Float x -> printf "%f\n%!" x
       | `String s -> printf "%s\n%!" s
       | `Bytes b -> printf "%s\n%!" (Caml_bytes.to_string b)

examples/blocking/blocking_example.ml

@@ -18,6 +18,7 @@ let print_row row =
       match M.Field.value field with
       | `Int i -> printf "%d\n%!" i
       | `Int64 i -> printf "%Ld\n%!" i
+      | `UInt64 i -> printf "%s\n%!" (Unsigned.UInt64.to_string i)
       | `Float x -> printf "%f\n%!" x
       | `String s -> printf "%s\n%!" s
       | `Bytes b -> printf "%s\n%!" (Bytes.to_string b)

examples/lwt/nonblocking_lwt_example.ml

@@ -53,6 +53,7 @@ let print_row row =
       match M.Field.value field with
       | `Int i -> Lwt_io.printf "%d\n%!" i
       | `Int64 i -> Lwt_io.printf "%Ld\n%!" i
+      | `UInt64 i -> Lwt_io.printf "%s\n%!" (Unsigned.UInt64.to_string i)
       | `Float x -> Lwt_io.printf "%f\n%!" x
       | `String s -> Lwt_io.printf "%s\n%!" s
       | `Bytes b -> Lwt_io.printf "%s\n%!" (Bytes.to_string b)

examples/nonblocking/nonblocking_stress_test.ml

@@ -70,6 +70,7 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
     | `Null -> "NULL"
     | `Int i -> sprintf "(%d : int)" i
     | `Int64 i -> sprintf "(%Ld : int64)" i
+    | `UInt64 i -> sprintf "(%s : uint64)" (Unsigned.UInt64.to_string i)
     | `Float x -> sprintf "(%.8g : float)" x
     | `String s -> sprintf "(%S : string)" s
     | `Bytes s -> sprintf "(%S : bytes)" (Bytes.to_string s)
@@ -92,8 +93,12 @@ module Make (W : Mariadb.Nonblocking.Wait) = struct
     | `Int i, `Float x | `Float x, `Int i -> float_of_int i = x
     | `Int64 i, `Int x | `Int x, `Int64 i -> Int64.(equal i (of_int x))
     | `Int64 i, `Float x | `Float x, `Int64 i -> Int64.to_float i = x
+    | `UInt64 i, `Int x | `Int x, `UInt64 i -> Unsigned.UInt64.(equal i (of_int x))
+    | `UInt64 i, `Float x | `Float x, `UInt64 i -> Int64.to_float (Unsigned.UInt64.to_int64 i) = x
+    | `UInt64 i, `Int64 x | `Int64 x, `UInt64 i -> Int64.equal (Unsigned.UInt64.to_int64 i) x
     | `Int _, _ | _, `Int _ -> false
     | `Int64 _, _ | _, `Int64 _ -> false
+    | `UInt64 _, _ | _, `UInt64 _ -> false
     | `Float x, `Float x' -> equal_float x x'
     | `Float _, _ | _, `Float _ -> false
     | `String s, `String s' -> s = s'

examples/select/nonblocking_select_example.ml

@@ -56,6 +56,7 @@ let print_row row =
       match M.Field.value field with
       | `Int i -> printf "%d\n%!" i
       | `Int64 i -> printf "%Ld\n%!" i
+      | `UInt64 i -> printf "%s\n%!" (Unsigned.UInt64.to_string i)
       | `Float x -> printf "%f\n%!" x
       | `String s -> printf "%s\n%!" s
       | `Bytes b -> printf "%s\n%!" (Bytes.to_string b)

lib/common.ml

@@ -340,7 +340,7 @@ module Stmt = struct
             | `Null -> Bind.null b ~at
             | `Int i -> Bind.int b i ~at
             | `Int64 i -> Bind.int64 b i ~at
-            | `UInt64 i -> Bind.int64 ~unsigned:true b i ~at
+            | `UInt64 i -> Bind.int64 ~unsigned:true b (Unsigned.UInt64.to_int64 i) ~at
             | `Float x -> Bind.float b x ~at
             | `String s -> Bind.string b s ~at
             | `Bytes s -> Bind.blob b s ~at

lib/field.ml

@@ -6,6 +6,7 @@ type value =
   [ `Null
   | `Int of int
   | `Int64 of Int64.t
+  | `UInt64 of Unsigned.UInt64.t
   | `Float of float
   | `String of string
   | `Bytes of bytes
@@ -82,7 +83,7 @@ let convert field typ unsigned =
   | `Short,           false -> `Int (UInt.to_int (cast_to uint field))
   | (`Int24 | `Long),  true -> `Int (UInt32.to_int (cast_to uint32_t field))
   | (`Int24 | `Long), false -> `Int (Int32.to_int (cast_to int32_t field))
-  | `Long_long,        true -> `Int64 (UInt64.to_int64 (cast_to uint64_t field))
+  | `Long_long,        true -> `UInt64 (cast_to uint64_t field)
   | `Long_long,       false -> `Int64 (cast_to int64_t field)
   | `Float,               _ -> `Float (cast_to float field)
   | `Double,              _ -> `Float (cast_to double field)
@@ -108,7 +109,12 @@ let int field =
 let int64 field =
   match value field with
   | `Int64 i -> i
-  | _ -> err field ~info:"an 64-bit integer"
+  | _ -> err field ~info:"a 64-bit integer"
+
+let uint64 field =
+  match value field with
+  | `UInt64 i -> i
+  | _ -> err field ~info:"a 64-bit unsigned integer"
 
 let float field =
   match value field with
@@ -142,6 +148,12 @@ let int64_opt field =
   | `Null -> None
   | _ -> err field ~info:"a nullable 64-bit integer"
 
+let uint64_opt field =
+  match value field with
+  | `UInt64 i -> Some i
+  | `Null -> None
+  | _ -> err field ~info:"a nullable 64-bit unsigned integer"
+
 let float_opt field =
   match value field with
   | `Float x -> Some x