Merge pull request #307 from jmid/missing-int-32-64

Add missing int32 and int64 combinators

Author: jmid

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## NEXT RELEASE
 
+- Add missing combinators `QCheck{,2}.Print.int{32,64}`, `QCheck.Gen.int{32,64}`,
+  `QCheck{,2}.Observable.int{32,64}`, and deprecate `QCheck.Gen.{ui32,ui64}`
 - Document `dune` usage in README
 
 ## 0.23

src/core/QCheck.ml

@@ -256,8 +256,11 @@ module Gen = struct
     done;
     Bytes.unsafe_to_string s
 
-  let ui32 st = Int32.of_string (random_binary_string st 32)
-  let ui64 st = Int64.of_string (random_binary_string st 64)
+  let int32 st = Int32.of_string (random_binary_string st 32)
+  let int64 st = Int64.of_string (random_binary_string st 64)
+
+  let ui32 = int32
+  let ui64 = int64
 
   let list_size size gen st =
     foldn ~f:(fun acc _ -> (gen st)::acc) ~init:[] (size st)
@@ -477,6 +480,8 @@ module Print = struct
 
   let unit _ = "()"
   let int = string_of_int
+  let int32 i = Int32.to_string i ^ "l"
+  let int64 i = Int64.to_string i ^ "L"
   let bool = string_of_bool
   let float = string_of_float
   let string s = Printf.sprintf "%S" s
@@ -961,6 +966,8 @@ module Observable = struct
     let combine a b = Hashtbl.seeded_hash a b
     let combine_f f s x = Hashtbl.seeded_hash s (f x)
     let int i = i land max_int
+    let int32 (i:int32) = Hashtbl.hash i
+    let int64 (i:int64) = Hashtbl.hash i
     let bool b = if b then 1 else 2
     let char x = Char.code x
     let bytes (x:bytes) = Hashtbl.hash x
@@ -977,6 +984,8 @@ module Observable = struct
     type 'a t = 'a -> 'a -> bool
 
     let int : int t = (=)
+    let int32 : int32 t = (=)
+    let int64 : int64 t = (=)
     let bytes : bytes t = (=)
     let string : string t = (=)
     let bool : bool t = (=)
@@ -1010,6 +1019,8 @@ module Observable = struct
   let unit : unit t = make ~hash:(fun _ -> 1) ~eq:Eq.unit Print.unit
   let bool : bool t = make ~hash:H.bool ~eq:Eq.bool Print.bool
   let int : int t = make ~hash:H.int ~eq:Eq.int Print.int
+  let int32 : int32 t = make ~hash:H.int32 ~eq:Eq.int32 Print.int32
+  let int64 : int64 t = make ~hash:H.int64 ~eq:Eq.int64 Print.int64
   let float : float t = make ~eq:Eq.float Print.float
   let bytes = make ~hash:H.bytes ~eq:Eq.bytes Print.bytes
   let string = make ~hash:H.string ~eq:Eq.string Print.string
@@ -1122,11 +1133,9 @@ let small_int_corners () = make_int (Gen.nng_corners ())
 let neg_int = make_int Gen.neg_int
 
 let int32 =
-  make ~print:(fun i -> Int32.to_string i ^ "l") ~small:small1
-    ~shrink:Shrink.int32 Gen.ui32
+  make ~print:Print.int32 ~small:small1 ~shrink:Shrink.int32 Gen.int32
 let int64 =
-  make ~print:(fun i -> Int64.to_string i ^ "L") ~small:small1
-    ~shrink:Shrink.int64 Gen.ui64
+  make ~print:Print.int64 ~small:small1 ~shrink:Shrink.int64 Gen.int64
 
 let small_char target c = abs ((Char.code c) - (Char.code target))
 

src/core/QCheck.mli

@@ -337,9 +337,23 @@ module Gen : sig
 
   val (--) : int -> int -> int t (** Synonym for {!int_range}. *)
 
