mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
use preproc to deal with 4.03 and others < 4.08 versions
This commit is contained in:
parent
919360f96e
commit
e242b004ad
6 changed files with 33 additions and 9 deletions
|
|
@ -30,7 +30,7 @@ let eval ~major ~minor op i j =
|
||||||
|
|
||||||
let preproc_lines ~file ~major ~minor (ic:in_channel) : unit =
|
let preproc_lines ~file ~major ~minor (ic:in_channel) : unit =
|
||||||
let pos = ref 0 in
|
let pos = ref 0 in
|
||||||
let fail msg = failwith (Printf.sprintf "at line %d: %s" !pos msg) in
|
let fail msg = failwith (Printf.sprintf "at line %d in '%s': %s" !pos file msg) in
|
||||||
let pp_pos () = Printf.printf "#%d %S\n" !pos file in
|
let pp_pos () = Printf.printf "#%d %S\n" !pos file in
|
||||||
|
|
||||||
let parse_line () : line =
|
let parse_line () : line =
|
||||||
|
|
|
||||||
|
|
@ -31,6 +31,20 @@ module Test = struct
|
||||||
let str_loc (self:t) : string =
|
let str_loc (self:t) : string =
|
||||||
Printf.sprintf "(test :file '%s' :n %d)" self.__FILE__ self.n
|
Printf.sprintf "(test :file '%s' :n %d)" self.__FILE__ self.n
|
||||||
|
|
||||||
|
|
||||||
|
[@@@ifge 4.08]
|
||||||
|
|
||||||
|
let get_state (r:_ QCheck.TestResult.t) : _ QCheck.TestResult.state =
|
||||||
|
QCheck.TestResult.get_state r
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
(* must have qcheck < 0.17 *)
|
||||||
|
let get_state (r:_ QCheck.TestResult.t) : _ QCheck.TestResult.state =
|
||||||
|
r.state
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let run ~seed (self:t) : _ result =
|
let run ~seed (self:t) : _ result =
|
||||||
match
|
match
|
||||||
match self.run with
|
match self.run with
|
||||||
|
|
@ -50,7 +64,7 @@ module Test = struct
|
||||||
|
|
||||||
(* create a random state from the seed *)
|
(* create a random state from the seed *)
|
||||||
let rand =
|
let rand =
|
||||||
let bits = String.to_seq seed |> Seq.map Char.code |> CCArray.of_seq in
|
let bits = CCString.to_list seed |> List.map Char.code |> Array.of_list in
|
||||||
Random.State.make bits
|
Random.State.make bits
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
@ -70,17 +84,17 @@ module Test = struct
|
||||||
|
|
||||||
let res = Q.Test.check_cell ~rand cell in
|
let res = Q.Test.check_cell ~rand cell in
|
||||||
|
|
||||||
begin match Q.TestResult.get_state res with
|
begin match get_state res with
|
||||||
| QCheck2.TestResult.Success -> Ok ()
|
| QCheck.TestResult.Success -> Ok ()
|
||||||
| QCheck2.TestResult.Failed { instances } ->
|
| QCheck.TestResult.Failed { instances } ->
|
||||||
let msg = Format.asprintf "@[<v2>failed on instances:@ %a@]"
|
let msg = Format.asprintf "@[<v2>failed on instances:@ %a@]"
|
||||||
(Fmt.list ~sep:(Fmt.return ";@ ") pp_cex) instances
|
(Fmt.list ~sep:(Fmt.return ";@ ") pp_cex) instances
|
||||||
in
|
in
|
||||||
Error msg
|
Error msg
|
||||||
| QCheck2.TestResult.Failed_other {msg} ->
|
| QCheck.TestResult.Failed_other {msg} ->
|
||||||
let msg = spf "failed: %s" msg in
|
let msg = spf "failed: %s" msg in
|
||||||
Error msg
|
Error msg
|
||||||
| QCheck2.TestResult.Error {instance; exn; backtrace} ->
|
| QCheck.TestResult.Error {instance; exn; backtrace} ->
|
||||||
let msg = Format.asprintf "@[<v2>raised %s@ on instance %a@ :backtrace %s@]"
|
let msg = Format.asprintf "@[<v2>raised %s@ on instance %a@ :backtrace %s@]"
|
||||||
(Printexc.to_string exn) pp_cex instance backtrace
|
(Printexc.to_string exn) pp_cex instance backtrace
|
||||||
in
|
in
|
||||||
|
|
@ -166,12 +180,14 @@ let make ~__FILE__ () : (module S) =
|
||||||
end) in
|
end) in
|
||||||
(module M)
|
(module M)
|
||||||
|
|
||||||
|
let getenv_opt s = try Some (Sys.getenv s) with _ -> None
|
||||||
|
|
||||||
let run_all ?seed:seed_hex ~descr (l:Test.t list list) : unit =
|
let run_all ?seed:seed_hex ~descr (l:Test.t list list) : unit =
|
||||||
let start = Unix.gettimeofday() in
|
let start = Unix.gettimeofday() in
|
||||||
|
|
||||||
(* generate or parse seed *)
|
(* generate or parse seed *)
|
||||||
|
|
||||||
let seed_hex = match seed_hex, Sys.getenv_opt "SEED" with
|
let seed_hex = match seed_hex, getenv_opt "SEED" with
|
||||||
| Some s, _ -> s
|
| Some s, _ -> s
|
||||||
| None, Some s -> s
|
| None, Some s -> s
|
||||||
| None, None ->
|
| None, None ->
|
||||||
|
|
|
||||||
|
|
@ -2,4 +2,5 @@
|
||||||
(library
|
(library
|
||||||
(name containers_testlib)
|
(name containers_testlib)
|
||||||
(synopsis "Test library for containers")
|
(synopsis "Test library for containers")
|
||||||
|
(preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(libraries containers qcheck-core unix))
|
(libraries containers qcheck-core unix))
|
||||||
|
|
|
||||||
|
|
@ -2,5 +2,8 @@
|
||||||
(name t)
|
(name t)
|
||||||
(flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
|
(flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
|
||||||
(modes native)
|
(modes native)
|
||||||
|
(preprocess
|
||||||
|
(action
|
||||||
|
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(libraries containers containers.bencode containers.unix threads
|
(libraries containers containers.bencode containers.unix threads
|
||||||
containers_testlib iter gen uutf csexp))
|
containers_testlib iter gen uutf csexp))
|
||||||
|
|
|
||||||
|
|
@ -45,6 +45,8 @@ t @@ fun () ->
|
||||||
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
|
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
|
||||||
true;;
|
true;;
|
||||||
|
|
||||||
|
[@@@ifge 4.8]
|
||||||
|
|
||||||
t @@ fun () ->
|
t @@ fun () ->
|
||||||
set_color_default true;
|
set_color_default true;
|
||||||
let s = sprintf
|
let s = sprintf
|
||||||
|
|
@ -59,6 +61,8 @@ t @@ fun () ->
|
||||||
true
|
true
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
t @@ fun () ->
|
t @@ fun () ->
|
||||||
set_color_default true;
|
set_color_default true;
|
||||||
let s = sprintf
|
let s = sprintf
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@ module Test = (val Containers_testlib.make ~__FILE__())
|
||||||
open Test
|
open Test
|
||||||
open CCBijection;;
|
open CCBijection;;
|
||||||
|
|
||||||
module M = Make(Int)(String);;
|
module M = Make(CCInt)(String);;
|
||||||
|
|
||||||
|
|
||||||
eq 2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal);;
|
eq 2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal);;
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue