Fix tests

mirage · Mar 26, 2024 · b58d26e · b58d26e
1 parent c2f7e7d
commit b58d26e
Show file tree

Hide file tree

Showing 63 changed files with 1,075 additions and 842 deletions.
diff --git a/bench/irmin-pack/bench_common.ml b/bench/irmin-pack/bench_common.ml
@@ -60,20 +60,11 @@ let random_string n = String.init n (fun _i -> random_char ())
 let random_blob () = random_string 10 |> Bytes.of_string
 let random_key () = random_string 5
 
-let default_artefacts_dir =
-  let ( / ) = Filename.concat in
-  Unix.getcwd () / "_artefacts" / Uuidm.to_string (Uuidm.v `V4)
+let default_artefacts_dir cwd =
+  Eio.Path.(cwd / "_artefacts" / Uuidm.to_string (Uuidm.v `V4))
 
 let prepare_artefacts_dir path =
-  let rec mkdir_p path =
-    if Sys.file_exists path then ()
-    else
-      let path' = Filename.dirname path in
-      if path' = path then failwith "Failed to prepare result dir";
-      mkdir_p path';
-      Unix.mkdir path 0o755
-  in
-  mkdir_p path
+  Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path
 
 let with_timer f =
   let t0 = Sys.time () in
@@ -121,27 +112,26 @@ end
 
 module FSHelper = struct
   let file f =
-    try (Unix.stat f).st_size with Unix.Unix_error (Unix.ENOENT, _, _) -> 0
+    (* in MiB *)
+    try
+      Eio.Switch.run @@ fun sw ->
+      let f = Eio.Path.open_in ~sw f in
+      Optint.Int63.to_int (Eio.File.size f)
+    with Eio.Exn.Io (Eio.Fs.E (Not_found _), _) -> 0
 
   let dict root = file (Irmin_pack.Layout.V1_and_v2.dict ~root) / 1024 / 1024
   let pack root = file (Irmin_pack.Layout.V1_and_v2.pack ~root) / 1024 / 1024
 
   let index root =
-    let index_dir = Filename.concat root "index" in
-    let a = file (Filename.concat index_dir "data") in
-    let b = file (Filename.concat index_dir "log") in
-    let c = file (Filename.concat index_dir "log_async") in
+    let index_dir = Eio.Path.(root / "index") in
+    let a = file Eio.Path.(index_dir / "data") in
+    let b = file Eio.Path.(index_dir / "log") in
+    let c = file Eio.Path.(index_dir / "log_async") in
     (a + b + c) / 1024 / 1024
 
   let size root = dict root + pack root + index root
   let get_size root = size root
-
-  let rm_dir root =
-    if Sys.file_exists root then (
-      let cmd = Printf.sprintf "rm -rf %s" root in
-      [%logs.info "exec: %s" cmd];
-      let _ = Sys.command cmd in
-      ())
+  let rm_dir root = Eio.Path.rmtree ~missing_ok:true root
 end
 
 module Generate_trees

diff --git a/bench/irmin-pack/bench_common.mli b/bench/irmin-pack/bench_common.mli
@@ -16,8 +16,8 @@
 
 module Mtime : module type of Import.Mtime
 
-val default_artefacts_dir : string
-val prepare_artefacts_dir : string -> unit
+val default_artefacts_dir : Eio.Fs.dir_ty Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t
+val prepare_artefacts_dir : Eio.Fs.dir_ty Eio.Path.t -> unit
 val reporter : ?prefix:string -> unit -> Logs.reporter
 val setup_log : Fmt.style_renderer option -> Logs.level option -> unit
 val reset_stats : unit -> unit
@@ -36,8 +36,8 @@ module Conf : Irmin_pack.Conf.S
 module Schema : Irmin.Schema.S
 
 module FSHelper : sig
-  val rm_dir : string -> unit
-  val get_size : string -> int
+  val rm_dir : Eio.Fs.dir_ty Eio.Path.t -> unit
+  val get_size : Eio.Fs.dir_ty Eio.Path.t -> int
 end
 
 module Generate_trees

diff --git a/bench/irmin-pack/dune b/bench/irmin-pack/dune
@@ -80,7 +80,7 @@
 (executable
  (name trace_stats)
  (modules trace_stats)
- (libraries cmdliner irmin_traces))
+ (libraries cmdliner irmin_traces eio_main))
 
 ;; Require the executables to compile during tests
 

