use preproc to deal with 4.03 and others < 4.08 versions

Author: c-cube

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 =

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 "@[<v2>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 "@[<v2>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 ->

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

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

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

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