Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Align int generators #165

Merged
merged 4 commits into from
Aug 22, 2021
Merged

Align int generators #165

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
bd152c7
fix QCheck.Gen.pint evaluation order
jmid Aug 18, 2021
820c815
use same evaluation order for QCheck2.Gen.pint_raw and QCheck.Gen.pint
jmid Aug 18, 2021
c51eb5b
update expected output
jmid Aug 18, 2021
d9124fa
avoid repeated Sys.word_size test for each gen call
jmid Aug 18, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 9 additions & 3 deletions src/core/QCheck.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -147,9 +147,15 @@ module Gen = struct
fun st -> RS.bits st
else (* word size = 64 *)
fun st ->
RS.bits st (* Bottom 30 bits *)
lor (RS.bits st lsl 30) (* Middle 30 bits *)
lor ((RS.bits st land 3) lsl 60) (* Top 2 bits *) (* top bit = 0 *)
(* Technically we could write [3] but this is clearer *)
let two_bits_mask = 0b11 in
(* Top 2 bits *)
let left = ((RS.bits st land two_bits_mask) lsl 60) in
(* Middle 30 bits *)
let middle = (RS.bits st lsl 30) in
(* Bottom 30 bits *)
let right = RS.bits st in
left lor middle lor right

let int st = if RS.bool st then - (pint st) - 1 else pint st
let int_bound n =
Expand Down
13 changes: 7 additions & 6 deletions src/core/QCheck2.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -384,18 +384,19 @@ module Gen = struct
Technically this function is a special case of [random_binary_string] where the size is
{!Sys.int_size}.
*)
let pint_raw (st : RS.t) : int =
let pint_raw : RS.t -> int =
if Sys.word_size = 32
then RS.bits st
then fun st -> RS.bits st
else (* word size = 64 *)
(* Bottom 30 bits *)
let right = RS.bits st in
(* Middle 30 bits *)
let middle = (RS.bits st lsl 30) in
fun st ->
(* Technically we could write [3] but this is clearer *)
let two_bits_mask = 0b11 in
(* Top 2 bits *)
let left = ((RS.bits st land two_bits_mask) lsl 60) in
(* Middle 30 bits *)
let middle = (RS.bits st lsl 30) in
(* Bottom 30 bits *)
let right = RS.bits st in
left lor middle lor right

let pint ?(origin : int = 0) : int t = fun st ->
Expand Down
Loading