-  val ui32 : int32 t (** Generates (unsigned) [int32] values. *)
+  val int32 : int32 t
+  (** Generates [int32] values uniformly.
+      @since NEXT_RELEASE *)
+
+  val int64 : int64 t
+  (** Generates [int64] values uniformly.
+      @since NEXT_RELEASE *)
+
+  val ui32 : int32 t
+  (** Generates [int32] values.
+      @deprecated use {!val:int32} instead, the name is wrong, values {i are} signed.
+  *)
 
-  val ui64 : int64 t (** Generates (unsigned) [int64] values. *)
+  val ui64 : int64 t
+  (** Generates [int64] values.
+      @deprecated use {!val:int64} instead, the name is wrong, values {i are} signed.
+  *)
 
   val list : 'a t -> 'a list t
   (** Builds a list generator from an element generator. List size is generated by {!nat}. *)
@@ -639,6 +653,14 @@ module Print : sig
 
   val int : int t (** Integer printer. *)
 
+  val int32 : int32 t
+  (** 32-bit integer printer.
+      @since NEXT_RELEASE *)
+
+  val int64 : int64 t
+  (** 64-bit integer printer.
+      @since NEXT_RELEASE *)
+
   val bool : bool t (** Boolean printer. *)
 
   val float : float t (** Floating point number printer. *)
@@ -1625,6 +1647,8 @@ module Observable : sig
   val unit : unit t
   val bool : bool t
   val int : int t
+  val int32 : int32 t (** @since NEXT_RELEASE *)
+  val int64 : int64 t (** @since NEXT_RELEASE *)
   val float : float t
   val string : string t
   val bytes : bytes t (** @since 0.20 *)

src/core/QCheck2.ml

@@ -792,6 +792,8 @@ module Print = struct
   let unit _ = "()"
 
   let int = string_of_int
+  let int32 i = Int32.to_string i ^ "l"
+  let int64 i = Int64.to_string i ^ "L"
 
   let bool = string_of_bool
 
@@ -979,6 +981,8 @@ module Observable = struct
     let combine_f f s x = Hashtbl.seeded_hash s (f x)
 
     let int i = i land max_int
+    let int32 (i:int32) = Hashtbl.hash i
+    let int64 (i:int64) = Hashtbl.hash i
 
     let bool b = if b then 1 else 2
 
@@ -1002,6 +1006,8 @@ module Observable = struct
     type 'a t = 'a -> 'a -> bool
 
     let int : int t = (=)
+    let int32 : int32 t = (=)
+    let int64 : int64 t = (=)
 
     let bytes : bytes t = (=)
 
@@ -1043,6 +1049,8 @@ module Observable = struct
   let bool : bool t = make ~hash:H.bool ~eq:Eq.bool Print.bool
 
   let int : int t = make ~hash:H.int ~eq:Eq.int Print.int
+  let int32 : int32 t = make ~hash:H.int32 ~eq:Eq.int32 Print.int32
+  let int64 : int64 t = make ~hash:H.int64 ~eq:Eq.int64 Print.int64
 
   let float : float t = make ~eq:Eq.float Print.float
 

src/core/QCheck2.mli

@@ -1111,7 +1111,15 @@ module Print : sig
   *)
 
   val int : int t
-  (** [int] is a printer of integer. *)
+  (** [int] is a printer of integers. *)
+
+  val int32 : int32 t
+  (** [int32] is a printer of 32-bit integers.
+      @since NEXT_RELEASE *)
+
+  val int64 : int64 t
+  (** [int64] is a printer of 64-bit integers.
+      @since NEXT_RELEASE *)
 
   val bool : bool t
   (** [bool] is a printer of boolean. *)
@@ -1334,6 +1342,14 @@ module Observable : sig
   val int : int t
   (** [int] is an observable of [int]. *)
 
+  val int32 : int32 t
+  (** [int32] is an observable of [int32].
+      @since NEXT_RELEASE *)
+
+  val int64 : int64 t
+  (** [int64] is an observable of [int64].
+      @since NEXT_RELEASE *)
+
   val float : float t
   (** [float] is an observable of [float]. *)