Skip to content

Commit

Permalink
Merge pull request #5885 from psafont/qcheck-core
Browse files Browse the repository at this point in the history
  • Loading branch information
psafont authored Jul 26, 2024
2 parents 231bb73 + f4b9bcf commit afe5fec
Show file tree
Hide file tree
Showing 5 changed files with 16 additions and 78 deletions.
2 changes: 2 additions & 0 deletions clock.opam
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,8 @@ depends: [
"astring"
"mtime"
"ptime"
"qcheck-core" {with-test}
"qcheck-alcotest" {with-test}
"odoc" {with-doc}
]
build: [
Expand Down
2 changes: 2 additions & 0 deletions dune-project
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,8 @@
astring
mtime
ptime
(qcheck-core :with-test)
(qcheck-alcotest :with-test)
)
)

Expand Down
12 changes: 11 additions & 1 deletion ocaml/libs/clock/dune
Original file line number Diff line number Diff line change
Expand Up @@ -15,5 +15,15 @@
(names test_date test_timer)
(package clock)
(modules test_date test_timer)
(libraries alcotest clock fmt mtime mtime.clock.os ptime qcheck-core qcheck-core.runner)
(libraries
alcotest
clock
fmt
mtime
mtime.clock.os
ptime
qcheck-alcotest
qcheck-core
qcheck-core.runner
)
)
76 changes: 0 additions & 76 deletions ocaml/libs/clock/test_timer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2,82 +2,6 @@ module Timer = Clock.Timer
module Gen = QCheck2.Gen
module Test = QCheck2.Test

module QCheck_alcotest = struct
(* SPDX: BSD-2-Clause
From github.com/c-cube/qcheck
*)

module Q = QCheck2
module T = QCheck2.Test
module Raw = QCheck_base_runner.Raw

let seed_ =
lazy
(let s =
try int_of_string @@ Sys.getenv "QCHECK_SEED"
with _ -> Random.self_init () ; Random.int 1_000_000_000
in
Printf.printf "qcheck random seed: %d\n%!" s ;
s
)

let default_rand () =
(* random seed, for repeatability of tests *)
Random.State.make [|Lazy.force seed_|]

let verbose_ =
lazy
( match Sys.getenv "QCHECK_VERBOSE" with
| "1" | "true" ->
true
| _ ->
false
| exception Not_found ->
false
)

let long_ =
lazy
( match Sys.getenv "QCHECK_LONG" with
| "1" | "true" ->
true
| _ ->
false
| exception Not_found ->
false
)

let to_alcotest ?(colors = false) ?(verbose = Lazy.force verbose_)
?(long = Lazy.force long_) ?(debug_shrink = None) ?debug_shrink_list
?(rand = default_rand ()) (t : T.t) =
let (T.Test cell) = t in
let handler name cell r =
match (r, debug_shrink) with
| QCheck2.Test.Shrunk (step, x), Some out ->
let go =
match debug_shrink_list with
| None ->
true
| Some test_list ->
List.mem name test_list
in
if not go then
()
else
QCheck_base_runner.debug_shrinking_choices ~colors ~out ~name cell
~step x
| _ ->
()
in
let print = Raw.print_std in
let name = T.get_name cell in
let run () =
let call = Raw.callback ~colors ~verbose ~print_res:true ~print in
T.check_cell_exn ~long ~call ~handler ~rand cell
in
((name, `Slow, run) : unit Alcotest.test_case)
end

let spans =
Gen.oneofa ([|1; 100; 300|] |> Array.map (fun v -> Mtime.Span.(v * ms)))

Expand Down
2 changes: 1 addition & 1 deletion quality-gate.sh
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ ocamlyacc () {


unixgetenv () {
N=1
N=0
UNIXGETENV=$(git grep -P -r -o --count 'getenv(?!_opt)' -- **/*.ml | wc -l)
if [ "$UNIXGETENV" -eq "$N" ]; then
echo "OK found $UNIXGETENV usages of exception-raising Unix.getenv in OCaml files."
Expand Down

0 comments on commit afe5fec

Please sign in to comment.