From e242b004ad8ff1e947abd4dea6a32d2f8a2a5358 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 2 Jul 2022 23:39:33 -0400 Subject: [PATCH] use preproc to deal with 4.03 and others < 4.08 versions --- src/core/cpp/cpp.ml | 2 +- src/testlib/containers_testlib.ml | 30 +++++++++++++++++++++++------- src/testlib/dune | 1 + tests/core/dune | 3 +++ tests/core/t_format.ml | 4 ++++ tests/data/t_bijection.ml | 2 +- 6 files changed, 33 insertions(+), 9 deletions(-) diff --git a/src/core/cpp/cpp.ml b/src/core/cpp/cpp.ml index 03c85c20..76e010c3 100644 --- a/src/core/cpp/cpp.ml +++ b/src/core/cpp/cpp.ml @@ -30,7 +30,7 @@ let eval ~major ~minor op i j = let preproc_lines ~file ~major ~minor (ic:in_channel) : unit = 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 parse_line () : line = diff --git a/src/testlib/containers_testlib.ml b/src/testlib/containers_testlib.ml index e60731a3..50678098 100644 --- a/src/testlib/containers_testlib.ml +++ b/src/testlib/containers_testlib.ml @@ -31,6 +31,20 @@ module Test = struct let str_loc (self:t) : string = 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 = match match self.run with @@ -50,7 +64,7 @@ module Test = struct (* create a random state from the seed *) 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 in @@ -70,17 +84,17 @@ module Test = struct let res = Q.Test.check_cell ~rand cell in - begin match Q.TestResult.get_state res with - | QCheck2.TestResult.Success -> Ok () - | QCheck2.TestResult.Failed { instances } -> + begin match get_state res with + | QCheck.TestResult.Success -> Ok () + | QCheck.TestResult.Failed { instances } -> let msg = Format.asprintf "@[failed on instances:@ %a@]" (Fmt.list ~sep:(Fmt.return ";@ ") pp_cex) instances in Error msg - | QCheck2.TestResult.Failed_other {msg} -> + | QCheck.TestResult.Failed_other {msg} -> let msg = spf "failed: %s" msg in Error msg - | QCheck2.TestResult.Error {instance; exn; backtrace} -> + | QCheck.TestResult.Error {instance; exn; backtrace} -> let msg = Format.asprintf "@[raised %s@ on instance %a@ :backtrace %s@]" (Printexc.to_string exn) pp_cex instance backtrace in @@ -166,12 +180,14 @@ let make ~__FILE__ () : (module S) = end) in (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 start = Unix.gettimeofday() in (* 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 | None, Some s -> s | None, None -> diff --git a/src/testlib/dune b/src/testlib/dune index e07a46ae..c339ecbd 100644 --- a/src/testlib/dune +++ b/src/testlib/dune @@ -2,4 +2,5 @@ (library (name containers_testlib) (synopsis "Test library for containers") + (preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) (libraries containers qcheck-core unix)) diff --git a/tests/core/dune b/tests/core/dune index 062b32b7..8a91091f 100644 --- a/tests/core/dune +++ b/tests/core/dune @@ -2,5 +2,8 @@ (name t) (flags :standard -strict-sequence -warn-error -a+8 -open CCShims_) (modes native) + (preprocess + (action + (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) (libraries containers containers.bencode containers.unix threads containers_testlib iter gen uutf csexp)) diff --git a/tests/core/t_format.ml b/tests/core/t_format.ml index 3e270560..c343a9c0 100644 --- a/tests/core/t_format.ml +++ b/tests/core/t_format.ml @@ -45,6 +45,8 @@ t @@ fun () -> assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2); true;; +[@@@ifge 4.8] + t @@ fun () -> set_color_default true; let s = sprintf @@ -59,6 +61,8 @@ t @@ fun () -> true ;; +[@@@endif] + t @@ fun () -> set_color_default true; let s = sprintf diff --git a/tests/data/t_bijection.ml b/tests/data/t_bijection.ml index 87f3649d..8686d312 100644 --- a/tests/data/t_bijection.ml +++ b/tests/data/t_bijection.ml @@ -3,7 +3,7 @@ module Test = (val Containers_testlib.make ~__FILE__()) open Test open CCBijection;; -module M = Make(Int)(String);; +module M = Make(CCInt)(String);; eq 2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal);;