diff --git a/bench/irmin-pack/main.ml b/bench/irmin-pack/main.ml
@@ -33,15 +33,19 @@ module Bench = Irmin_bench.Make (KV)
 
 let file f =
   (* in MiB *)
-  try (Unix.stat f).st_size / 1024 / 1024
-  with Unix.Unix_error (Unix.ENOENT, _, _) -> 0
+  try
+    Eio.Switch.run @@ fun sw ->
+    let open Optint.Int63 in
+    let f = Eio.Path.open_in ~sw f in
+    Infix.(to_int @@ (Eio.File.size f / of_int 1024 / of_int 1024))
+  with Eio.Exn.Io (Eio.Fs.E (Not_found _), _) -> 0
 
 let index root =
   let rec aux acc i =
     if i = 256 then acc
     else
       let filename = Format.sprintf "store.index.%d" i in
-      let s = file (Filename.concat root filename) in
+      let s = file Eio.Path.(root / filename) in
       aux (acc + s) (i + 1)
   in
   aux 0 0
@@ -52,4 +56,4 @@ let size ~root =
   |> List.map file
   |> List.fold_left ( + ) index_size
 
-let () = Bench.run ~config ~size
+let () = Eio_main.run @@ fun env -> Bench.run ~env ~config ~size
diff --git a/bench/irmin-pack/trace_collection.ml b/bench/irmin-pack/trace_collection.ml
@@ -167,7 +167,7 @@ module Make_stat (Store : Irmin.Generic_key.KV) = struct
         }
   end
 
-  let create_file : string -> Def.config -> string -> t =
+  let create_file : Eio.Fs.dir_ty Eio.Path.t -> Def.config -> string -> t =
    fun path config store_path ->
     let header =
       Def.

diff --git a/bench/irmin-pack/trace_common.ml b/bench/irmin-pack/trace_common.ml
@@ -228,8 +228,10 @@ module Io (Ff : File_format) = struct
     in
     Seq.unfold produce_row ()
 
-  let open_reader : string -> Ff.Latest.header * Ff.Latest.row Seq.t =
+  let open_reader :
+      Eio.Fs.dir_ty Eio.Path.t -> Ff.Latest.header * Ff.Latest.row Seq.t =
    fun path ->
+    let path = Eio.Path.native_exn path in
     let chan = open_in_bin path in
     let len = LargeFile.in_channel_length chan in
     if len < 12L then
@@ -260,6 +262,7 @@ module Io (Ff : File_format) = struct
   type writer = { path : string; channel : out_channel; buffer : Buffer.t }
 
   let create_file path header =
+    let path = Eio.Path.native_exn path in
     let channel = open_out path in
     let buffer = Buffer.create 0 in
     output_string channel (Magic.to_string Ff.magic);

diff --git a/bench/irmin-pack/trace_replay.ml b/bench/irmin-pack/trace_replay.ml
@@ -370,7 +370,7 @@ module Make (Store : Store) = struct
     let really_add_volume = time_to_add_volume in
     (really_wait_gc, really_start_gc, really_split, really_add_volume)
 
-  let add_commits ~domain_mgr config repo commit_seq on_commit on_end stats
+  let add_commits ~fs ~domain_mgr config repo commit_seq on_commit on_end stats
       check_hash empty_blobs =
     let max_ncommits = config.number_of_commits_to_replay in
     with_progress_bar ~message:"Replaying trace" ~n:max_ncommits ~unit:"commit"
@@ -444,7 +444,7 @@ module Make (Store : Store) = struct
                       commit_duration duration finalise_duration]
                 | Error s -> failwith s
               in
-              Store.gc_run ~domain_mgr ~finished repo gc_commit_key)
+              Store.gc_run ~fs ~domain_mgr ~finished repo gc_commit_key)
           in
           let () = add_operations t repo ops i stats check_hash empty_blobs in
           t.latest_commit_idx <- i;
@@ -465,8 +465,14 @@ module Make (Store : Store) = struct
     in
     aux commit_seq 0
 
