use preproc to deal with 4.03 and others < 4.08 versions

This commit is contained in:
Simon Cruanes 2022-07-02 23:39:33 -04:00
parent 919360f96e
commit e242b004ad
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
6 changed files with 33 additions and 9 deletions

View file

@ -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 =

View file

@ -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 ->

View file

@ -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))

View file

@ -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))

View file

@ -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

View file

@ -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);;