-  let run : type a. domain_mgr:_ Eio.Domain_manager.t -> _ -> a config -> a =
-   fun ~domain_mgr ext_config config ->
+  let run :
+      type a.
+      fs:Eio.Fs.dir_ty Eio.Path.t ->
+      domain_mgr:_ Eio.Domain_manager.t ->
+      _ ->
+      a config ->
+      a =
+   fun ~fs ~domain_mgr ext_config config ->
     let check_hash =
       config.path_conversion = `None
       && config.inode_config = (32, 256)
@@ -480,10 +486,10 @@ module Make (Store : Store) = struct
       open_commit_sequence config.number_of_commits_to_replay
         config.path_conversion config.replay_trace_path
     in
-    let root = Filename.concat config.artefacts_path "root" in
-    let repo, on_commit, on_end = Store.create_repo ~sw ~root ext_config in
+    let root = Eio.Path.(config.artefacts_path / "root") in
+    let repo, on_commit, on_end = Store.create_repo ~sw ~fs ~root ext_config in
     prepare_artefacts_dir config.artefacts_path;
-    let stat_path = Filename.concat config.artefacts_path "stat_trace.repr" in
+    let stat_path = Eio.Path.(config.artefacts_path / "stat_trace.repr") in
     let c =
       let entries, stable_hash = config.inode_config in
       Trace_definitions.Stat_trace.
@@ -492,19 +498,21 @@ module Make (Store : Store) = struct
             `Replay
               {
                 path_conversion = config.path_conversion;
-                artefacts_dir = config.artefacts_path;
+                artefacts_dir = Eio.Path.native_exn config.artefacts_path;
               };
           inode_config = (entries, entries, stable_hash);
           store_type = config.store_type;
         }
     in
-    let stats = Stat_collector.create_file stat_path c root in
+    let stats =
+      Stat_collector.create_file stat_path c (Eio.Path.native_exn root)
+    in
     Irmin_pack.Stats.reset_stats ();
     Fun.protect
       (fun () ->
         let block_count =
-          add_commits ~domain_mgr config repo commit_seq on_commit on_end stats
-            check_hash config.empty_blobs
+          add_commits ~fs ~domain_mgr config repo commit_seq on_commit on_end
+            stats check_hash config.empty_blobs
         in
         [%logs.app "Closing repo..."];
         let () = Store.Repo.close repo in
@@ -516,7 +524,7 @@ module Make (Store : Store) = struct
             Trace_stat_summary.summarise ~block_count stat_path)
       ~finally:(fun () ->
         if config.keep_stat_trace then (
-          [%logs.app "Stat trace kept at %s" stat_path];
-          Unix.chmod stat_path 0o444)
+          [%logs.app "Stat trace kept at %s" (Eio.Path.native_exn stat_path)];
+          Unix.chmod (Eio.Path.native_exn stat_path) 0o444)
         else Stat_collector.remove stats)
 end
diff --git a/bench/irmin-pack/trace_replay_intf.ml b/bench/irmin-pack/trace_replay_intf.ml
@@ -24,8 +24,8 @@ module Config = struct
     path_conversion : [ `None | `V1 | `V0_and_v1 | `V0 ];
     inode_config : int * int;
     store_type : [ `Pack | `Pack_layered | `Pack_mem ];
-    replay_trace_path : string;
-    artefacts_path : string;
+    replay_trace_path : Eio.Fs.dir_ty Eio.Path.t;
+    artefacts_path : Eio.Fs.dir_ty Eio.Path.t;
     keep_store : bool;
     keep_stat_trace : bool;
     empty_blobs : bool;
@@ -101,7 +101,8 @@ module type Store = sig
 
   val create_repo :
     sw:Eio.Switch.t ->
-    root:string ->
+    fs:Eio.Fs.dir_ty Eio.Path.t ->
+    root:Eio.Fs.dir_ty Eio.Path.t ->
     store_config ->
     Repo.t * on_commit * on_end
 
@@ -112,6 +113,7 @@ module type Store = sig
   type stats := Irmin_pack_unix.Stats.Latest_gc.stats
 
   val gc_run :
+    fs:Eio.Fs.dir_ty Eio.Path.t ->
     domain_mgr:_ Eio.Domain_manager.t ->
     ?finished:((stats, string) result -> unit) ->
     repo ->
@@ -134,6 +136,10 @@ module type Sigs = sig
          and type 'a config = 'a config
 
     val run :
-      domain_mgr:_ Eio.Domain_manager.t -> Store.store_config -> 'a config -> 'a
+      fs:Eio.Fs.dir_ty Eio.Path.t ->
+      domain_mgr:_ Eio.Domain_manager.t ->
+      Store.store_config ->
+      'a config ->
+      'a
   end
 end
diff --git a/bench/irmin-pack/trace_stat_summary.ml b/bench/irmin-pack/trace_stat_summary.ml
@@ -1098,6 +1098,7 @@ let summarise ?block_count trace_stat_path =
 (* Section 4/4 - Conversion from summary to json file *)
 
 let save_to_json v path =
+  let path = Eio.Path.native_exn path in
   let j = Fmt.str "%a\n" (Irmin.Type.pp_json t) v in
   let chan = open_out path in
   output_string chan j;

diff --git a/bench/irmin-pack/trace_stats.ml b/bench/irmin-pack/trace_stats.ml
@@ -29,9 +29,10 @@ let summarise path =
   Summary.(summarise path |> Fmt.pr "%a\n" (Irmin.Type.pp_json t))
 
 let class_of_path p =
-  let chan = open_in_bin p in
+  let path = Eio.Path.native_exn p in
+  let chan = open_in_bin path in
   if in_channel_length chan < 8 then
-    Fmt.invalid_arg "File \"%s\" should be a stat trace or a json." p;
+    Fmt.invalid_arg "File \"%s\" should be a stat trace or a json." path;
   let magic = really_input_string chan 8 in
   close_in chan;
   if is_trace_magic magic then
@@ -44,13 +45,13 @@ let class_of_path p =
     in
     `Trace block_count
   else
-    let chan = open_in_bin p in
+    let chan = open_in_bin path in
     let raw = really_input_string chan (in_channel_length chan) in
     close_in chan;
     match Irmin.Type.of_json_string Summary.t raw with
     | Error (`Msg msg) ->
         Fmt.invalid_arg
-          "File \"%s\" should be a stat trace or a json.\nError: %s" p msg
+          "File \"%s\" should be a stat trace or a json.\nError: %s" path msg
     | Ok s -> `Summary s
 
 let pp name_per_path paths cols_opt =
@@ -120,23 +121,41 @@ let summary_to_cb path =
 
 open Cmdliner
 
-let term_summarise =
+let eio_path fs =
+  let parse s = Ok Eio.Path.(fs / s) in
+  let print = Eio.Path.pp in
+  Arg.conv ~docv:"PATH" (parse, print)
+
+let term_summarise fs =
   let stat_trace_file =
     let doc = Arg.info ~docv:"PATH" ~doc:"A stat trace file" [] in
-    Arg.(required @@ pos 0 (some string) None doc)
+    Arg.(required @@ pos 0 (some (eio_path fs)) None doc)
   in
   Term.(const summarise $ stat_trace_file)
 
-let term_pp =
+let eio_file fs =
+  let parse s =
+    let path = Eio.Path.(fs / s) in
+    match Eio.Path.kind ~follow:true path with
+    | `Regular_file -> Ok path
+    | `Not_found -> Error (`Msg (Format.sprintf "no file %s" s))
+    | _ -> Error (`Msg (Format.sprintf "%s is a directory" s))
+  in
+  let print = Eio.Path.pp in
+  Arg.conv ~docv:"PATH" (parse, print)
+
+let term_pp fs =
   let arg_indexed_files =
     let open Arg in
-    let a = pos_all non_dir_file [] (info [] ~docv:"FILE") in
+    let a = pos_all (eio_file fs) [] (info [] ~docv:"FILE") in
     value a
   in
   let arg_named_files =
     let open Arg in
     let a =
-      opt_all (pair string non_dir_file) []
+      opt_all
+        (pair string (eio_file fs))
+        []
         (info [ "f"; "named-file" ]
            ~doc:
              "A comma-separated pair of short name / path to trace or summary. \
@@ -208,6 +227,9 @@ let () =
   let l =
     deprecated_info ~man ~doc:"Summary JSON to Continous Benchmarks JSON" "cb"
   in
+  Eio_main.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
   deprecated_exit
-  @@ deprecated_eval_choice (term_summarise, i)
-       [ (term_summarise, j); (term_pp, k); (term_cb, l) ]
+  @@ deprecated_eval_choice
+       (term_summarise fs, i)
+       [ (term_summarise fs, j); (term_pp fs, k); (term_cb, l) ]