From b58d26e32e582f1a53b7ebc475e05353a63f4433 Mon Sep 17 00:00:00 2001 From: gwenaelle Date: Tue, 26 Mar 2024 17:40:24 +0100 Subject: [PATCH] Fix tests --- bench/irmin-pack/bench_common.ml | 38 ++- bench/irmin-pack/bench_common.mli | 8 +- bench/irmin-pack/dune | 2 +- bench/irmin-pack/main.ml | 12 +- bench/irmin-pack/trace_collection.ml | 2 +- bench/irmin-pack/trace_common.ml | 5 +- bench/irmin-pack/trace_replay.ml | 34 +-- bench/irmin-pack/trace_replay_intf.ml | 14 +- bench/irmin-pack/trace_stat_summary.ml | 1 + bench/irmin-pack/trace_stats.ml | 44 +++- bench/irmin-pack/tree.ml | 122 +++++----- examples/irmin-pack/gc.ml | 23 +- examples/irmin-pack/kv.ml | 8 +- src/irmin-pack-tools/tezos_explorer/main.ml | 25 +- src/irmin-pack-tools/tezos_explorer/parse.ml | 3 +- src/irmin-pack-tools/tezos_explorer/show.ml | 3 +- src/irmin-pack/conf.ml | 8 +- src/irmin-pack/conf.mli | 4 +- src/irmin-pack/io/checks.ml | 25 +- src/irmin-pack/io/checks_intf.ml | 19 +- src/irmin-pack/io/control_file.ml | 2 +- src/irmin-pack/io/file_manager.ml | 8 +- src/irmin-pack/io/file_manager_intf.ml | 1 + src/irmin-pack/io/gc.ml | 6 +- src/irmin-pack/io/gc.mli | 3 +- src/irmin-pack/io/gc_worker.ml | 10 +- src/irmin-pack/io/gc_worker.mli | 3 +- src/irmin-pack/io/store.ml | 34 +-- src/irmin-pack/io/store_intf.ml | 3 + src/irmin-pack/irmin_pack_intf.ml | 4 +- src/irmin-test/irmin_bench.ml | 19 +- src/irmin-test/irmin_bench.mli | 5 +- test/irmin-bench/replay.ml | 62 +++-- test/irmin-bench/test.ml | 4 +- test/irmin-pack/bench_multicore/bench.ml | 28 +-- test/irmin-pack/bench_multicore/main.ml | 4 +- test/irmin-pack/common.ml | 33 +-- test/irmin-pack/common.mli | 47 +++- test/irmin-pack/test.ml | 6 +- test/irmin-pack/test_corrupted.ml | 9 +- test/irmin-pack/test_dispatcher.ml | 5 +- test/irmin-pack/test_existing_stores.ml | 151 ++++++------ test/irmin-pack/test_flush_reload.ml | 40 ++-- test/irmin-pack/test_gc.ml | 234 ++++++++++--------- test/irmin-pack/test_gc.mli | 7 +- test/irmin-pack/test_hashes.ml | 36 +-- test/irmin-pack/test_hashes.mli | 2 +- test/irmin-pack/test_indexing_strategy.ml | 3 +- test/irmin-pack/test_inode.ml | 9 +- test/irmin-pack/test_lower.ml | 98 ++++---- test/irmin-pack/test_multicore.ml | 14 +- test/irmin-pack/test_pack.ml | 226 +++++++++--------- test/irmin-pack/test_pack.mli | 7 +- test/irmin-pack/test_pack_version_bump.ml | 60 +++-- test/irmin-pack/test_pack_version_bump.mli | 2 +- test/irmin-pack/test_readonly.ml | 40 ++-- test/irmin-pack/test_readonly.mli | 2 +- test/irmin-pack/test_snapshot.ml | 59 +++-- test/irmin-pack/test_tree.ml | 70 +++--- test/irmin-pack/test_upgrade.ml | 106 +++++---- test/irmin-tezos/generate.ml | 46 ++-- test/irmin-tezos/irmin_fsck.ml | 6 +- test/irmin/test_tree.ml | 3 - 63 files changed, 1075 insertions(+), 842 deletions(-) diff --git a/bench/irmin-pack/bench_common.ml b/bench/irmin-pack/bench_common.ml index 771ce98df2..ecb67485b4 100644 --- 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 index 57f247bbf3..8a77002dee 100644 --- 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 index 487bb2cbff..cdcd8ea36f 100644 --- 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 index 828480924f..275a1b5a0f 100644 --- 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 index fcd1bc6be5..b9b216a548 100644 --- 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 index ce2773d0cd..2aa888d732 100644 --- 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 index 602cb86fc3..665a3712fc 100644 --- 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 index 63b47af254..f33a30f660 100644 --- 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 index 74ef2429b0..69824a2210 100644 --- 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 index 6ad6d53598..9840a949f9 100644 --- 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) ] diff --git a/bench/irmin-pack/tree.ml b/bench/irmin-pack/tree.ml index bfa50ba3bf..4846456ad4 100644 --- a/bench/irmin-pack/tree.ml +++ b/bench/irmin-pack/tree.ml @@ -25,13 +25,13 @@ type config = { nchain_trees : int; width : int; nlarge_trees : int; - store_dir : string; + store_dir : Eio.Fs.dir_ty Eio.Path.t; path_conversion : [ `None | `V1 | `V0_and_v1 | `V0 ]; inode_config : int * int; store_type : [ `Pack | `Pack_mem ]; freeze_commit : int; - 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; no_summary : bool; @@ -58,7 +58,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 @@ -68,6 +69,7 @@ module type Store = sig val add_volume : repo -> unit val gc_run : + fs:Eio.Fs.dir_ty Eio.Path.t -> domain_mgr:_ Eio.Domain_manager.t -> ?finished:((stats, string) result -> unit) -> repo -> @@ -130,11 +132,11 @@ module Bench_suite (Store : Store) = struct in aux None 0 - let run_large config = + let run_large ~fs config = reset_stats (); Eio.Switch.run @@ fun sw -> let root = config.store_dir in - let repo, on_commit, on_end = Store.create_repo ~sw ~root config in + let repo, on_commit, on_end = Store.create_repo ~sw ~fs ~root config in let result, () = Trees.add_large_trees config.width config.nlarge_trees |> add_commits ~message:"Playing large mode" repo config.ncommits @@ -151,11 +153,11 @@ module Bench_suite (Store : Store) = struct config.ncommits config.nlarge_trees config.width Benchmark.pp_results result - let run_chains config = + let run_chains ~fs config = reset_stats (); Eio.Switch.run @@ fun sw -> let root = config.store_dir in - let repo, on_commit, on_end = Store.create_repo ~sw ~root config in + let repo, on_commit, on_end = Store.create_repo ~sw ~fs ~root config in let result, () = Trees.add_chain_trees config.depth config.nchain_trees |> add_commits ~message:"Playing chain mode" repo config.ncommits @@ -172,7 +174,7 @@ module Bench_suite (Store : Store) = struct config.ncommits config.nchain_trees config.depth Benchmark.pp_results result - let run_read_trace ~domain_mgr config = + let run_read_trace ~fs ~domain_mgr config = let replay_config : _ Irmin_traces.Trace_replay.config = { number_of_commits_to_replay = config.number_of_commits_to_replay; @@ -194,15 +196,15 @@ module Bench_suite (Store : Store) = struct in if config.no_summary then let () = - Trace_replay.run ~domain_mgr config + Trace_replay.run ~fs ~domain_mgr config { replay_config with return_type = Unit } in fun _ppf -> () else - let summary = Trace_replay.run ~domain_mgr config replay_config in + let summary = Trace_replay.run ~fs ~domain_mgr config replay_config in fun ppf -> if not config.no_summary then ( - let p = Filename.concat config.artefacts_path "stat_summary.json" in + let p = Eio.Path.(config.artefacts_path / "stat_summary.json") in Trace_stat_summary.save_to_json summary p; Format.fprintf ppf "%a" (Trace_stat_summary_pp.pp 5) @@ -223,12 +225,12 @@ module Make_store_mem (Conf : Irmin_pack.Conf.S) = struct let indexing_strategy = Irmin_pack.Indexing_strategy.minimal - let create_repo ~sw ~root _config = + let create_repo ~sw ~fs ~root _config = let conf = Irmin_pack.config ~readonly:false ~fresh:true ~indexing_strategy root in prepare_artefacts_dir root; - let repo = Store.Repo.v ~sw conf in + let repo = Store.Repo.v ~sw ~fs conf in let on_commit _ _ = () in let on_end () = () in (repo, on_commit, on_end) @@ -236,7 +238,7 @@ module Make_store_mem (Conf : Irmin_pack.Conf.S) = struct let split _repo = () let add_volume _repo = () let gc_wait _repo = () - let gc_run ~domain_mgr:_ ?finished:_ _repo _key = () + let gc_run ~fs:_ ~domain_mgr:_ ?finished:_ _repo _key = () end module Make_store_pack (Conf : Irmin_pack.Conf.S) = struct @@ -253,9 +255,9 @@ module Make_store_pack (Conf : Irmin_pack.Conf.S) = struct let indexing_strategy = Irmin_pack.Indexing_strategy.minimal - let create_repo ~sw ~root (config : store_config) = + let create_repo ~sw ~fs ~root (config : store_config) = let lower_root = - if config.add_volume_every > 0 then Some (Filename.concat root "lower") + if config.add_volume_every > 0 then Some Eio.Path.(root / "lower") else None in let conf = @@ -263,7 +265,7 @@ module Make_store_pack (Conf : Irmin_pack.Conf.S) = struct ~lower_root root in prepare_artefacts_dir root; - let repo = Store.Repo.v ~sw conf in + let repo = Store.Repo.v ~sw ~fs conf in let on_commit _ _ = () in let on_end () = () in (repo, on_commit, on_end) @@ -275,13 +277,13 @@ module Make_store_pack (Conf : Irmin_pack.Conf.S) = struct let r = Store.Gc.wait repo in match r with Ok _ -> () | Error (`Msg err) -> failwith err - let gc_run ~domain_mgr ?(finished = fun _ -> ()) repo key = + let gc_run ~fs ~domain_mgr ?(finished = fun _ -> ()) repo key = let f (result : (_, Store.Gc.msg) result) = match result with | Error (`Msg err) -> finished @@ Error err | Ok stats -> finished @@ Ok stats in - let launched = Store.Gc.run ~domain_mgr ~finished:f repo key in + let launched = Store.Gc.run ~fs ~domain_mgr ~finished:f repo key in match launched with | Ok true -> () | Ok false -> [%logs.app "GC skipped"] @@ -289,11 +291,18 @@ module Make_store_pack (Conf : Irmin_pack.Conf.S) = struct end module type B = sig - val run_large : config -> Format.formatter -> unit - val run_chains : config -> Format.formatter -> unit + val run_large : + fs:Eio.Fs.dir_ty Eio.Path.t -> config -> Format.formatter -> unit + + val run_chains : + fs:Eio.Fs.dir_ty Eio.Path.t -> config -> Format.formatter -> unit val run_read_trace : - domain_mgr:_ Eio.Domain_manager.t -> config -> Format.formatter -> unit + fs:Eio.Fs.dir_ty Eio.Path.t -> + domain_mgr:_ Eio.Domain_manager.t -> + config -> + Format.formatter -> + unit end let store_of_config config = @@ -314,7 +323,7 @@ type suite_elt = { run : config -> Format.formatter -> unit; } -let suite ~domain_mgr : suite_elt list = +let suite ~fs ~domain_mgr : suite_elt list = List.rev [ { @@ -326,7 +335,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (32, 256); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_read_trace ~domain_mgr config); + Store.run_read_trace ~fs ~domain_mgr config); }; { mode = `Read_trace; @@ -337,7 +346,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (32, 256); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_read_trace ~domain_mgr config); + Store.run_read_trace ~fs ~domain_mgr config); }; { mode = `Chains; @@ -348,7 +357,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (32, 256); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_chains config); + Store.run_chains ~fs config); }; { mode = `Chains; @@ -359,7 +368,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (2, 5); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_chains config); + Store.run_chains ~fs config); }; { mode = `Large; @@ -370,7 +379,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (32, 256); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_large config); + Store.run_large ~fs config); }; { mode = `Large; @@ -381,7 +390,7 @@ let suite ~domain_mgr : suite_elt list = { config with inode_config = (2, 5); store_type = `Pack } in let (module Store) = store_of_config config in - Store.run_large config); + Store.run_large ~fs config); }; { mode = `Read_trace; @@ -389,11 +398,11 @@ let suite ~domain_mgr : suite_elt list = run = (fun config -> let (module Store) = store_of_config config in - Store.run_read_trace ~domain_mgr config); + Store.run_read_trace ~fs ~domain_mgr config); }; ] -let get_suite ~domain_mgr suite_filter = +let get_suite ~fs ~domain_mgr suite_filter = List.filter (fun { mode; speed; _ } -> match (suite_filter, speed, mode) with @@ -410,9 +419,9 @@ let get_suite ~domain_mgr suite_filter = | (`Slow | `Quick | `Custom_trace | `Custom_chains | `Custom_large), _, _ -> false) - (suite ~domain_mgr) + (suite ~fs ~domain_mgr) -let main () ncommits number_of_commits_to_replay suite_filter inode_config +let main ~fs () ncommits number_of_commits_to_replay suite_filter inode_config store_type freeze_commit path_conversion depth width nchain_trees nlarge_trees replay_trace_path artefacts_path keep_store keep_stat_trace no_summary empty_blobs gc_every gc_distance_in_the_past gc_wait_after @@ -425,7 +434,7 @@ let main () ncommits number_of_commits_to_replay suite_filter inode_config { ncommits; number_of_commits_to_replay; - store_dir = Filename.concat artefacts_path "store"; + store_dir = Eio.Path.(artefacts_path / "store"); path_conversion; depth; width; @@ -454,20 +463,19 @@ let main () ncommits number_of_commits_to_replay suite_filter inode_config FSHelper.rm_dir config.store_dir; Eio_main.run @@ fun env -> let domain_mgr = Eio.Stdenv.domain_mgr env in - let suite = get_suite ~domain_mgr suite_filter in + let suite = get_suite ~fs ~domain_mgr suite_filter in let run_benchmarks () = List.map (fun b -> b.run config) suite in let results = Fun.protect run_benchmarks ~finally:(fun () -> if keep_store then ( - [%logs.app "Store kept at %s" config.store_dir]; - let ( / ) = Filename.concat in + [%logs.app "Store kept at %s" (Eio.Path.native_exn config.store_dir)]; let ro p = if Sys.file_exists p then Unix.chmod p 0o444 in - ro (config.store_dir / "store.branches"); - ro (config.store_dir / "store.dict"); - ro (config.store_dir / "store.pack"); - ro (config.store_dir / "index" / "data"); - ro (config.store_dir / "index" / "log"); - ro (config.store_dir / "index" / "log_async")) + ro Eio.Path.(native_exn @@ (config.store_dir / "store.branches")); + ro Eio.Path.(native_exn @@ (config.store_dir / "store.dict")); + ro Eio.Path.(native_exn @@ (config.store_dir / "store.pack")); + ro Eio.Path.(native_exn @@ (config.store_dir / "index" / "data")); + ro Eio.Path.(native_exn @@ (config.store_dir / "index" / "log")); + ro Eio.Path.(native_exn @@ (config.store_dir / "index" / "log_async"))) else FSHelper.rm_dir config.store_dir) in [%logs.app "%a@." Fmt.(list ~sep:(any "@\n@\n") (fun ppf f -> f ppf)) results] @@ -587,18 +595,23 @@ let nlarge_trees = in Arg.(value @@ opt int 1 doc) -let replay_trace_path = +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 replay_trace_path fs = let doc = Arg.info ~docv:"PATH" ~doc:"Trace of Tezos operations to be replayed." [] in - Arg.(required @@ pos 0 (some string) None doc) + Arg.(required @@ pos 0 (some (eio_path fs)) None doc) -let artefacts_path = +let artefacts_path fs cwd = let doc = Arg.info ~docv:"PATH" ~doc:"Destination of the bench artefacts." [ "artefacts" ] in - Arg.(value @@ opt string default_artefacts_dir doc) + Arg.(value @@ opt (eio_path fs) (default_artefacts_dir cwd) doc) let setup_log = Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) @@ -628,9 +641,9 @@ let add_volume_every = let doc = Arg.info ~doc:"Add volume ever N GCs" [ "add-volume-every" ] in Arg.(value @@ opt int 0 doc) -let main_term = +let main_term fs cwd = Term.( - const main + const (main ~fs) $ setup_log $ ncommits $ number_of_commits_to_replay @@ -643,8 +656,8 @@ let main_term = $ width $ nchain_trees $ nlarge_trees - $ replay_trace_path - $ artefacts_path + $ replay_trace_path fs + $ artefacts_path fs cwd $ keep_store $ keep_stat_trace $ no_summary @@ -679,4 +692,7 @@ let () = let info = deprecated_info ~man ~doc:"Benchmarks for tree operations" "tree" in - deprecated_exit @@ deprecated_eval (main_term, info) + Eio_main.run @@ fun env -> + let fs = Eio.Stdenv.fs env in + let cwd = Eio.Stdenv.cwd env in + deprecated_exit @@ deprecated_eval (main_term fs cwd, info) diff --git a/examples/irmin-pack/gc.ml b/examples/irmin-pack/gc.ml index c626beab70..fd936f8874 100644 --- a/examples/irmin-pack/gc.ml +++ b/examples/irmin-pack/gc.ml @@ -61,7 +61,7 @@ module Repo_config = struct (** Location on disk to save the repository Note: irmin-pack will not create the entire path, only the final directory *) - let root = "./irmin-pack-example" + let root fs = Eio.Path.(fs / "./irmin-pack-example") (** See {!Irmin_pack.Conf} for more keys that can be used when initialising the repository config *) @@ -71,19 +71,19 @@ module Repo_config = struct let fresh = true (** Create config for our repository *) - let config = + let config fs = Irmin_pack.config ~fresh ~index_log_size ~merge_throttle ~indexing_strategy - root + (root fs) (** We can add an optional lower layer to our repository. Data discarded by the GC will be stored there and still be accessible instead of being deleted. *) - let lower_root = Some "./irmin-pack-example-lower" + let lower_root fs = Some Eio.Path.(fs / "./irmin-pack-example-lower") (** Create a copy of the previous configuration, now with a lower layer *) - let config_with_lower = + let config_with_lower fs = Irmin_pack.config ~fresh ~index_log_size ~merge_throttle ~indexing_strategy - ~lower_root root + ~lower_root:(lower_root fs) (root fs) end (** Utility for creating commit info *) @@ -121,7 +121,7 @@ end (** Demonstrate running GC on a previous commit aligned to the end of a chunk for ideal GC space reclamation. *) -let run_gc domain_mgr config repo tracker = +let run_gc fs domain_mgr config repo tracker = let () = match Tracker.(tracker.next_gc_commit) with | None -> () @@ -148,7 +148,7 @@ let run_gc domain_mgr config repo tracker = in (* Launch GC *) let commit_key = Store.Commit.key commit in - let launched = Store.Gc.run ~domain_mgr ~finished repo commit_key in + let launched = Store.Gc.run ~fs ~domain_mgr ~finished repo commit_key in match launched with | Ok false -> () | Ok true -> @@ -180,7 +180,7 @@ let run_experiment env config = in Tracker.update_latest_commit tracker commit; let _ = - if i mod gc_every = 0 then run_gc domain_mgr config repo tracker + if i mod gc_every = 0 then run_gc fs domain_mgr config repo tracker in if i >= n then () else loop (i + 1) n in @@ -192,7 +192,8 @@ let run_experiment env config = let () = Eio_main.run @@ fun env -> + let fs = Eio.Stdenv.fs env in Printf.printf "== RUN 1: deleting discarded data ==\n"; - run_experiment env Repo_config.config; + run_experiment env (Repo_config.config fs); Printf.printf "== RUN 2: archiving discarded data ==\n"; - run_experiment env Repo_config.config_with_lower + run_experiment env (Repo_config.config_with_lower fs) diff --git a/examples/irmin-pack/kv.ml b/examples/irmin-pack/kv.ml index 7586d06a62..d130c51238 100644 --- a/examples/irmin-pack/kv.ml +++ b/examples/irmin-pack/kv.ml @@ -50,7 +50,7 @@ module Repo_config = struct (** Location on disk to save the repository Note: irmin-pack will not create the entire path, only the final directory *) - let root = "./irmin-pack-example" + let root fs = Eio.Path.(fs / "./irmin-pack-example") (** See {!Irmin_pack.Conf} for more keys that can be used when initialising the repository config *) @@ -60,9 +60,9 @@ module Repo_config = struct let fresh = true (** Create config for our repository *) - let config = + let config fs = Irmin_pack.config ~fresh ~index_log_size ~merge_throttle ~indexing_strategy - root + (root fs) end module StoreMaker = Irmin_pack_unix.KV (Conf) @@ -73,7 +73,7 @@ let main env = Eio.Switch.run @@ fun sw -> let fs = Eio.Stdenv.fs env in (* Instantiate a repository *) - let repo = Store.Repo.v ~sw ~fs Repo_config.config in + let repo = Store.Repo.v ~sw ~fs (Repo_config.config fs) in (* Get the store from the main branch. *) let store = Store.main repo in diff --git a/src/irmin-pack-tools/tezos_explorer/main.ml b/src/irmin-pack-tools/tezos_explorer/main.ml index 433c14e50a..a016c81fd0 100644 --- a/src/irmin-pack-tools/tezos_explorer/main.ml +++ b/src/irmin-pack-tools/tezos_explorer/main.ml @@ -1,10 +1,15 @@ open Cmdliner (* Common arguments *) -let store_path = +let eio_path root = + let parse s = Ok Eio.Path.(root / s) in + let print = Eio.Path.pp in + Arg.conv ~docv:"PATH" (parse, print) + +let store_path fs = Arg.( value - & opt string "." + & opt (eio_path fs) fs & info [ "store_path" ] ~doc:"the path to the irmin store files, default to `.`") @@ -34,27 +39,27 @@ let index_path = ~doc:"the path to the index file generated, default to `store.index`") (* Command parse *) -let parse_cmd = +let parse_cmd env fs = let doc = "parses a pack file and generates the associated .info & .idx files" in let info = Cmd.info "parse" ~doc in Cmd.v info Term.( - const Parse.main - $ store_path + const (Parse.main env) + $ store_path fs $ info_last_path $ info_next_path $ index_path) (* Command show *) -let show_cmd = +let show_cmd env fs = let doc = "graphical user interface for pack files inspection" in let info = Cmd.info "show" ~doc in Cmd.v info Term.( - const Show.main - $ store_path + const (Show.main env) + $ store_path fs $ info_last_path $ info_next_path $ index_path) @@ -64,6 +69,8 @@ let main_cmd = let doc = "a visual tool for irmin pack files inspection" in let info = Cmd.info "irmin-pack-inspect" ~version:"%%VERSION%%" ~doc in let default = Term.(ret (const (`Help (`Pager, None)))) in - Cmd.group info ~default [ parse_cmd; show_cmd ] + Eio_main.run @@ fun env -> + let fs = Eio.Stdenv.fs env in + Cmd.group info ~default [ parse_cmd env fs; show_cmd env fs ] let () = exit (Cmd.eval ~catch:false main_cmd) diff --git a/src/irmin-pack-tools/tezos_explorer/parse.ml b/src/irmin-pack-tools/tezos_explorer/parse.ml index 312e93f650..e09239dd47 100644 --- a/src/irmin-pack-tools/tezos_explorer/parse.ml +++ b/src/irmin-pack-tools/tezos_explorer/parse.ml @@ -68,8 +68,7 @@ let dump_idxs fd n is is2 = let get_values r = List.filter_map (Ring.get r) [ 1; 10; 1000 ] -let main store_path info_last_path info_next_path idx_path = - Eio_main.run @@ fun env -> +let main env store_path info_last_path info_next_path idx_path = Eio.Switch.run @@ fun sw -> let fs = Eio.Stdenv.fs env in let conf = Irmin_pack.Conf.init store_path in diff --git a/src/irmin-pack-tools/tezos_explorer/show.ml b/src/irmin-pack-tools/tezos_explorer/show.ml index c840741a5f..c696651d9d 100644 --- a/src/irmin-pack-tools/tezos_explorer/show.ml +++ b/src/irmin-pack-tools/tezos_explorer/show.ml @@ -854,8 +854,7 @@ let rec loop t c = loop t c | _ -> loop t c -let main store_path info_last_path info_next_path index_path = - Eio_main.run @@ fun env -> +let main env store_path info_last_path info_next_path index_path = Eio.Switch.run @@ fun sw -> let fs = Eio.Stdenv.fs env in let conf = Irmin_pack.Conf.init store_path in diff --git a/src/irmin-pack/conf.ml b/src/irmin-pack/conf.ml index b0cc16b9d2..e3ec623130 100644 --- a/src/irmin-pack/conf.ml +++ b/src/irmin-pack/conf.ml @@ -128,7 +128,13 @@ let init ?(fresh = Default.fresh) ?(readonly = Default.readonly) ?(merge_throttle = Default.merge_throttle) ?(indexing_strategy = Default.indexing_strategy) ?(use_fsync = Default.use_fsync) ?(no_migrate = Default.no_migrate) - ?(lower_root = Default.lower_root) root = + ?(lower_root = None) root = + let root = Eio.Path.native_exn root in + let lower_root = + match lower_root with + | None -> Default.lower_root + | Some lower_root -> Some (Eio.Path.native_exn lower_root) + in let config = empty spec in let config = add config Key.root root in let config = add config Key.lower_root lower_root in diff --git a/src/irmin-pack/conf.mli b/src/irmin-pack/conf.mli index 4386fa3a2a..3a145dabbd 100644 --- a/src/irmin-pack/conf.mli +++ b/src/irmin-pack/conf.mli @@ -138,8 +138,8 @@ val init : ?indexing_strategy:Indexing_strategy.t -> ?use_fsync:bool -> ?no_migrate:bool -> - ?lower_root:string option -> - string -> + ?lower_root:Eio.Fs.dir_ty Eio.Path.t option -> + Eio.Fs.dir_ty Eio.Path.t -> Irmin.config (** [init root] creates a backend configuration for storing data with default configuration parameters and stored at [root]. Flags are documented above. *) diff --git a/src/irmin-pack/io/checks.ml b/src/irmin-pack/io/checks.ml index d75b99f258..79a9559890 100644 --- a/src/irmin-pack/io/checks.ml +++ b/src/irmin-pack/io/checks.ml @@ -41,10 +41,15 @@ let setup_log = in Cmdliner.Term.(const init $ Fmt_cli.style_renderer () $ Logs_cli.level ()) -let path = +let path fs = let open Cmdliner.Arg in + let eio_path fs = + let parse s = Ok Eio.Path.(fs / s) in + let print = Eio.Path.pp in + conv ~docv:"PATH" (parse, print) + in required - @@ pos 0 (some string) None + @@ pos 0 (some (eio_path fs)) None @@ info ~doc:"Path to the Irmin store on disk" ~docv:"PATH" [] let deprecated_info = (Cmdliner.Term.info [@alert "-deprecated"]) @@ -73,6 +78,7 @@ struct [@@deriving irmin] let traverse_index ~root log_size = + let root = Eio.Path.native_exn root in let index = Index.v_exn ~readonly:true ~fresh:false ~log_size root in let ppf = Format.err_formatter in let bar, (progress_contents, progress_nodes, progress_commits) = @@ -96,14 +102,15 @@ struct let conf root = Conf.init ~readonly:true ~fresh:false ~no_migrate:true root let run ~fs:_ ~root = - [%logs.app "Getting statistics for store: `%s'@," root]; + [%logs.app + "Getting statistics for store: `%s'@," (Eio.Path.native_exn root)]; let log_size = conf root |> Conf.index_log_size in let objects = traverse_index ~root log_size in { hash_size = Bytes Hash.hash_size; log_size; objects } |> Irmin.Type.pp_json ~minify:false t Fmt.stdout let term_internal ~fs = - Cmdliner.Term.(const (fun root () -> run ~fs ~root) $ path) + Cmdliner.Term.(const (fun root () -> run ~fs ~root) $ path fs) let term ~fs = let doc = "Print high-level statistics about the store." in @@ -140,7 +147,7 @@ struct const (fun root output index_log_size () -> Eio.Switch.run (fun sw -> run ~sw ~fs ~root ~output ?index_log_size ())) - $ path + $ path fs $ dest $ index_log_size) @@ -178,7 +185,7 @@ struct Cmdliner.Term.( const (fun root auto_repair always () -> Eio.Switch.run (fun sw -> run ~sw ~fs ~root ~auto_repair ~always ())) - $ path + $ path fs $ auto_repair $ always) @@ -247,7 +254,7 @@ struct Eio.Switch.run (fun sw -> run ~sw ~fs ~ppf:Format.err_formatter ~root ~auto_repair ~always ~heads ())) - $ path + $ path fs $ auto_repair $ always $ heads) @@ -292,7 +299,7 @@ struct Cmdliner.Term.( const (fun root heads () -> Eio.Switch.run (fun sw -> run ~sw ~fs ~root ~heads)) - $ path + $ path fs $ heads) let term ~fs = @@ -350,7 +357,7 @@ struct const (fun root commit dump_blob_paths_to () -> Eio.Switch.run (fun sw -> run ~sw ~fs ~root ~commit ~dump_blob_paths_to ())) - $ path + $ path fs $ commit $ dump_blob_paths_to) diff --git a/src/irmin-pack/io/checks_intf.ml b/src/irmin-pack/io/checks_intf.ml index b1994cf8e7..aee916f6a2 100644 --- a/src/irmin-pack/io/checks_intf.ml +++ b/src/irmin-pack/io/checks_intf.ml @@ -38,7 +38,8 @@ module type S = sig module Stat : sig include Subcommand - with type run := fs:Eio.Fs.dir_ty Eio.Path.t -> root:string -> unit + with type run := + fs:Eio.Fs.dir_ty Eio.Path.t -> root:Eio.Fs.dir_ty Eio.Path.t -> unit (** Internal implementation utilities exposed for use in other integrity checks. *) @@ -48,7 +49,7 @@ module type S = sig type objects = { nb_commits : int; nb_nodes : int; nb_contents : int } [@@deriving irmin] - val traverse_index : root:string -> int -> objects + val traverse_index : root:Eio.Fs.dir_ty Eio.Path.t -> int -> objects end module Reconstruct_index : @@ -56,7 +57,7 @@ module type S = sig with type run := sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> - root:string -> + root:Eio.Fs.dir_ty Eio.Path.t -> output:string option -> ?index_log_size:int -> unit -> @@ -71,7 +72,7 @@ module type S = sig sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> ?ppf:Format.formatter -> - root:string -> + root:Eio.Fs.dir_ty Eio.Path.t -> auto_repair:bool -> always:bool -> heads:string list option -> @@ -94,7 +95,7 @@ module type S = sig with type run := sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> - root:string -> + root:Eio.Fs.dir_ty Eio.Path.t -> auto_repair:bool -> always:bool -> unit -> @@ -108,7 +109,7 @@ module type S = sig with type run := sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> - root:string -> + root:Eio.Fs.dir_ty Eio.Path.t -> heads:string list option -> unit end @@ -120,7 +121,7 @@ module type S = sig with type run := sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> - root:string -> + root:Eio.Fs.dir_ty Eio.Path.t -> commit:string option -> dump_blob_paths_to:string option -> unit -> @@ -152,7 +153,9 @@ module type Sigs = sig type nonrec empty = empty val setup_log : unit Cmdliner.Term.t - val path : string Cmdliner.Term.t + + val path : + Eio.Fs.dir_ty Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t Cmdliner.Term.t module type Subcommand = Subcommand module type S = S diff --git a/src/irmin-pack/io/control_file.ml b/src/irmin-pack/io/control_file.ml index df4d54bc39..b4e99d1119 100644 --- a/src/irmin-pack/io/control_file.ml +++ b/src/irmin-pack/io/control_file.ml @@ -239,7 +239,7 @@ module Serde = struct | Valid (V4 payload) -> Ok (upgrade_from_v4 payload) | Valid (V5 payload) -> Ok payload - (* Similar yo [of_bin_string] but skips version upgrade *) + (* Similar to [of_bin_string] but skips version upgrade *) let raw_of_bin_string = Data.of_bin_string let to_bin_string payload = Data.(to_bin_string (Valid (V5 payload))) end diff --git a/src/irmin-pack/io/file_manager.ml b/src/irmin-pack/io/file_manager.ml index 1ea622db55..419212a4d8 100644 --- a/src/irmin-pack/io/file_manager.ml +++ b/src/irmin-pack/io/file_manager.ml @@ -558,7 +558,9 @@ struct let tmp_dict_path = Layout.dict_tmp ~root in let* dict_file = Io.open_ ~sw ~path:dict_path ~readonly:false in let* len = Io.read_size dict_file in - let* tmp_dict_file = Io.open_ ~sw ~path:tmp_dict_path ~readonly:false in + let* tmp_dict_file = + Io.create ~sw ~path:tmp_dict_path ~overwrite:true + in let contents_len = Int63.to_int len - dead_header_size in let* contents = Io.read_to_string dict_file @@ -996,10 +998,10 @@ struct let lower = t.lower in cleanup ~root ~generation ~chunk_start_idx ~chunk_num ~lower - let create_one_commit_store t config gced commit_key = + let create_one_commit_store ~fs t config gced commit_key = let open Result_syntax in let src_root = t.root in - let dst_root = Eio.Path.(t.root / Irmin_pack.Conf.root config) in + let dst_root = Eio.Path.(fs / Irmin_pack.Conf.root config) in (* Step 1. Copy the dict *) let src_dict = Layout.dict ~root:src_root in let dst_dict = Layout.dict ~root:dst_root in diff --git a/src/irmin-pack/io/file_manager_intf.ml b/src/irmin-pack/io/file_manager_intf.ml index 06a86e1436..c75d73a0fd 100644 --- a/src/irmin-pack/io/file_manager_intf.ml +++ b/src/irmin-pack/io/file_manager_intf.ml @@ -303,6 +303,7 @@ module type S = sig (** Returns where data discarded by the GC will end up. (see {!gc_behaviour}). *) val create_one_commit_store : + fs:Eio.Fs.dir_ty Eio.Path.t -> t -> Irmin.Backend.Conf.t -> Control_file.Payload.Upper.Latest.gced -> diff --git a/src/irmin-pack/io/gc.ml b/src/irmin-pack/io/gc.ml index 06e126a9bc..3bcebb0c69 100644 --- a/src/irmin-pack/io/gc.ml +++ b/src/irmin-pack/io/gc.ml @@ -42,7 +42,7 @@ module Make (Args : Gc_args.S) = struct latest_gc_target_offset : int63; } - let v ~sw ~domain_mgr ~root ~lower_root ~output ~generation ~unlink + let v ~sw ~fs ~domain_mgr ~root ~lower_root ~output ~generation ~unlink ~dispatcher ~fm ~contents ~node ~commit commit_key = let open Result_syntax in let new_suffix_start_offset, latest_gc_target_offset = @@ -113,8 +113,8 @@ module Make (Args : Gc_args.S) = struct (* start worker task *) let task = Async.async ~sw ~domain_mgr (fun () -> - Worker.run_and_output_result root commit_key new_suffix_start_offset - ~lower_root ~generation ~new_files_path) + Worker.run_and_output_result ~fs root commit_key + new_suffix_start_offset ~lower_root ~generation ~new_files_path) in let partial_stats = Gc_stats_main.finish_current_step partial_stats "before finalise" diff --git a/src/irmin-pack/io/gc.mli b/src/irmin-pack/io/gc.mli index ca8cf0280f..3b2938a431 100644 --- a/src/irmin-pack/io/gc.mli +++ b/src/irmin-pack/io/gc.mli @@ -26,9 +26,10 @@ module Make val v : sw:Eio.Switch.t -> + fs:Eio.Fs.dir_ty Eio.Path.t -> domain_mgr:_ Eio.Domain_manager.t -> root:Eio.Fs.dir_ty Eio.Path.t -> - lower_root:string option -> + lower_root:Eio.Fs.dir_ty Eio.Path.t option -> output:[ `External of Eio.Fs.dir_ty Eio.Path.t | `Root ] -> generation:int -> unlink:bool -> diff --git a/src/irmin-pack/io/gc_worker.ml b/src/irmin-pack/io/gc_worker.ml index ee168f3137..76f46a3a7e 100644 --- a/src/irmin-pack/io/gc_worker.ml +++ b/src/irmin-pack/io/gc_worker.ml @@ -211,12 +211,12 @@ module Make (Args : Gc_args.S) = struct type gc_output = (gc_results, Args.Errs.t) result [@@deriving irmin] - let run ~sw ~lower_root ~generation ~new_files_path root commit_key + let run ~sw ~fs ~lower_root ~generation ~new_files_path root commit_key new_suffix_start_offset = let open Result_syntax in let config = Irmin_pack.Conf.init ~fresh:false ~readonly:true ~lru_size:0 ~lower_root - (Eio.Path.native_exn root) + root in (* Step 1. Open the files *) @@ -226,7 +226,7 @@ module Make (Args : Gc_args.S) = struct report_old_file_sizes ~root ~generation:(generation - 1) stats |> ignore in - let fm = Fm.open_ro ~sw ~fs:root config |> Errs.raise_if_error in + let fm = Fm.open_ro ~sw ~fs config |> Errs.raise_if_error in Errors.finalise_exn (fun _outcome -> Fm.close fm |> Errs.log_if_error "GC: Close File_manager") @@ fun () -> @@ -427,13 +427,13 @@ module Make (Args : Gc_args.S) = struct (* No one catches errors when this function terminates. Write the result in a file and terminate. *) - let run_and_output_result ~lower_root ~generation ~new_files_path root + let run_and_output_result ~fs ~lower_root ~generation ~new_files_path root commit_key new_suffix_start_offset = Eio.Switch.run @@ fun sw -> let result = try Errs.catch (fun () -> - run ~sw ~lower_root ~generation ~new_files_path root commit_key + run ~sw ~fs ~lower_root ~generation ~new_files_path root commit_key new_suffix_start_offset) with e -> Format.printf "GC ERROR: %s@." (Printexc.to_string e); diff --git a/src/irmin-pack/io/gc_worker.mli b/src/irmin-pack/io/gc_worker.mli index 7584dabf4d..4e6bc6c0fe 100644 --- a/src/irmin-pack/io/gc_worker.mli +++ b/src/irmin-pack/io/gc_worker.mli @@ -24,7 +24,8 @@ module Make module Args : Gc_args.S val run_and_output_result : - lower_root:string option -> + fs:Eio.Fs.dir_ty Eio.Path.t -> + lower_root:Eio.Fs.dir_ty Eio.Path.t option -> generation:int -> new_files_path:Eio.Fs.dir_ty Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t -> diff --git a/src/irmin-pack/io/store.ml b/src/irmin-pack/io/store.ml index 74bbcbc817..8ec84cc3ea 100644 --- a/src/irmin-pack/io/store.ml +++ b/src/irmin-pack/io/store.ml @@ -256,7 +256,7 @@ struct (Irmin.Type.to_string XKey.t key)) | Some (k, _kind) -> Ok k) - let start ~domain_mgr ~unlink ~use_auto_finalisation ~output t + let start ~fs ~domain_mgr ~unlink ~use_auto_finalisation ~output t commit_key = let open Result_syntax in [%log.info "GC: Starting on %a" pp_key commit_key]; @@ -274,9 +274,13 @@ struct Eio.Mutex.use_rw_exn t.lock @@ fun () -> let current_generation = File_manager.generation t.fm in let next_generation = current_generation + 1 in - let lower_root = Conf.lower_root t.config in + let lower_root = + Option.map + (fun path -> Eio.Path.(t.fs / path)) + (Conf.lower_root t.config) + in let* gc = - Gc.v ~sw:t.sw ~domain_mgr ~root ~lower_root + Gc.v ~sw:t.sw ~fs ~domain_mgr ~root ~lower_root ~generation:next_generation ~unlink ~dispatcher:t.dispatcher ~fm:t.fm ~contents:t.contents ~node:t.node ~commit:t.commit ~output commit_key @@ -284,7 +288,7 @@ struct Atomic.set t.running_gc (Some { gc; use_auto_finalisation }); Ok () - let start_exn ~domain_mgr ?(unlink = true) ?(output = `Root) + let start_exn ~fs ~domain_mgr ?(unlink = true) ?(output = `Root) ~use_auto_finalisation t commit_key = match Atomic.get t.running_gc with | Some _ -> @@ -292,7 +296,7 @@ struct false | None -> ( let result = - start ~domain_mgr ~unlink ~use_auto_finalisation ~output t + start ~fs ~domain_mgr ~unlink ~use_auto_finalisation ~output t commit_key in match result with Ok _ -> true | Error e -> Errs.raise_error e) @@ -359,7 +363,7 @@ struct let key = Pack_key.v_direct ~offset ~length entry.hash in Some key) - let create_one_commit_store ~domain_mgr t commit_key path = + let create_one_commit_store ~fs ~domain_mgr t commit_key path = let () = match Io.classify_path path with | `Directory -> () @@ -373,7 +377,7 @@ struct (* The GC action here does not matter, since we'll not fully finalise it *) let launched = - start_exn ~domain_mgr ~use_auto_finalisation:false + start_exn ~fs ~domain_mgr ~use_auto_finalisation:false ~output:(`External path) t commit_key in let () = @@ -391,7 +395,8 @@ struct (Eio.Path.native_exn path) in let () = - File_manager.create_one_commit_store t.fm config gced commit_key + File_manager.create_one_commit_store ~fs t.fm config gced + commit_key |> Errs.raise_if_error in let branch_path = Irmin_pack.Layout.V4.branch ~root:path in @@ -644,13 +649,14 @@ struct let finalise_exn = X.Repo.Gc.finalise_exn - let start_exn ~domain_mgr ?unlink t = - X.Repo.Gc.start_exn ~domain_mgr ?unlink ~use_auto_finalisation:false t + let start_exn ~fs ~domain_mgr ?unlink t = + X.Repo.Gc.start_exn ~fs ~domain_mgr ?unlink ~use_auto_finalisation:false + t - let start ~domain_mgr repo commit_key = + let start ~fs ~domain_mgr repo commit_key = try let started = - X.Repo.Gc.start_exn ~domain_mgr ~unlink:true + X.Repo.Gc.start_exn ~fs ~domain_mgr ~unlink:true ~use_auto_finalisation:true repo commit_key in Ok started @@ -669,8 +675,8 @@ struct | `Finalised stats -> Ok (Some stats) with exn -> catch_errors "Wait for GC" exn - let run ~domain_mgr ?(finished = fun _ -> ()) repo commit_key = - let started = start ~domain_mgr repo commit_key in + let run ~fs ~domain_mgr ?(finished = fun _ -> ()) repo commit_key = + let started = start ~fs ~domain_mgr repo commit_key in match started with | Ok r -> if r then diff --git a/src/irmin-pack/io/store_intf.ml b/src/irmin-pack/io/store_intf.ml index 2b5a1774fe..00220bac86 100644 --- a/src/irmin-pack/io/store_intf.ml +++ b/src/irmin-pack/io/store_intf.ml @@ -106,6 +106,7 @@ module type S = sig by a readonly instance.*) val create_one_commit_store : + fs:Eio.Fs.dir_ty Eio.Path.t -> domain_mgr:_ Eio.Domain_manager.t -> repo -> commit_key -> @@ -129,6 +130,7 @@ module type S = sig (** {1 Low-level API} *) val start_exn : + fs:Eio.Fs.dir_ty Eio.Path.t -> domain_mgr:_ Eio.Domain_manager.t -> ?unlink:bool -> repo -> @@ -171,6 +173,7 @@ module type S = sig logging *) val run : + fs:Eio.Fs.dir_ty Eio.Path.t -> domain_mgr:_ Eio.Domain_manager.t -> ?finished:((Stats.Latest_gc.stats, msg) result -> unit) -> repo -> diff --git a/src/irmin-pack/irmin_pack_intf.ml b/src/irmin-pack/irmin_pack_intf.ml index edfebbcd26..ab4e12dc57 100644 --- a/src/irmin-pack/irmin_pack_intf.ml +++ b/src/irmin-pack/irmin_pack_intf.ml @@ -79,8 +79,8 @@ module type Sigs = sig ?indexing_strategy:Indexing_strategy.t -> ?use_fsync:bool -> ?no_migrate:bool -> - ?lower_root:string option -> - string -> + ?lower_root:Eio.Fs.dir_ty Eio.Path.t option -> + Eio.Fs.dir_ty Eio.Path.t -> Irmin.config (** Configuration options for stores. See {!Irmin_pack.Conf} for more details. *) diff --git a/src/irmin-test/irmin_bench.ml b/src/irmin-test/irmin_bench.ml index f734784b12..6a708d9596 100644 --- a/src/irmin-test/irmin_bench.ml +++ b/src/irmin-test/irmin_bench.ml @@ -18,7 +18,7 @@ open Irmin.Export_for_backends type t = { - root : string; + root : Eio.Fs.dir_ty Eio.Path.t; ncommits : int; depth : int; tree_add : int; @@ -90,10 +90,11 @@ let clear = let doc = Arg.info ~doc:"Clear the tree after each commit." [ "clear" ] in Arg.(value @@ flag doc) -let t = +let t env = + let fs = Eio.Stdenv.fs env in Term.( const (fun () ncommits depth tree_add display clear gc -> - { ncommits; depth; tree_add; display; root = "."; clear; gc }) + { ncommits; depth; tree_add; display; root = fs; clear; gc }) $ log $ ncommits $ depth @@ -171,8 +172,9 @@ struct Store.Repo.close r; Fmt.epr "\n[run done]\n%!" - let main t config size = - let root = "_build/_bench" in + let main env t config size = + let fs = Eio.Stdenv.fs env in + let root = Eio.Path.(fs / "_build" / "_bench") in let config = config ~root in let size () = size ~root in let t = { t with root } in @@ -181,15 +183,16 @@ struct init ~fs t config; run ~fs t config size - let main_term config size = Term.(const main $ t $ const config $ const size) + let main_term env config size = + Term.(const (main env) $ t env $ const config $ const size) let () = at_exit (fun () -> Fmt.epr "tree counters:\n%a\n%!" Store.Tree.dump_counters ()) - let run ~config ~size = + let run ~env ~config ~size = let info = deprecated_info "Simple benchmark for trees" in - deprecated_exit @@ deprecated_eval (main_term config size, info) + deprecated_exit @@ deprecated_eval (main_term env config size, info) end let () = diff --git a/src/irmin-test/irmin_bench.mli b/src/irmin-test/irmin_bench.mli index 79232b2711..e49382000d 100644 --- a/src/irmin-test/irmin_bench.mli +++ b/src/irmin-test/irmin_bench.mli @@ -18,5 +18,8 @@ module Make (S : Irmin.Generic_key.KV with type Schema.Contents.t = string) : sig val run : - config:(root:string -> Irmin.config) -> size:(root:string -> int) -> unit + env:< fs : Eio.Fs.dir_ty Eio.Path.t ; .. > -> + config:(root:Eio.Fs.dir_ty Eio.Path.t -> Irmin.config) -> + size:(root:Eio.Fs.dir_ty Eio.Path.t -> int) -> + unit end diff --git a/test/irmin-bench/replay.ml b/test/irmin-bench/replay.ml index 088d82d45f..4d1cb41841 100644 --- a/test/irmin-bench/replay.ml +++ b/test/irmin-bench/replay.ml @@ -1,6 +1,6 @@ open! Import -let test_dir = Filename.concat "_build" "test-pack-trace-replay" +let test_dir fs = Eio.Path.(fs / "_build" / "test-pack-trace-replay") let () = Logs.set_level (Some Logs.Debug); @@ -16,15 +16,13 @@ module Store = struct type key = commit_key - let create_repo ~sw ~root () = + let create_repo ~sw ~fs ~root () = (* make sure the parent dir exists *) - let () = - match Sys.file_exists (Filename.dirname root) with - | false -> Unix.mkdir (Filename.dirname root) 0o755 - | true -> () - in + let dirname, _ = Option.get (Eio.Path.split root) in + if Eio.Path.kind ~follow:false dirname = `Not_found then + Eio.Path.mkdir ~perm:0o755 dirname; let conf = Irmin_pack.config ~readonly:false ~fresh:true root in - let repo = Store.Repo.v ~sw conf in + let repo = Store.Repo.v ~sw ~fs conf in let on_commit _ _ = () in let on_end () = () in (repo, on_commit, on_end) @@ -33,13 +31,13 @@ module Store = struct let r = Store.Gc.wait repo in match r with Ok _ -> () | Error (`Msg err) -> failwith err - let gc_run ~domain_mgr ?(finished = fun _ -> ()) repo key = + let gc_run ~fs ~domain_mgr ?(finished = fun _ -> ()) repo key = let f (result : (_, Store.Gc.msg) result) = match result with | Error (`Msg err) -> finished @@ Error err | Ok stats -> finished @@ Ok stats in - let launched = Store.Gc.run ~domain_mgr ~finished:f repo key in + let launched = Store.Gc.run ~fs ~domain_mgr ~finished:f repo key in match launched with | Ok true -> () | Ok false -> [%logs.app "GC skipped"] @@ -63,23 +61,19 @@ let goto_project_root () = Unix.chdir (Fpath.to_string root) | _ -> () -let setup_env () = +let setup_env ~fs = goto_project_root (); let trace_path = - let open Fpath in - v "test" / "irmin-bench" / "data" / "tezos_actions_1commit.repr" - |> to_string + Eio.Path.( + fs / "test" / "irmin-bench" / "data" / "tezos_actions_1commit.repr") in - assert (Sys.file_exists trace_path); - if Sys.file_exists test_dir then ( - let cmd = Printf.sprintf "rm -rf %s" test_dir in - [%logs.debug "exec: %s\n%!" cmd]; - let _ = Sys.command cmd in - ()); + let test_dir = test_dir fs in + if Eio.Path.kind ~follow:false test_dir <> `Not_found then + Eio.Path.rmtree test_dir; trace_path -let replay_1_commit domain_mgr () = - let trace_path = setup_env () in +let replay_1_commit ~fs ~domain_mgr () = + let trace_path = setup_env ~fs in let replay_config : _ Replay.config = { number_of_commits_to_replay = 1; @@ -87,7 +81,7 @@ let replay_1_commit domain_mgr () = inode_config = (Conf.entries, Conf.stable_hash); store_type = `Pack; replay_trace_path = trace_path; - artefacts_path = test_dir; + artefacts_path = test_dir fs; keep_store = false; keep_stat_trace = false; empty_blobs = false; @@ -98,7 +92,7 @@ let replay_1_commit domain_mgr () = add_volume_every = 0; } in - let summary = Replay.run ~domain_mgr () replay_config in + let summary = Replay.run ~fs ~domain_mgr () replay_config in [%logs.debug "%a" (Irmin_traces.Trace_stat_summary_pp.pp 5) ([ "" ], [ summary ])]; let check name = Alcotest.(check int) ("Stats_counters" ^ name) in @@ -134,9 +128,9 @@ module Store_mem = struct type key = commit_key - let create_repo ~sw ~root () = + let create_repo ~sw ~fs ~root () = let conf = Irmin_pack.config ~readonly:false ~fresh:true root in - let repo = Store.Repo.v ~sw conf in + let repo = Store.Repo.v ~sw ~fs conf in let on_commit _ _ = () in let on_end () = () in (repo, on_commit, on_end) @@ -144,13 +138,13 @@ module Store_mem = struct let split _repo = () let add_volume _repo = () let gc_wait _repo = () - let gc_run ~domain_mgr:_ ?finished:_ _repo _key = () + let gc_run ~fs:_ ~domain_mgr:_ ?finished:_ _repo _key = () end module Replay_mem = Irmin_traces.Trace_replay.Make (Store_mem) -let replay_1_commit_mem domain_mgr () = - let trace_path = setup_env () in +let replay_1_commit_mem ~fs ~domain_mgr () = + let trace_path = setup_env ~fs in let replay_config : _ Irmin_traces.Trace_replay.config = { number_of_commits_to_replay = 1; @@ -158,7 +152,7 @@ let replay_1_commit_mem domain_mgr () = inode_config = (Conf.entries, Conf.stable_hash); store_type = `Pack; replay_trace_path = trace_path; - artefacts_path = test_dir; + artefacts_path = test_dir fs; keep_store = false; keep_stat_trace = false; empty_blobs = false; @@ -169,17 +163,17 @@ let replay_1_commit_mem domain_mgr () = add_volume_every = 0; } in - let summary = Replay_mem.run ~domain_mgr () replay_config in + let summary = Replay_mem.run ~fs ~domain_mgr () replay_config in [%logs.debug "%a" (Irmin_traces.Trace_stat_summary_pp.pp 5) ([ "" ], [ summary ])]; () -let test_cases domain_mgr = +let test_cases ~fs ~domain_mgr = let tc msg f = Alcotest.test_case msg `Quick f in [ ( "replay", [ - tc "replay_1_commit" (replay_1_commit domain_mgr); - tc "replay_1_commit_in_memory" (replay_1_commit_mem domain_mgr); + tc "replay_1_commit" (replay_1_commit ~fs ~domain_mgr); + tc "replay_1_commit_in_memory" (replay_1_commit_mem ~fs ~domain_mgr); ] ); ] diff --git a/test/irmin-bench/test.ml b/test/irmin-bench/test.ml index cff00b41ba..3af38b4296 100644 --- a/test/irmin-bench/test.ml +++ b/test/irmin-bench/test.ml @@ -17,6 +17,6 @@ let () = Eio_main.run @@ fun env -> let domain_mgr = Eio.Stdenv.domain_mgr env in - Irmin_pack_unix.Io.set_env (Eio.Stdenv.fs env); + let fs = Eio.Stdenv.fs env in Alcotest.run "irmin-bench" - (Ema.test_cases @ Misc.test_cases @ Replay.test_cases domain_mgr) + (Ema.test_cases @ Misc.test_cases @ Replay.test_cases ~fs ~domain_mgr) diff --git a/test/irmin-pack/bench_multicore/bench.ml b/test/irmin-pack/bench_multicore/bench.ml index 00fad5bc8a..dd2a1627f6 100644 --- a/test/irmin-pack/bench_multicore/bench.ml +++ b/test/irmin-pack/bench_multicore/bench.ml @@ -14,17 +14,17 @@ let goto_project_root () = Unix.chdir @@ String.concat Fpath.dir_sep @@ List.rev root | _ -> () -let root = Filename.concat "_build" "bench-multicore" +let root fs = Eio.Path.(fs / "_build" / "bench-multicore") -let reset_test_env () = +let reset_test_env ~fs () = goto_project_root (); - Common.rm_dir root + Common.rm_dir (root fs) let info () = S.Info.empty -let open_repo ~fresh ~readonly () = - let conf = Irmin_pack.Conf.init ~fresh ~readonly root in - S.Repo.v conf +let open_repo ~sw ~fs ~fresh ~readonly () = + let conf = Irmin_pack.Conf.init ~fresh ~readonly (root fs) in + S.Repo.v ~sw ~fs conf let apply_op tree = function | Gen.Find path -> @@ -82,21 +82,21 @@ let get_tree ~config repo tasks = Array.iter (warmup_task tree) tasks; fun () -> tree -let setup_tree ~sw ~readonly paths = +let setup_tree ~sw ~fs ~readonly paths = let tree = make_tree_of_paths paths in - reset_test_env (); - let repo = open_repo ~sw ~fresh:true ~readonly:false () in + reset_test_env ~fs (); + let repo = open_repo ~sw ~fs ~fresh:true ~readonly:false () in let () = S.set_tree_exn ~info (S.main repo) [] tree in S.Repo.close repo; - let repo = open_repo ~sw ~fresh:false ~readonly () in + let repo = open_repo ~sw ~fs ~fresh:false ~readonly () in Format.printf "# domains,min_time,median_time,max_time,min_ratio,median_ratio,max_ratio@."; repo -let half ~d_mgr ~(config : Gen.config) = +let half ~fs ~d_mgr ~(config : Gen.config) = Eio.Switch.run @@ fun sw -> let paths, tasks = Gen.make ~config in - let repo = setup_tree ~sw ~readonly:true paths in + let repo = setup_tree ~sw ~fs ~readonly:true paths in let get_tree = get_tree ~config repo tasks in let _, sequential, _ = @@ -119,10 +119,10 @@ let half ~d_mgr ~(config : Gen.config) = done; S.Repo.close repo -let full ~d_mgr ~(config : Gen.config) = +let full ~fs ~d_mgr ~(config : Gen.config) = Eio.Switch.run @@ fun sw -> let paths, tasks = Gen.make_full ~config in - let repo = setup_tree ~sw ~readonly:false paths in + let repo = setup_tree ~sw ~fs ~readonly:false paths in let get_tree = get_tree ~config repo tasks in let parents = [ S.Commit.key @@ S.Head.get @@ S.main repo ] in diff --git a/test/irmin-pack/bench_multicore/main.ml b/test/irmin-pack/bench_multicore/main.ml index 1b53002356..0026277b93 100644 --- a/test/irmin-pack/bench_multicore/main.ml +++ b/test/irmin-pack/bench_multicore/main.ml @@ -120,11 +120,11 @@ let config = let bench_half config = Logs.set_level None; - Eio_main.run @@ fun env -> Bench.half ~d_mgr:env#domain_mgr ~config + Eio_main.run @@ fun env -> Bench.half ~fs:env#fs ~d_mgr:env#domain_mgr ~config let bench_full config = Logs.set_level None; - Eio_main.run @@ fun env -> Bench.full ~d_mgr:env#domain_mgr ~config + Eio_main.run @@ fun env -> Bench.full ~fs:env#fs ~d_mgr:env#domain_mgr ~config let cmd_half = let doc = "Half-diamond benchmark" in diff --git a/test/irmin-pack/common.ml b/test/irmin-pack/common.ml index d9518d0cf5..dbdb1fb900 100644 --- a/test/irmin-pack/common.ml +++ b/test/irmin-pack/common.ml @@ -91,16 +91,17 @@ module Branch = (Irmin_pack.Atomic_write.Value.Of_hash (Schema.Hash)) module Make_context (Config : sig - val root : string + val root : fs:Eio.Fs.dir_ty Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t end) = struct let fresh_name = let c = ref 0 in - fun object_type -> + fun ~fs object_type -> incr c; - - let name = Filename.concat Config.root ("pack_" ^ string_of_int !c) in - [%logs.info "Constructing %s context object: %s" object_type name]; + let name = Eio.Path.(Config.root ~fs / ("pack_" ^ string_of_int !c)) in + [%logs.info + "Constructing %s context object: %s" object_type + (Eio.Path.native_exn name)]; name let mkdir_dash_p dirname = @@ -113,7 +114,11 @@ struct in aux dirname - type d = { name : string; fm : File_manager.t; dict : Dict.t } + type d = { + name : Eio.Fs.dir_ty Eio.Path.t; + fm : File_manager.t; + dict : Dict.t; + } (* TODO : test the indexing_strategy minimal. *) let config ~readonly ~fresh name = @@ -134,7 +139,7 @@ struct else File_manager.open_rw ~sw ~fs config |> Errs.raise_if_error let get_dict ~sw ~fs ?name ~readonly ~fresh () = - let name = Option.value name ~default:(fresh_name "dict") in + let name = Option.value name ~default:(fresh_name ~fs "dict") in let config = config ~readonly ~fresh name in let fm = get_fm ~sw ~fs config in let dict = File_manager.dict fm in @@ -143,7 +148,7 @@ struct let close_dict d = File_manager.close d.fm |> Errs.raise_if_error type t = { - name : string; + name : Eio.Fs.dir_ty Eio.Path.t; fm : File_manager.t; index : Index.t; pack : read Pack.t; @@ -163,12 +168,12 @@ struct (f := fun () -> File_manager.flush fm |> Errs.raise_if_error); { name; index; pack; dict; fm } - let get_rw_pack ~sw = - let name = fresh_name "" in - create ~sw ~readonly:false ~fresh:true name + let get_rw_pack ~sw ~fs = + let name = fresh_name ~fs "" in + create ~sw ~fs ~readonly:false ~fresh:true name - let get_ro_pack ~sw name = create ~sw ~readonly:true ~fresh:false name - let reopen_rw ~sw name = create ~sw ~readonly:false ~fresh:false name + let get_ro_pack ~sw ~fs name = create ~sw ~fs ~readonly:true ~fresh:false name + let reopen_rw ~sw ~fs name = create ~sw ~fs ~readonly:false ~fresh:false name let close_pack t = let _ = File_manager.flush t.fm in @@ -365,6 +370,8 @@ let create_lower_root ~fs = let setup_test_env ~root_archive ~root_local_build = goto_project_root (); rm_dir root_local_build; + let root_archive = Eio.Path.native_exn root_archive in + let root_local_build = Eio.Path.native_exn root_local_build in let cmd = Filename.quote_command "cp" [ "-R"; "-p"; root_archive; root_local_build ] in diff --git a/test/irmin-pack/common.mli b/test/irmin-pack/common.mli index 331fd70d9b..54e74fb8a8 100644 --- a/test/irmin-pack/common.mli +++ b/test/irmin-pack/common.mli @@ -84,40 +84,62 @@ module Pack : (** Helper constructors for fresh pre-initialised dictionaries and packs *) module Make_context (Config : sig - val root : string + val root : fs:Eio.Fs.dir_ty Eio.Path.t -> Eio.Fs.dir_ty Eio.Path.t end) : sig - val fresh_name : string -> string + val fresh_name : + fs:Eio.Fs.dir_ty Eio.Path.t -> string -> Eio.Fs.dir_ty Eio.Path.t (** [fresh_name typ] is a clean directory for a resource of type [typ]. *) - type d = { name : string; fm : File_manager.t; dict : Dict.t } + type d = { + name : Eio.Fs.dir_ty Eio.Path.t; + fm : File_manager.t; + dict : Dict.t; + } val get_dict : - sw:Eio.Switch.t -> ?name:string -> readonly:bool -> fresh:bool -> unit -> d + sw:Eio.Switch.t -> + fs:Eio.Fs.dir_ty Eio.Path.t -> + ?name:Eio.Fs.dir_ty Eio.Path.t -> + readonly:bool -> + fresh:bool -> + unit -> + d val close_dict : d -> unit type t = { - name : string; + name : Eio.Fs.dir_ty Eio.Path.t; fm : File_manager.t; index : Index.t; pack : read Pack.t; dict : Dict.t; } - val get_rw_pack : sw:Eio.Switch.t -> t - val get_ro_pack : sw:Eio.Switch.t -> string -> t - val reopen_rw : sw:Eio.Switch.t -> string -> t + val get_rw_pack : sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> t + + val get_ro_pack : + sw:Eio.Switch.t -> + fs:Eio.Fs.dir_ty Eio.Path.t -> + Eio.Fs.dir_ty Eio.Path.t -> + t + + val reopen_rw : + sw:Eio.Switch.t -> + fs:Eio.Fs.dir_ty Eio.Path.t -> + Eio.Fs.dir_ty Eio.Path.t -> + t + val close_pack : t -> unit end val get : 'a option -> 'a val sha1 : string -> Schema.Hash.t val sha1_contents : string -> Schema.Hash.t -val rm_dir : string -> unit +val rm_dir : Eio.Fs.dir_ty Eio.Path.t -> unit val index_log_size : int option val random_string : int -> string val random_letters : int -> string -val unlink_path : string -> unit +val unlink_path : Eio.Fs.dir_ty Eio.Path.t -> unit val create_lower_root : fs:Eio.Fs.dir_ty Eio.Path.t -> ?mkdir:bool -> unit -> Eio.Fs.dir_ty Eio.Path.t @@ -125,6 +147,9 @@ val create_lower_root : val exec_cmd : string -> (unit, int) result (** Exec a command, and return [Ok ()] or [Error n] if return code is n <> 0 *) -val setup_test_env : root_archive:string -> root_local_build:string -> unit +val setup_test_env : + root_archive:Eio.Fs.dir_ty Eio.Path.t -> + root_local_build:Eio.Fs.dir_ty Eio.Path.t -> + unit (** [setup_test_env ~root_archive ~root_local_build] copies an existing store to a temporary location, to be used by the test. *) diff --git a/test/irmin-pack/test.ml b/test/irmin-pack/test.ml index 4a1ecc90ea..3ca0e68a1a 100644 --- a/test/irmin-pack/test.ml +++ b/test/irmin-pack/test.ml @@ -16,10 +16,12 @@ let () = Eio_main.run @@ fun env -> + let sr = Eio.Stdenv.secure_random env in let fs = Eio.Stdenv.fs env in + let domain_mgr = Eio.Stdenv.domain_mgr env in (* **/** *) let test_suite = Test_pack.suite in Irmin_test.Store.run ~fs "irmin-pack" - ~misc:(Test_pack.misc @@ Eio.Stdenv.domain_mgr env) + ~misc:(Test_pack.misc ~sr ~fs ~domain_mgr) ~sleep:Eio_unix.sleep - (List.map (fun s -> (`Quick, s)) test_suite) + (List.map (fun s -> (`Quick, s)) (test_suite ~fs)) diff --git a/test/irmin-pack/test_corrupted.ml b/test/irmin-pack/test_corrupted.ml index 5f6987842c..f51fa56e42 100644 --- a/test/irmin-pack/test_corrupted.ml +++ b/test/irmin-pack/test_corrupted.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test-corrupted" +let root fs = Eio.Path.(fs / "_build" / "test-corrupted") module Conf = Irmin_tezos.Conf @@ -32,6 +32,7 @@ let config ?(readonly = false) ?(fresh = true) root = let info () = Store.Info.empty let read_file path = + let path = Eio.Path.native_exn path in let ch = open_in_bin path in Fun.protect (fun () -> @@ -40,6 +41,7 @@ let read_file path = ~finally:(fun () -> close_in ch) let write_file path contents = + let path = Eio.Path.native_exn path in let ch = open_out_bin path in Fun.protect (fun () -> output_string ch contents) @@ -48,9 +50,10 @@ let write_file path contents = close_out ch) let test_corrupted_control_file ~fs () = + let root = root fs in rm_dir root; Eio.Switch.run @@ fun sw -> - let control_file_path = Filename.concat root "store.control" in + let control_file_path = Eio.Path.(root / "store.control") in let repo = Store.Repo.v ~sw ~fs (config ~fresh:true root) in let control_file_blob0 = read_file control_file_path in let store = Store.main repo in @@ -76,7 +79,7 @@ let test_corrupted_control_file ~fs () = match error with | Error (Irmin_pack_unix.Errors.Pack_error (`Corrupted_control_file s)) -> Alcotest.(check string) - "path is corrupted" s "_build/test-corrupted/store.control" + "path is corrupted" s "./_build/test-corrupted/store.control" | _ -> Alcotest.fail "unexpected error" let tests ~fs = diff --git a/test/irmin-pack/test_dispatcher.ml b/test/irmin-pack/test_dispatcher.ml index eac1a03087..a6cd70e2e4 100644 --- a/test/irmin-pack/test_dispatcher.ml +++ b/test/irmin-pack/test_dispatcher.ml @@ -19,16 +19,17 @@ open Common module S = Test_gc.Store module Dispatcher = Irmin_pack_unix.Dispatcher.Make (File_manager) -let root = Filename.concat "_build" "test-dispatcher" +let root ~fs = Eio.Path.(fs / "_build" / "test-dispatcher") let src = Logs.Src.create "tests.dispatcher" ~doc:"Test dispatcher" module Log = (val Logs.src_log src : Logs.LOG) let setup_store ~fs domain_mgr () = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let config = S.config root in - let t = S.init_with_config ~sw config in + let t = S.init_with_config ~sw ~fs config in let _ = S.commit_1 t in let t, c2 = S.commit_2 t in let t = S.checkout_exn t c2 in diff --git a/test/irmin-pack/test_existing_stores.ml b/test/irmin-pack/test_existing_stores.ml index 915defabb8..c4b4512598 100644 --- a/test/irmin-pack/test_existing_stores.ml +++ b/test/irmin-pack/test_existing_stores.ml @@ -32,11 +32,11 @@ let archive = ("foo", [ ([ "b" ], "y") ]); ] -let root_v1_archive, root_v1, tmp = - let open Fpath in - ( v "test" / "irmin-pack" / "data" / "version_1" |> to_string, - v "_build" / "test_pack_version_1" |> to_string, - v "_build" / "test_index_reconstruct" |> to_string ) +let root_v1_archive ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_1") + +let root_v1 ~fs = Eio.Path.(fs / "_build" / "test_pack_version_1") +let tmp ~fs = Eio.Path.(fs / "_build" / "test_index_reconstruct") module Test (S : Irmin.Generic_key.KV with type Schema.Contents.t = string) = struct @@ -117,25 +117,29 @@ module Test_reconstruct = struct module S = V2 () include Test (S) - let setup_test_env () = - setup_test_env ~root_archive:root_v1_archive ~root_local_build:root_v1; - setup_test_env ~root_archive:root_v1_archive ~root_local_build:tmp + let setup_test_env ~fs () = + setup_test_env ~root_archive:(root_v1_archive ~fs) + ~root_local_build:(root_v1 ~fs); + setup_test_env ~root_archive:(root_v1_archive ~fs) + ~root_local_build:(tmp ~fs) - let test_reconstruct () = + let test_reconstruct ~fs () = let module Kind = Irmin_pack.Pack_value.Kind in - setup_test_env (); - let conf = config ~readonly:false ~fresh:false root_v1 in + setup_test_env ~fs (); + let conf = config ~readonly:false ~fresh:false (root_v1 ~fs) in (* Open store in RW to migrate it to V3. *) Eio.Switch.run @@ fun sw -> - let repo = S.Repo.v ~sw conf in + let repo = S.Repo.v ~sw ~fs conf in let () = S.Repo.close repo in (* Test on a V3 store. *) - S.test_traverse_pack_file ~sw (`Reconstruct_index `In_place) conf; + S.test_traverse_pack_file ~sw ~fs (`Reconstruct_index `In_place) conf; let index_old = - Index.v_exn ~fresh:false ~readonly:false ~log_size:500_000 tmp + Index.v_exn ~fresh:false ~readonly:false ~log_size:500_000 + (Eio.Path.native_exn @@ tmp ~fs) in let index_new = - Index.v_exn ~fresh:false ~readonly:false ~log_size:500_000 root_v1 + Index.v_exn ~fresh:false ~readonly:false ~log_size:500_000 + (Eio.Path.native_exn @@ root_v1 ~fs) in Index.iter (fun k (offset, length, kind) -> @@ -154,15 +158,15 @@ module Test_reconstruct = struct Index.close_exn index_new; [%log.app "Checking old bindings are still reachable post index reconstruction)"]; - let r = S.Repo.v ~sw conf in + let r = S.Repo.v ~sw ~fs conf in check_repo r archive; S.Repo.close r - let test_gc_allowed () = - setup_test_env (); + let test_gc_allowed ~fs () = + setup_test_env ~fs (); Eio.Switch.run @@ fun sw -> - let conf = config ~readonly:false ~fresh:false root_v1 in - let repo = S.Repo.v ~sw conf in + let conf = config ~readonly:false ~fresh:false (root_v1 ~fs) in + let repo = S.Repo.v ~sw ~fs conf in let allowed = S.Gc.is_allowed repo in Alcotest.(check bool) "deleting gc not allowed on stores with V1 objects" allowed false; @@ -170,20 +174,21 @@ module Test_reconstruct = struct end module Test_corrupted_stores = struct - let root_archive, root = - let open Fpath in - ( v "test" / "irmin-pack" / "data" / "corrupted" |> to_string, - v "_build" / "test_integrity" |> to_string ) + let root_archive ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "corrupted") + + let root ~fs = Eio.Path.(fs / "_build" / "test_integrity") - let setup_env () = setup_test_env ~root_archive ~root_local_build:root + let setup_env ~fs () = + setup_test_env ~root_archive:(root_archive ~fs) ~root_local_build:(root ~fs) module S = V2 () include Test (S) - let test () = - setup_env (); + let test ~fs () = + setup_env ~fs (); Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~fresh:false root) in + let rw = S.Repo.v ~sw ~fs (config ~fresh:false (root ~fs)) in [%log.app "integrity check on a store where 3 entries are missing from pack"]; let result = S.integrity_check ~auto_repair:false rw in @@ -201,18 +206,20 @@ module Test_corrupted_stores = struct | _ -> Alcotest.fail "Store is repaired, should return Ok"); S.Repo.close rw - let root_archive, root_local_build = - let open Fpath in - ( v "test" / "irmin-pack" / "data" / "version_3_minimal" |> to_string, - v "_build" / "test_corrupt_minimal" |> to_string ) + let root_archive ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal") + + let root_local_build ~fs = Eio.Path.(fs / "_build" / "test_corrupt_minimal") - let setup_env () = setup_test_env ~root_archive ~root_local_build + let setup_env ~fs () = + setup_test_env ~root_archive:(root_archive ~fs) + ~root_local_build:(root_local_build ~fs) module IO = Irmin_pack_unix.Io.Unix - let write_corrupted_data_to_suffix () = + let write_corrupted_data_to_suffix ~fs () = Eio.Switch.run @@ fun sw -> - let path = Filename.concat root_local_build "store.0.suffix" in + let path = Eio.Path.(root_local_build ~fs / "store.0.suffix") in let io = IO.open_ ~sw ~path ~readonly:false |> Result.get_ok in let corrupted_node_hash = (* the correct hash starts with '9', modified it to have an incorrect hash @@ -225,15 +232,16 @@ module Test_corrupted_stores = struct IO.write_exn io ~off:(Int63.of_int 54) ~len s; IO.close io |> Result.get_ok - let test_minimal () = - setup_env (); + let test_minimal ~fs () = + setup_env ~fs (); [%log.app "integrity check on a good minimal store"]; let config = config ~fresh:false - ~indexing_strategy:Irmin_pack.Indexing_strategy.minimal root_local_build + ~indexing_strategy:Irmin_pack.Indexing_strategy.minimal + (root_local_build ~fs) in Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw config in + let rw = S.Repo.v ~sw ~fs config in let commit = commit_of_string rw "22e159de13b427226e5901defd17f0c14e744205" @@ -247,8 +255,8 @@ module Test_corrupted_stores = struct in let () = S.Repo.close rw in [%log.app "integrity check on a corrupted minimal store"]; - write_corrupted_data_to_suffix (); - let rw = S.Repo.v ~sw config in + write_corrupted_data_to_suffix ~fs (); + let rw = S.Repo.v ~sw ~fs config in let result = S.integrity_check ~heads:[ commit ] ~auto_repair:false rw in let () = match result with @@ -264,20 +272,21 @@ module Test_corrupted_stores = struct end module Test_corrupted_inode = struct - let root_archive, root = - let open Fpath in - ( v "test" / "irmin-pack" / "data" / "corrupted_inode" |> to_string, - v "_build" / "test_integrity_inode" |> to_string ) + let root_archive ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "corrupted_inode") - let setup_test_env () = setup_test_env ~root_archive ~root_local_build:root + let root ~fs = Eio.Path.(fs / "_build" / "test_integrity_inode") + + let setup_test_env ~fs () = + setup_test_env ~root_archive:(root_archive ~fs) ~root_local_build:(root ~fs) module S = V1 () include Test (S) - let test () = - setup_test_env (); + let test ~fs () = + setup_test_env ~fs (); Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~fresh:false root) in + let rw = S.Repo.v ~sw ~fs (config ~fresh:false (root ~fs)) in [%log.app "integrity check of inodes on a store with one corrupted inode"]; let c2 = "8d89b97726d9fb650d088cb7e21b78d84d132c6e" in let c2 = commit_of_string rw c2 in @@ -299,19 +308,21 @@ module Test_corrupted_inode = struct end module Test_traverse_gced = struct - let root_archive, root_local_build = - let open Fpath in - ( v "test" / "irmin-pack" / "data" / "version_3_minimal" |> to_string, - v "_build" / "test_reconstruct" |> to_string ) + let root_archive ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal") + + let root_local_build ~fs = Eio.Path.(fs / "_build" / "test_reconstruct") - let setup_test_env () = setup_test_env ~root_archive ~root_local_build + let setup_test_env ~fs () = + setup_test_env ~root_archive:(root_archive ~fs) + ~root_local_build:(root_local_build ~fs) module S = V2 () include Test (S) - let commit_and_gc domain_mgr conf = + let commit_and_gc ~fs ~domain_mgr conf = Eio.Switch.run @@ fun sw -> - let repo = S.Repo.v ~sw conf in + let repo = S.Repo.v ~sw ~fs conf in let commit = commit_of_string repo "22e159de13b427226e5901defd17f0c14e744205" in @@ -319,7 +330,7 @@ module Test_traverse_gced = struct let tree = S.Tree.add tree [ "abba"; "baba" ] "x" in let commit = S.Commit.v repo ~info:S.Info.empty ~parents:[] tree in let commit_key = S.Commit.key commit in - let _ = S.Gc.start_exn ~domain_mgr ~unlink:false repo commit_key in + let _ = S.Gc.start_exn ~fs ~domain_mgr ~unlink:false repo commit_key in let result = S.Gc.finalise_exn ~wait:true repo in let () = match result with @@ -329,29 +340,31 @@ module Test_traverse_gced = struct in S.Repo.close repo - let test_traverse_pack domain_mgr () = + let test_traverse_pack ~fs ~domain_mgr () = Eio.Switch.run @@ fun sw -> let module Kind = Irmin_pack.Pack_value.Kind in - setup_test_env (); + setup_test_env ~fs (); let conf = config ~readonly:false ~fresh:false - ~indexing_strategy:Irmin_pack.Indexing_strategy.minimal root_local_build + ~indexing_strategy:Irmin_pack.Indexing_strategy.minimal + (root_local_build ~fs) in - let () = commit_and_gc domain_mgr conf in - S.test_traverse_pack_file ~sw `Check_index conf + let () = commit_and_gc ~fs ~domain_mgr conf in + S.test_traverse_pack_file ~sw ~fs `Check_index conf end -let tests domain_mgr = +let tests ~fs ~domain_mgr = [ Alcotest.test_case "Test index reconstruction" `Quick - Test_reconstruct.test_reconstruct; + (Test_reconstruct.test_reconstruct ~fs); Alcotest.test_case "Test gc not allowed" `Quick - Test_reconstruct.test_gc_allowed; - Alcotest.test_case "Test integrity check" `Quick Test_corrupted_stores.test; + (Test_reconstruct.test_gc_allowed ~fs); + Alcotest.test_case "Test integrity check" `Quick + (Test_corrupted_stores.test ~fs); Alcotest.test_case "Test integrity check minimal stores" `Quick - Test_corrupted_stores.test_minimal; + (Test_corrupted_stores.test_minimal ~fs); Alcotest.test_case "Test integrity check for inodes" `Quick - Test_corrupted_inode.test; + (Test_corrupted_inode.test ~fs); Alcotest.test_case "Test traverse pack on gced store" `Quick - (Test_traverse_gced.test_traverse_pack domain_mgr); + (Test_traverse_gced.test_traverse_pack ~fs ~domain_mgr); ] diff --git a/test/irmin-pack/test_flush_reload.ml b/test/irmin-pack/test_flush_reload.ml index 35327266fa..261058337c 100644 --- a/test/irmin-pack/test_flush_reload.ml +++ b/test/irmin-pack/test_flush_reload.ml @@ -100,9 +100,9 @@ let write1_no_flush bstore nstore cstore = () (* These tests always open both RW and RO without any data in the model. *) -let start ~sw t = - let () = start_rw ~sw t in - let () = open_ro ~sw t S2_before_write in +let start ~sw ~fs t = + let () = start_rw ~sw ~fs t in + let () = open_ro ~sw ~fs t S2_before_write in let rw = Option.get t.rw |> snd in let ro = Option.get t.ro |> snd in (rw, ro) @@ -110,14 +110,14 @@ let start ~sw t = (* Open both stores. RW writes but does not flush - we do this by running the rest of the test inside the [batch]. Then reload the RO at different phases during the flush. *) -let test_one t ~(ro_reload_at : phase_flush) = +let test_one ~fs t ~(ro_reload_at : phase_flush) = Eio.Switch.run @@ fun sw -> let aux phase = let () = check_ro t in if ro_reload_at = phase then reload_ro t phase; check_ro t in - let rw, _ = start ~sw t in + let rw, _ = start ~sw ~fs t in Store.S.Backend.Repo.batch rw (fun bstore nstore cstore -> let () = write1_no_flush bstore nstore cstore in let () = aux S1_before_flush in @@ -131,9 +131,9 @@ let test_one t ~(ro_reload_at : phase_flush) = in aux S4_after_flush) -let test_one_guarded setup ~ro_reload_at = - let t = create_test_env setup in - let () = test_one t ~ro_reload_at in +let test_one_guarded ~fs setup ~ro_reload_at = + let t = create_test_env ~fs setup in + let () = test_one ~fs t ~ro_reload_at in close_everything t let setup = @@ -141,8 +141,8 @@ let setup = for the flush/reload tests. *) { start_mode = From_scratch; indexing_strategy = `always; lru_size = 0 } -let test_flush () = - let t = test_one_guarded setup in +let test_flush ~fs () = + let t = test_one_guarded ~fs setup in let () = t ~ro_reload_at:S1_before_flush in let () = t ~ro_reload_at:S2_after_flush_dict in let () = t ~ro_reload_at:S3_after_flush_suffix in @@ -192,10 +192,10 @@ let flush_rw t (current_phase : phase_reload) = in match t.rw with None -> assert false | Some (_, repo) -> Store.S.flush repo -let test_one t ~(rw_flush_at : phase_reload) = +let test_one ~fs t ~(rw_flush_at : phase_reload) = Eio.Switch.run @@ fun sw -> let aux phase = if rw_flush_at = phase then flush_rw t phase in - let rw, ro = start ~sw t in + let rw, ro = start ~sw ~fs t in let reload_ro () = Store.S.Backend.Repo.batch rw (fun bstore nstore cstore -> let () = write1_no_flush bstore nstore cstore in @@ -215,13 +215,13 @@ let test_one t ~(rw_flush_at : phase_reload) = let () = reload_ro () in check_ro t -let test_one_guarded setup ~rw_flush_at = - let t = create_test_env setup in - let () = test_one t ~rw_flush_at in +let test_one_guarded setup ~fs ~rw_flush_at = + let t = create_test_env ~fs setup in + let () = test_one ~fs t ~rw_flush_at in close_everything t -let test_reload () = - let t = test_one_guarded setup in +let test_reload ~fs () = + let t = test_one_guarded setup ~fs in let () = t ~rw_flush_at:S1_before_reload in let () = t ~rw_flush_at:S2_after_reload_index in let () = t ~rw_flush_at:S3_after_reload_control in @@ -229,8 +229,8 @@ let test_reload () = let () = t ~rw_flush_at:S5_after_reload in () -let tests = +let tests ~fs = [ - Alcotest.test_case "Reload during flush stages" `Quick test_flush; - Alcotest.test_case "Flush during reload stages" `Quick test_reload; + Alcotest.test_case "Reload during flush stages" `Quick (test_flush ~fs); + Alcotest.test_case "Flush during reload stages" `Quick (test_reload ~fs); ] diff --git a/test/irmin-pack/test_gc.ml b/test/irmin-pack/test_gc.ml index 47e5114166..6b39ea3f6f 100644 --- a/test/irmin-pack/test_gc.ml +++ b/test/irmin-pack/test_gc.ml @@ -23,31 +23,33 @@ module Log = (val Logs.src_log src : Logs.LOG) let test_dir = "_build" -let fresh_name = +let fresh_name ~fs = let c = ref 0 in fun () -> incr c; - let name = Filename.concat test_dir ("test-gc" ^ string_of_int !c) in - name + Eio.Path.(fs / test_dir / ("test-gc" ^ string_of_int !c)) -let create_v1_test_env () = - let ( / ) = Filename.concat in - let root_archive = "test" / "irmin-pack" / "data" / "version_1_large" in - let root_local_build = "_build" / "test-v1-gc" in +let create_v1_test_env ~fs () = + let root_archive = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_1_large") + in + let root_local_build = Eio.Path.(fs / "_build" / "test-v1-gc") in setup_test_env ~root_archive ~root_local_build; root_local_build -let create_from_v2_always_test_env () = - let ( / ) = Filename.concat in - let root_archive = "test" / "irmin-pack" / "data" / "version_2_to_3_always" in - let root_local_build = "_build" / "test-from-v2-always-gc" in +let create_from_v2_always_test_env ~fs () = + let root_archive = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_2_to_3_always") + in + let root_local_build = Eio.Path.(fs / "_build" / "test-from-v2-always-gc") in setup_test_env ~root_archive ~root_local_build; root_local_build -let create_test_env () = - let ( / ) = Filename.concat in - let root_archive = "test" / "irmin-pack" / "data" / "version_3_minimal" in - let root_local_build = "_build" / "test-gc" in +let create_test_env ~fs () = + let root_archive = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal") + in + let root_local_build = Eio.Path.(fs / "_build" / "test-gc") in setup_test_env ~root_archive ~root_local_build; root_local_build @@ -60,7 +62,7 @@ module Store = struct end type t = { - root : string; + root : Eio.Fs.dir_ty Eio.Path.t; repo : S.Repo.t; parents : S.Commit.t list; tree : S.tree; @@ -73,9 +75,9 @@ module Store = struct let info = S.Info.empty - let start_gc ~domain_mgr ?(unlink = false) t commit = + let start_gc ~fs ~domain_mgr ?(unlink = false) t commit = let commit_key = S.Commit.key commit in - let _ = S.Gc.start_exn ~domain_mgr ~unlink t.repo commit_key in + let _ = S.Gc.start_exn ~fs ~domain_mgr ~unlink t.repo commit_key in () let finalise_gc_with_stats t = @@ -119,7 +121,7 @@ module Store = struct let init ~sw ~fs ?(lru_size = 0) ?(readonly = false) ?(fresh = true) ?root ?(lower_root = None) () = (* start with a clean dir if fresh *) - let root = Option.value root ~default:(fresh_name ()) in + let root = Option.value root ~default:(fresh_name ~fs ()) in if fresh then ( rm_dir root; Option.iter rm_dir lower_root); @@ -134,7 +136,7 @@ module Store = struct let init_with_config ~sw ~fs config = let repo = S.Repo.v ~sw ~fs config in - let root = Irmin_pack.Conf.root config in + let root = Eio.Path.(fs / Irmin_pack.Conf.root config) in let tree = S.Tree.empty () in { root; repo; tree; parents = [] } @@ -259,7 +261,7 @@ module type Gc_backend = sig ?lru_size:int -> ?readonly:bool -> ?fresh:bool -> - ?root:string -> + ?root:Eio.Fs.dir_ty Eio.Path.t -> unit -> t @@ -267,9 +269,12 @@ module type Gc_backend = sig val check_removed : t -> S.commit -> string -> unit end +let file_exists path = + match Eio.Path.kind ~follow:false path with `Not_found -> false | _ -> true + let rec check_async_unlinked ?(timeout = 3.141) file = if timeout < 0.0 then false - else if Sys.file_exists file then ( + else if file_exists file then ( Unix.sleepf 0.2; check_async_unlinked ~timeout:(timeout -. 0.2) file) else true @@ -288,7 +293,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c1 in let t, c3 = commit_3 t in [%log.debug "Gc c1, c2, keep c3"]; - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = B.check_gced t c1 "gced c1" in let () = B.check_removed t c2 "gced c2" in @@ -310,13 +315,13 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c2 in let t, c4 = commit_4 t in [%log.debug "Gc c1, c2, c3, keep c4"]; - let () = start_gc ~domain_mgr t c4 in + let () = start_gc ~fs ~domain_mgr t c4 in let () = finalise_gc t in let t = checkout_exn t c4 in let t, c5 = commit_5 t in let () = check_5 t c5 in [%log.debug "Gc c4, keep c5"]; - let () = start_gc ~domain_mgr t c5 in + let () = start_gc ~fs ~domain_mgr t c5 in let () = finalise_gc t in let () = check_5 t c5 in let () = B.check_gced t c1 "gced c1" in @@ -337,7 +342,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c2 in let t, c3 = commit_3 t in [%log.debug "Keep c1, c2, c3"]; - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let () = check_1 t c1 in let () = check_2 t c2 in @@ -356,7 +361,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c_del in let t, c3 = commit_3 t in [%log.debug "Gc c1, c_del, keep c3"]; - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = B.check_gced t c1 "gced c1" in let () = B.check_gced t c_del "gced c_del" in @@ -370,7 +375,7 @@ module Gc_common (B : Gc_backend) = struct let t, c2 = commit_2 t in let () = check_2 t c2 in [%log.debug "Gc c3, keep c1, c2"]; - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let () = B.check_gced t c3 "gced c3" in let () = check_2 t c2 in @@ -390,26 +395,26 @@ module Gc_common (B : Gc_backend) = struct let t = B.init ~sw ~fs () in let store_name = t.root in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr ~unlink:false t c1 in + let () = start_gc ~fs ~domain_mgr ~unlink:false t c1 in let () = finalise_gc t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in let () = S.Repo.close t.repo in Alcotest.(check bool) "unlink:false" true - (Sys.file_exists (Filename.concat store_name "store.0.suffix")); + (file_exists Eio.Path.(store_name / "store.0.suffix")); Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs ~readonly:true ~fresh:false ~root:store_name () in let () = S.Repo.close t.repo in Alcotest.(check bool) "RO no clean up" true - (Sys.file_exists (Filename.concat store_name "store.0.suffix")); + (file_exists Eio.Path.(store_name / "store.0.suffix")); Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs ~readonly:false ~fresh:false ~root:store_name () in let () = S.Repo.close t.repo in Alcotest.(check bool) "RW cleaned up" true - (check_async_unlinked (Filename.concat store_name "store.0.prefix")); + (check_async_unlinked Eio.Path.(store_name / "store.0.prefix")); Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs ~readonly:false ~fresh:false ~root:store_name () in let () = check_1 t c1 in @@ -418,12 +423,12 @@ module Gc_common (B : Gc_backend) = struct Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs ~readonly:false ~fresh:false ~root:store_name () in [%log.debug "Gc c1, keep c2"]; - let () = start_gc ~domain_mgr ~unlink:true t c2 in + let () = start_gc ~fs ~domain_mgr ~unlink:true t c2 in let () = finalise_gc t in let () = S.Repo.close t.repo in Alcotest.(check bool) "unlink:true" true - (check_async_unlinked (Filename.concat store_name "store.1.suffix")); + (check_async_unlinked Eio.Path.(store_name / "store.1.suffix")); Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs ~readonly:false ~fresh:false ~root:store_name () in let () = B.check_gced t c1 "gced c1" in @@ -442,7 +447,7 @@ module Gc_common (B : Gc_backend) = struct let t, c2 = commit_2 t in let t = { t with parents = [ c1; c2 ] } in let t, c3 = commit_3 t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = B.check_gced t c1 "gced c1" in let () = B.check_gced t c2 "gced c2" in @@ -465,7 +470,7 @@ module Gc_common (B : Gc_backend) = struct let t, c3 = commit_3 t in S.reload ro_t.repo; [%log.debug "Gc c1, c2, keeps c3"]; - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in [%log.debug "RO finds everything before reload"]; let () = check_1 ro_t c1 in @@ -482,7 +487,7 @@ module Gc_common (B : Gc_backend) = struct let t, c5 = commit_5 t in S.reload ro_t.repo; [%log.debug "Gc c3, keep c4, c5"]; - let () = start_gc ~domain_mgr t c4 in + let () = start_gc ~fs ~domain_mgr t c4 in let () = finalise_gc t in [%log.debug "RO finds c3, c4, c5 before reload"]; let () = check_3 ro_t c3 in @@ -506,11 +511,11 @@ module Gc_common (B : Gc_backend) = struct let ro_t = B.init ~sw ~fs ~readonly:true ~fresh:false ~root:t.root () in let t, c1 = commit_1 t in S.reload ro_t.repo; - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in [%log.debug "RO finds c1, but c2 gced before reload"]; let () = check_1 ro_t c1 in @@ -531,7 +536,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in let () = S.Repo.close ro_t.repo in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in [%log.debug "RO reopens is similar to a reload"]; let ro_t = B.init ~sw ~fs ~readonly:true ~fresh:false ~root:t.root () in @@ -580,7 +585,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c3 in let t = set t [ "a"; "b"; "e" ] "a" in let c4 = commit t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = check t c4 in S.Repo.close t.repo @@ -595,7 +600,7 @@ module Gc_common (B : Gc_backend) = struct (Irmin_pack_unix.Errors.Pack_error `Gc_forbidden_during_batch) (fun () -> S.Backend.Repo.batch t.repo (fun _ _ _ -> - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in finalise_gc t)) in S.Repo.close t.repo @@ -613,7 +618,7 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c2 in let t, c3 = commit_3 t in [%log.debug "Keep c3 gc c1 c2"]; - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = B.check_gced t c1 "gced c1" in let () = B.check_gced t c2 "gced c2" in @@ -635,11 +640,11 @@ module Gc_common (B : Gc_backend) = struct Eio.Switch.run @@ fun sw -> let t = B.init ~sw ~fs () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let t = checkout_exn t c1 in let t, c1_again = commit_1_different_author t in - let () = start_gc ~domain_mgr t c1_again in + let () = start_gc ~fs ~domain_mgr t c1_again in let () = finalise_gc t in let () = check_1 t c1_again in S.Repo.close t.repo @@ -662,12 +667,12 @@ module Gc_common (B : Gc_backend) = struct let t = checkout_exn t c1 in check_latest_gc_target None; let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in check_latest_gc_target (Some c2); let t = checkout_exn t c2 in let t, c3 = commit_3 t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in check_latest_gc_target (Some c3); S.Repo.close t.repo @@ -697,11 +702,11 @@ module Gc_common (B : Gc_backend) = struct let t, c1 = commit_1 t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let t = checkout_exn t c2 in let t, c3 = commit_3 t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let stats = finalise_gc_with_stats t in check_stats (Option.get stats); S.Repo.close t.repo @@ -723,7 +728,7 @@ module Gc_common (B : Gc_backend) = struct (* TODO: Now that the GC is not in another process, it cleans every stats. Make the stats domain dependant ? *) (* let count_before_gc = lru_hits () in *) - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in (* Read data again *) let () = check_3 t c3 in @@ -769,9 +774,9 @@ module Gc_archival = struct in Alcotest.testable pp Stdlib.( = ) - let gc_availability_recent () = - let lower_root = create_lower_root ~mkdir:false () in + let gc_availability_recent ~fs () = Eio.Switch.run @@ fun sw -> + let lower_root = create_lower_root ~fs ~mkdir:false () in let t = init ~sw ~fs ~lower_root:(Some lower_root) () in Alcotest.(check gc_behaviour) "recent stores with a lower use archiving gc" (S.Gc.behaviour t.repo) @@ -790,10 +795,10 @@ module Gc_archival = struct (S.Gc.is_allowed t.repo) true; S.Repo.close t.repo - let gc_availability_old () = - let root = create_v1_test_env () in - let lower_root = create_lower_root () in + let gc_availability_old ~fs () = Eio.Switch.run @@ fun sw -> + let root = create_v1_test_env ~fs () in + let lower_root = create_lower_root ~fs () in let t = init ~sw ~fs ~root ~fresh:false ~lower_root:(Some lower_root) () in Alcotest.(check gc_behaviour) "old stores with a lower use archiving gc" (S.Gc.behaviour t.repo) @@ -802,7 +807,7 @@ module Gc_archival = struct "archiving gc allowed on old stores with a lower" (S.Gc.is_allowed t.repo) true; let () = S.Repo.close t.repo in - let root = create_v1_test_env () in + let root = create_v1_test_env ~fs () in Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~root ~fresh:false () in Alcotest.(check gc_behaviour) @@ -814,8 +819,8 @@ module Gc_archival = struct S.Repo.close t.repo let gc_reachability_old ~fs ~domain_mgr () = - let root = create_v1_test_env () in - let lower_root = create_lower_root () in + let root = create_v1_test_env ~fs () in + let lower_root = create_lower_root ~fs () in [%log.debug "Open v1 store to trigger migration"]; Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~root ~fresh:false ~lower_root:(Some lower_root) () in @@ -831,14 +836,15 @@ module Gc_archival = struct true | _ -> assert false in - let () = start_gc ~domain_mgr t head in + let () = start_gc ~fs ~domain_mgr t head in let () = finalise_gc t in S.Repo.close t.repo module B = struct let init ~sw ~fs ?lru_size ?readonly ?fresh ?root () = - let root = Option.value root ~default:(fresh_name ()) in - let lower_root = root ^ ".lower" in + let root = Option.value root ~default:(fresh_name ~fs ()) in + let dir_name, root_name = Option.get @@ Eio.Path.split root in + let lower_root = Eio.Path.(dir_name / (root_name ^ ".lower")) in init ~sw ~fs ?lru_size ?readonly ?fresh ~root ~lower_root:(Some lower_root) () @@ -860,7 +866,7 @@ module Gc_archival = struct let t = checkout_exn t c2 in let t, c4 = commit_4 t in [%log.debug "Gc c1, c2, c3, keep c4"]; - let () = start_gc ~domain_mgr t c4 in + let () = start_gc ~fs ~domain_mgr t c4 in let () = finalise_gc t in [%log.debug "Add a new volume"]; S.add_volume t.repo; @@ -868,7 +874,7 @@ module Gc_archival = struct let t, c5 = commit_5 t in let () = check_5 t c5 in [%log.debug "Gc c4, keep c5"]; - let () = start_gc ~domain_mgr t c5 in + let () = start_gc ~fs ~domain_mgr t c5 in let () = finalise_gc t in let () = check_5 t c5 in let () = B.check_gced t c1 "gced c1" in @@ -878,7 +884,7 @@ module Gc_archival = struct let () = Alcotest.check_raises_pack_error "Cannot GC on commit older than c5" (function `Gc_disallowed _ -> true | _ -> false) - (fun () -> start_gc ~domain_mgr t c4) + (fun () -> start_gc ~fs ~domain_mgr t c4) in S.Repo.close t.repo @@ -887,9 +893,9 @@ module Gc_archival = struct let tests ~fs ~domain_mgr = [ tc "Test availability of different gc modes on recent stores" - gc_availability_recent; + (gc_availability_recent ~fs); tc "Test availability of different gc modes on old stores" - gc_availability_old; + (gc_availability_old ~fs); tc "Test archiving twice on different volumes" (gc_archival_multiple_volumes ~fs ~domain_mgr); tc "Test reachability on old stores" (gc_reachability_old ~fs ~domain_mgr); @@ -906,7 +912,7 @@ module Concurrent_gc = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in [%log.debug "Gc c1 keep c2"]; - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = check_1 t c1 in let () = check_2 t c2 in let () = finalise_gc t in @@ -922,7 +928,7 @@ module Concurrent_gc = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in [%log.debug "Gc c1 keep c2"]; - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let t = checkout_exn t c2 in let t, c3 = commit_3 t in let () = finalise_gc t in @@ -936,19 +942,19 @@ module Concurrent_gc = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~lru_size () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let t = checkout_exn t c1 in let t, c2 = commit_2 t in let () = finalise_gc t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let t = checkout_exn t c2 in let t, c3 = commit_3 t in let () = finalise_gc t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let t = checkout_exn t c3 in let t, c4 = commit_4 t in let () = finalise_gc t in - let () = start_gc ~domain_mgr t c4 in + let () = start_gc ~fs ~domain_mgr t c4 in let t = checkout_exn t c4 in let t, c5 = commit_5 t in let () = finalise_gc t in @@ -976,7 +982,7 @@ module Concurrent_gc = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in [%log.debug "Gc c1 keep c2"]; - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in S.reload ro_t.repo; let () = check_1 ro_t c1 in S.reload ro_t.repo; @@ -1000,7 +1006,7 @@ module Concurrent_gc = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in [%log.debug "Gc c1 keep c2"]; - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in S.reload ro_t.repo; let t = checkout_exn t c2 in let t, c3 = commit_3 t in @@ -1028,12 +1034,12 @@ module Concurrent_gc = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in [%log.debug "Gc c1 keep c2"]; - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let t = checkout_exn t c2 in let t, c3 = commit_3 t in [%log.debug "Gc c2 keep c3"]; - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in S.reload ro_t.repo; let () = check_not_found ro_t c1 "removed c1" in @@ -1067,7 +1073,7 @@ module Concurrent_gc = struct (count_before_reload < lru_hits ()); (* GC *) (* let count_before_gc = lru_hits () in *) - let () = start_gc ~domain_mgr rw_t c2 in + let () = start_gc ~fs ~domain_mgr rw_t c2 in let () = finalise_gc rw_t in (* Reload RO to get changes and clear LRU, and read some data *) S.reload ro_t.repo; @@ -1083,14 +1089,14 @@ module Concurrent_gc = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = S.Repo.close t.repo in Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~readonly:false ~fresh:false ~root:t.root () in let () = check_1 t c1 in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let t = checkout_exn t c2 in S.Repo.close t.repo @@ -1108,14 +1114,14 @@ module Concurrent_gc = struct let () = S.split t.repo in (* GC chunk 0 - important to have at least one GC to test the cleanup routine's usage of generation *) - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in (* chunk 2, commit 3 *) let t = checkout_exn t c2 in let t, c3 = commit_3 t in let () = S.split t.repo in (* Start GC and then close repo before finalise *) - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = S.Repo.close t.repo in (* Reopen store. If the cleanup on cancel deletes wrong files, the store will fail to open. *) @@ -1135,10 +1141,10 @@ module Concurrent_gc = struct let t, c1 = commit_1 t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let t = checkout_exn t c2 in let t, c3 = commit_3 t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = check_not_found t c1 "removed c1" in let () = check_2 t c2 in @@ -1154,7 +1160,7 @@ module Concurrent_gc = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let killed = kill_gc t in let () = if killed then @@ -1170,7 +1176,7 @@ module Concurrent_gc = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let _killed = kill_gc t in S.Repo.close t.repo @@ -1198,7 +1204,7 @@ module Concurrent_gc = struct end module Split = struct - let two_splits () = + let two_splits ~fs () = Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in @@ -1216,7 +1222,7 @@ module Split = struct let () = check_3 t c3 in S.Repo.close t.repo - let ro_two_splits () = + let ro_two_splits ~fs () = Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let ro_t = init ~sw ~fs ~readonly:true ~fresh:false ~root:t.root () in @@ -1259,7 +1265,7 @@ module Split = struct Alcotest.(check (option string)) "find blob" (Some "b01") got let v3_migrated_store_splits_and_gc ~fs ~domain_mgr () = - let root = create_test_env () in + let root = create_test_env ~fs () in Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~readonly:false ~fresh:false ~root () in let c0 = load_commit t "22e159de13b427226e5901defd17f0c14e744205" in @@ -1274,32 +1280,32 @@ module Split = struct let () = check_1 t c1 in let () = check_2 t c2 in [%log.debug "GC at c0"]; - let () = start_gc ~domain_mgr ~unlink:true t c0 in + let () = start_gc ~fs ~domain_mgr ~unlink:true t c0 in let () = finalise_gc t in let () = check_preexisting_commit t in let () = check_1 t c1 in let () = check_2 t c2 in Alcotest.(check bool) "Chunk0 still exists" true - (Sys.file_exists (Filename.concat t.root "store.0.suffix")); + (file_exists Eio.Path.(t.root / "store.0.suffix")); [%log.debug "GC at c1"]; - let () = start_gc ~domain_mgr ~unlink:true t c1 in + let () = start_gc ~fs ~domain_mgr ~unlink:true t c1 in let () = finalise_gc t in let () = check_not_found t c0 "removed c0" in let () = check_1 t c1 in let () = check_2 t c2 in Alcotest.(check bool) "Chunk0 removed" true - (check_async_unlinked (Filename.concat t.root "store.0.suffix")); + (check_async_unlinked Eio.Path.(t.root / "store.0.suffix")); [%log.debug "GC at c2"]; - let () = start_gc ~domain_mgr ~unlink:true t c2 in + let () = start_gc ~fs ~domain_mgr ~unlink:true t c2 in let () = finalise_gc t in let () = check_not_found t c0 "removed c0" in let () = check_not_found t c1 "removed c1" in let () = check_2 t c2 in S.Repo.close t.repo - let close_and_split () = + let close_and_split ~fs () = Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let root = t.root in @@ -1331,11 +1337,11 @@ module Split = struct let t, c1 = commit_1 t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let t = checkout_exn t c2 in let t, c3 = commit_3 t in - let () = start_gc ~domain_mgr t c3 in + let () = start_gc ~fs ~domain_mgr t c3 in let () = finalise_gc t in let () = S.split t.repo in let t = checkout_exn t c3 in @@ -1360,14 +1366,14 @@ module Split = struct let t, c2 = commit_2 t in let () = S.split t.repo in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let t = checkout_exn t c2 in let t, c3 = commit_3 t in let () = S.split t.repo in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let t = checkout_exn t c3 in @@ -1386,7 +1392,7 @@ module Split = struct let () = S.split t.repo in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in let () = check_2 t c2 in let () = check_not_found t c1 "removed c1" in @@ -1399,7 +1405,7 @@ module Split = struct let () = S.split t.repo in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = finalise_gc t in let () = check_1 t c1 in let () = check_2 t c2 in @@ -1409,7 +1415,7 @@ module Split = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let () = start_gc ~domain_mgr t c1 in + let () = start_gc ~fs ~domain_mgr t c1 in let () = S.split t.repo in let t = checkout_exn t c1 in let t, c2 = commit_2 t in @@ -1429,7 +1435,7 @@ module Split = struct let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = S.split t.repo in let t = checkout_exn t c2 in @@ -1446,8 +1452,8 @@ module Split = struct let () = check_4 t c4 in S.Repo.close t.repo - let split_always_indexed_from_v2_store () = - let root = create_from_v2_always_test_env () in + let split_always_indexed_from_v2_store ~fs () = + let root = create_from_v2_always_test_env ~fs () in Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~readonly:false ~fresh:false ~root () in let _c0 = load_commit t "22e159de13b427226e5901defd17f0c14e744205" in @@ -1462,11 +1468,11 @@ module Split = struct let tests ~fs ~domain_mgr = [ - tc "Test two splits" two_splits; - tc "Test two splits for ro" ro_two_splits; + tc "Test two splits" (two_splits ~fs); + tc "Test two splits for ro" (ro_two_splits ~fs); tc "Test splits and GC on V3 store" (v3_migrated_store_splits_and_gc ~fs ~domain_mgr); - tc "Test split and close" close_and_split; + tc "Test split and close" (close_and_split ~fs); tc "Test two gc followed by split" (two_gc_then_split ~fs ~domain_mgr); tc "Test split and GC" (split_and_gc ~fs ~domain_mgr); tc "Test multi split and GC" (multi_split_and_gc ~fs ~domain_mgr); @@ -1475,7 +1481,7 @@ module Split = struct tc "Test commits and splits during GC" (commits_and_splits_during_gc ~fs ~domain_mgr); tc "Test split for always indexed from v2 store" - split_always_indexed_from_v2_store; + (split_always_indexed_from_v2_store ~fs); ] end @@ -1488,7 +1494,7 @@ module Snapshot = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let root_snap = Filename.concat t.root "snap" in + let root_snap = Eio.Path.(t.root / "snap") in let () = export ~fs ~domain_mgr t c1 root_snap in [%log.debug "store works after export"]; let t = checkout_exn t c1 in @@ -1510,7 +1516,7 @@ module Snapshot = struct Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs () in let t, c1 = commit_1 t in - let root_snap = Filename.concat t.root "snap" in + let root_snap = Eio.Path.(t.root / "snap") in let () = export ~fs ~domain_mgr t c1 root_snap in let () = S.Repo.close t.repo in [%log.debug "open store from import in ro"]; @@ -1528,7 +1534,7 @@ module Snapshot = struct [%log.debug "open store in readonly to export"]; Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~readonly:false ~fresh:false ~root:t.root () in - let root_snap = Filename.concat t.root "snap" in + let root_snap = Eio.Path.(t.root / "snap") in let () = export ~fs ~domain_mgr t c1 root_snap in [%log.debug "store works after export in readonly"]; let t = checkout_exn t c1 in @@ -1546,15 +1552,15 @@ module Snapshot = struct (* Test creating a snapshot in an archive store for a commit that is before the last gc target commit (ie it is in the lower) *) let snapshot_gced_commit ~fs ~domain_mgr () = - let lower_root = create_lower_root ~mkdir:false () in + let lower_root = create_lower_root ~fs ~mkdir:false () in Eio.Switch.run @@ fun sw -> let t = init ~sw ~fs ~lower_root:(Some lower_root) () in let t, c1 = commit_1 t in let t = checkout_exn t c1 in let t, c2 = commit_2 t in - let () = start_gc ~domain_mgr t c2 in + let () = start_gc ~fs ~domain_mgr t c2 in let () = finalise_gc t in - let root_snap = Filename.concat t.root "snap" in + let root_snap = Eio.Path.(t.root / "snap") in let () = export ~fs ~domain_mgr t c1 root_snap in let () = S.Repo.close t.repo in [%log.debug "open store from snapshot"]; diff --git a/test/irmin-pack/test_gc.mli b/test/irmin-pack/test_gc.mli index 20a75fb09a..4d7a6ab96e 100644 --- a/test/irmin-pack/test_gc.mli +++ b/test/irmin-pack/test_gc.mli @@ -54,8 +54,11 @@ module Store : sig type t - val config : string -> Irmin.config - val init_with_config : sw:Eio.Switch.t -> Irmin.config -> t + val config : Eio.Fs.dir_ty Eio.Path.t -> Irmin.config + + val init_with_config : + sw:Eio.Switch.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> Irmin.config -> t + val close : t -> unit val start_gc : diff --git a/test/irmin-pack/test_hashes.ml b/test/irmin-pack/test_hashes.ml index 7df8165c03..78e3589376 100644 --- a/test/irmin-pack/test_hashes.ml +++ b/test/irmin-pack/test_hashes.ml @@ -17,10 +17,10 @@ open! Import open Common -let root = Filename.concat "_build" "test-irmin-tezos" +let root fs = Eio.Path.(fs / "_build" / "test-irmin-tezos") -let conf = - Irmin_pack.config ~readonly:false ~fresh:true ~index_log_size:1000 root +let conf fs = + Irmin_pack.config ~readonly:false ~fresh:true ~index_log_size:1000 (root fs) let zero = Bytes.make 10 '0' @@ -70,8 +70,8 @@ struct in tree - let persist_tree ~sw tree = - let repo = Repo.v ~sw conf in + let persist_tree ~sw ~fs tree = + let repo = Repo.v ~sw ~fs (conf fs) in let init_commit = Commit.v ~parents:[] ~info:Info.empty repo (Tree.singleton [ "singleton-step" ] (Bytes.of_string "singleton-val")) @@ -144,10 +144,10 @@ module Test_tezos_conf = struct in ("len of values", nb_steps) :: checks - let inode_values_hash () = + let inode_values_hash ~fs () = Eio.Switch.run @@ fun sw -> let tree = Store.build_tree some_steps in - let repo, tree, _ = Store.persist_tree ~sw tree in + let repo, tree, _ = Store.persist_tree ~sw ~fs tree in let root_node = match Store.Tree.destruct tree with | `Contents _ -> Alcotest.fail "Expected root to be node" @@ -165,10 +165,10 @@ module Test_tezos_conf = struct "CoVeCU4o3dqmfdwqt2vh8LDz9X6qGbTUyLhgVvFReyzAvTf92AKx" h; Store.Repo.close repo - let commit_hash () = + let commit_hash ~fs () = Eio.Switch.run @@ fun sw -> let tree = Store.build_tree some_steps in - let repo, _, commit = Store.persist_tree ~sw tree in + let repo, _, commit = Store.persist_tree ~sw ~fs tree in let commit_val = Store.to_backend_commit commit in let h = Commit.Hash.hash commit_val in let encode_bin_hash = Irmin.Type.(unstage (encode_bin Commit.Hash.t)) in @@ -241,10 +241,10 @@ module Test_small_conf = struct "821707c86f7030b1102397feb88d454076ec64744dfd9811b8254bd61d396cfe" ); ] - let inode_tree_hash () = + let inode_tree_hash ~fs () = Eio.Switch.run @@ fun sw -> let tree = Store.build_tree many_steps in - let repo, tree, _ = Store.persist_tree ~sw tree in + let repo, tree, _ = Store.persist_tree ~sw ~fs tree in let root_node = match Store.Tree.destruct tree with | `Contents _ -> Alcotest.fail "Expected root to be node" @@ -283,10 +283,10 @@ module Test_V1 = struct let many_steps = [ "00"; "01"; "02"; "03"; "04"; "05" ] - let commit_hash () = + let commit_hash ~fs () = Eio.Switch.run @@ fun sw -> let tree = Store.build_tree many_steps in - let repo, _, commit = Store.persist_tree ~sw tree in + let repo, _, commit = Store.persist_tree ~sw ~fs tree in let commit_val = Store.to_backend_commit commit in let checks = [ @@ -309,12 +309,12 @@ module Test_V1 = struct Store.Repo.close repo end -let tests = +let tests ~fs = let tc name f = Alcotest.test_case name `Quick f in [ tc "contents hash" Test_tezos_conf.contents_hash; - tc "inode_values hash" Test_tezos_conf.inode_values_hash; - tc "inode_tree hash" Test_small_conf.inode_tree_hash; - tc "commit hash" Test_tezos_conf.commit_hash; - tc "V1 commit hash" Test_V1.commit_hash; + tc "inode_values hash" (Test_tezos_conf.inode_values_hash ~fs); + tc "inode_tree hash" (Test_small_conf.inode_tree_hash ~fs); + tc "commit hash" (Test_tezos_conf.commit_hash ~fs); + tc "V1 commit hash" (Test_V1.commit_hash ~fs); ] diff --git a/test/irmin-pack/test_hashes.mli b/test/irmin-pack/test_hashes.mli index 3e8b1f82b6..0e2361c412 100644 --- a/test/irmin-pack/test_hashes.mli +++ b/test/irmin-pack/test_hashes.mli @@ -14,7 +14,7 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -val tests : unit Alcotest.test_case list +val tests : fs:Eio.Fs.dir_ty Eio.Path.t -> unit Alcotest.test_case list val check_iter : string -> diff --git a/test/irmin-pack/test_indexing_strategy.ml b/test/irmin-pack/test_indexing_strategy.ml index a778d13cfa..af81c34be2 100644 --- a/test/irmin-pack/test_indexing_strategy.ml +++ b/test/irmin-pack/test_indexing_strategy.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test_indexing_strategy" +let root fs = Eio.Path.(fs / "_build" / "test_indexing_strategy") let src = Logs.Src.create "tests.indexing_strategy" ~doc:"Test indexing strategy" @@ -33,6 +33,7 @@ let config ~indexing_strategy ?(readonly = false) ?(fresh = false) root = Irmin_pack.config ~readonly ~indexing_strategy ~fresh root let test_unique_when_switched ~fs () = + let root = root fs in rm_dir root; let value = "Welt" in let get_contents_key store path = diff --git a/test/irmin-pack/test_inode.ml b/test/irmin-pack/test_inode.ml index 3bb51a991f..5a51a3823b 100644 --- a/test/irmin-pack/test_inode.ml +++ b/test/irmin-pack/test_inode.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test-inode" +let root ~fs = Eio.Path.(fs / "_build" / "test-inode") let src = Logs.Src.create "tests.instances" ~doc:"Tests" module Log = (val Logs.src_log src : Logs.LOG) @@ -139,6 +139,7 @@ struct let get_store ~sw ~fs ~indexing_strategy () = [%log.app "Constructing a fresh context for use by the test"]; + let root = root ~fs in rm_dir root; let config = config ~indexing_strategy ~readonly:false ~fresh:true root in let fm = get_fm ~sw ~fs config in @@ -346,6 +347,7 @@ let check_hardcoded_hash msg h v = (** Test add values from an empty node. *) let test_add_values ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = Context.get_store ~sw ~fs ~indexing_strategy () in @@ -372,6 +374,7 @@ let integrity_check ?(stable = true) v = (** Test add to inodes. *) let test_add_inodes ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = Context.get_store ~sw ~fs ~indexing_strategy () in @@ -407,6 +410,7 @@ let test_add_inodes ~fs () = (** Test remove values on an empty node. *) let test_remove_values ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = Context.get_store ~sw ~fs ~indexing_strategy () in @@ -430,6 +434,7 @@ let test_remove_values ~fs () = (** Test remove and add values to go from stable to unstable inodes. *) let test_remove_inodes ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = Context.get_store ~sw ~fs ~indexing_strategy () in @@ -778,6 +783,7 @@ module Inode_tezos = struct let hex_encode s = Hex.of_string s |> Hex.show let test_encode_bin_values ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = S.Context.get_store ~sw ~fs ~indexing_strategy () in @@ -817,6 +823,7 @@ module Inode_tezos = struct test_encode_bin_values ~fs ~indexing_strategy:`minimal let test_encode_bin_tree ~fs ~indexing_strategy = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> let t = S.Context.get_store ~sw ~fs ~indexing_strategy () in diff --git a/test/irmin-pack/test_lower.ml b/test/irmin-pack/test_lower.ml index d01a6294a3..5e7f30c150 100644 --- a/test/irmin-pack/test_lower.ml +++ b/test/irmin-pack/test_lower.ml @@ -172,7 +172,7 @@ module Store_tc = struct in Common.rm_dir name; let$ _ = if make_root then Io.mkdir name else Ok () in - let lower = Filename.concat name "lower" in + let lower = Eio.Path.(name / "lower") in Common.rm_dir lower; (name, lower) @@ -246,7 +246,7 @@ module Store_tc = struct let test_create_nested ~fs () = Eio.Switch.run @@ fun sw -> - let root, lower_root = fresh_roots ~make_root:false () in + let root, lower_root = fresh_roots ~fs ~make_root:false () in let repo = config ~fresh:true ~lower_root root |> Store.Repo.v ~sw ~fs in let volume_num = count_volumes repo in Alcotest.(check int) "volume_num is 1" 1 volume_num; @@ -254,7 +254,7 @@ module Store_tc = struct let test_open_rw_lower ~fs () = Eio.Switch.run @@ fun sw -> - let root, lower_root = fresh_roots ~make_root:false () in + let root, lower_root = fresh_roots ~fs ~make_root:false () in let repo = config ~fresh:true root |> Store.Repo.v ~sw ~fs in let () = Store.Repo.close repo in let repo = config ~fresh:false ~lower_root root |> Store.Repo.v ~sw ~fs in @@ -272,7 +272,7 @@ module Store_tc = struct main [ "a" ] "a" in let c = Store.Head.get main in - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key c) in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key c) in let () = Alcotest.check_raises "add volume during gc" (Irmin_pack_unix.Errors.Pack_error `Add_volume_forbidden_during_gc) @@ -298,7 +298,7 @@ module Store_tc = struct let info () = Store.Info.v ~author:"test" Int64.zero in let () = Store.set_exn ~info main [ "a" ] "a" in let c1 = Store.Head.get main in - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key c1) in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key c1) in let _ = Store.Gc.finalise_exn ~wait:true repo in let () = Store.add_volume repo in Alcotest.(check int) "two volumes" 2 (count_volumes repo); @@ -346,13 +346,12 @@ module Store_tc = struct (* Tests that dead header is handled appropriately *) let test_migrate_v2 ~fs () = Eio.Switch.run @@ fun sw -> - let ( / ) = Filename.concat in let root_archive = - "test" / "irmin-pack" / "data" / "version_2_to_3_always" + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_2_to_3_always") in - let root = "_build" / "test_lower_migrate_v2" in + let root = Eio.Path.(fs / "_build" / "test_lower_migrate_v2") in setup_test_env ~root_archive ~root_local_build:root; - let lower_root = root / "lower" in + let lower_root = Eio.Path.(root / "lower") in (* Open store and trigger migration. This should succeed. *) let repo = Store.Repo.v ~sw ~fs (config ~fresh:false ~lower_root root) in let _ = read_everything repo in @@ -361,22 +360,24 @@ module Store_tc = struct let test_migrate_v3 ~fs () = Eio.Switch.run @@ fun sw -> (* minimal indexing *) - let ( / ) = Filename.concat in - let root_archive = "test" / "irmin-pack" / "data" / "version_3_minimal" in - let root = "_build" / "test_lower_migrate_v3_minimal" in + let root_archive = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal") + in + let root = Eio.Path.(fs / "_build" / "test_lower_migrate_v3_minimal") in setup_test_env ~root_archive ~root_local_build:root; - let lower_root = root / "lower" in + let lower_root = Eio.Path.(root / "lower") in (* Open store and trigger migration. This should succeed. *) let repo = Store.Repo.v ~sw ~fs (config ~fresh:false ~lower_root root) in let _ = read_everything repo in let _ = Store.Repo.close repo in (* always indexing *) - let ( / ) = Filename.concat in - let root_archive = "test" / "irmin-pack" / "data" / "version_3_always" in - let root = "_build" / "test_lower_migrate_v3_always" in + let root_archive = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_always") + in + let root = Eio.Path.(fs / "_build" / "test_lower_migrate_v3_always") in setup_test_env ~root_archive ~root_local_build:root; - let lower_root = root / "lower" in + let lower_root = Eio.Path.(root / "lower") in (* Open store and trigger migration. This should succeed. *) let repo = Store.Repo.v ~sw ~fs (config ~fresh:false ~lower_root root) in let _ = read_everything repo in @@ -402,7 +403,9 @@ module Store_tc = struct let b_commit = Store.Head.get main in let () = Store.set_exn ~info main [ "c" ] "c" in (* GC at [b] requires reading [a] data from the lower volume *) - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key b_commit) in + let _ = + Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key b_commit) + in let _ = Store.Gc.finalise_exn ~wait:true repo in let _ = read_everything repo in Store.Repo.close repo @@ -427,7 +430,9 @@ module Store_tc = struct Important: we call GC on a commit that is not the latest in the lower (ie [b]) to ensure its offset is not equal to the start offset of the upper. *) - let _ = Store.Gc.start_exn repo ~domain_mgr (Store.Commit.key a_commit) in + let _ = + Store.Gc.start_exn ~fs repo ~domain_mgr (Store.Commit.key a_commit) + in let _ = Store.Gc.finalise_exn ~wait:true repo in Store.Repo.close repo @@ -441,7 +446,7 @@ module Store_tc = struct let () = Store.set_exn ~info main [ "c1" ] "a" in let c1 = Store.Head.get main in [%log.debug "GC c1"]; - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key c1) in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key c1) in let _ = Store.Gc.finalise_exn ~wait:true repo in let () = Store.add_volume repo in [%log.debug "add c2, c3, c4"]; @@ -452,7 +457,7 @@ module Store_tc = struct let () = Store.set_exn ~info main [ "c5" ] "e" in let c5 = Store.Head.get main in [%log.debug "GC c5"]; - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key c5) in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key c5) in let _ = Store.Gc.finalise_exn ~wait:true repo in let get_direct_key key = match Irmin_pack_unix.Pack_key.inspect key with @@ -504,7 +509,7 @@ module Store_tc = struct let info () = Store.Info.v ~author:"test" Int64.zero in let () = Store.set_exn ~info main [ "a" ] "a" in let c1 = Store.Head.get main in - let _ = Store.Gc.start_exn ~domain_mgr repo (Store.Commit.key c1) in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo (Store.Commit.key c1) in let _ = Store.Gc.finalise_exn ~wait:true repo in let volume_root = volume_path repo Int63.zero in let generation = generation repo in @@ -534,40 +539,43 @@ end module Store = struct include Store_tc - let tests ~domain_mgr = + let tests ~fs ~domain_mgr = Alcotest. [ - quick_tc "create store" test_create; - quick_tc "create nested" test_create_nested; - quick_tc "open rw with lower" test_open_rw_lower; - quick_tc "add volume with no lower" test_add_volume_wo_lower; - quick_tc "add volume during gc" (test_add_volume_during_gc ~domain_mgr); + quick_tc "create store" (test_create ~fs); + quick_tc "create nested" (test_create_nested ~fs); + quick_tc "open rw with lower" (test_open_rw_lower ~fs); + quick_tc "add volume with no lower" (test_add_volume_wo_lower ~fs); + quick_tc "add volume during gc" + (test_add_volume_during_gc ~fs ~domain_mgr); quick_tc "control file updated after add" - (test_add_volume_reopen ~domain_mgr); - quick_tc "add volume and reopen" (test_add_volume_reopen ~domain_mgr); - quick_tc "create without lower then migrate" test_migrate; - quick_tc "migrate v2" test_migrate_v2; - quick_tc "migrate v3" test_migrate_v3; - quick_tc "migrate then gc" (test_migrate_then_gc ~domain_mgr); + (test_add_volume_reopen ~fs ~domain_mgr); + quick_tc "add volume and reopen" + (test_add_volume_reopen ~fs ~domain_mgr); + quick_tc "create without lower then migrate" (test_migrate ~fs); + quick_tc "migrate v2" (test_migrate_v2 ~fs); + quick_tc "migrate v3" (test_migrate_v3 ~fs); + quick_tc "migrate then gc" (test_migrate_then_gc ~fs ~domain_mgr); quick_tc "migrate then gc in lower" - (test_migrate_then_gc_in_lower ~domain_mgr); - quick_tc "test data locality" (test_volume_data_locality ~domain_mgr); - quick_tc "test cleanup" (test_cleanup ~domain_mgr); + (test_migrate_then_gc_in_lower ~fs ~domain_mgr); + quick_tc "test data locality" + (test_volume_data_locality ~fs ~domain_mgr); + quick_tc "test cleanup" (test_cleanup ~fs ~domain_mgr); ] end module Direct = struct include Direct_tc - let tests = + let tests ~fs = Alcotest. [ - quick_tc "empty lower" test_empty; - quick_tc "volume_num too high" test_volume_num; - quick_tc "add volume" test_add_volume; - quick_tc "add volume ro" test_add_volume_ro; - quick_tc "add multiple empty" test_add_multiple_empty; - quick_tc "find volume" test_find_volume; - quick_tc "test read_exn" test_read_exn; + quick_tc "empty lower" (test_empty ~fs); + quick_tc "volume_num too high" (test_volume_num ~fs); + quick_tc "add volume" (test_add_volume ~fs); + quick_tc "add volume ro" (test_add_volume_ro ~fs); + quick_tc "add multiple empty" (test_add_multiple_empty ~fs); + quick_tc "find volume" (test_find_volume ~fs); + quick_tc "test read_exn" (test_read_exn ~fs); ] end diff --git a/test/irmin-pack/test_multicore.ml b/test/irmin-pack/test_multicore.ml index 79d7a166c7..337772951b 100644 --- a/test/irmin-pack/test_multicore.ml +++ b/test/irmin-pack/test_multicore.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test-multicore" +let root ~fs = Eio.Path.(fs / "_build" / "test-multicore") let src = Logs.Src.create "tests.multicore" ~doc:"Tests" module Log = (val Logs.src_log src : Logs.LOG) @@ -108,6 +108,7 @@ let list_shape shape = list_shape [] [] shape let make_store ~fs shape = Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~fresh:true root) in let main = Store.main repo in let tree = make_tree shape in @@ -144,6 +145,7 @@ let test_find ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:true ~fresh:false root) in @@ -166,6 +168,7 @@ let test_length ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:true ~fresh:false root) in @@ -221,6 +224,7 @@ let test_add_remove ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:true ~fresh:false root) in @@ -261,6 +265,7 @@ let test_commit ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in @@ -284,6 +289,7 @@ let test_merkle ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in @@ -308,6 +314,7 @@ let test_hash ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in @@ -351,6 +358,7 @@ let test_list_disk ~fs ~cache ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:true ~fresh:false root) in @@ -363,6 +371,7 @@ let test_list_mem ~fs ~cache ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:true ~fresh:false root) in @@ -377,6 +386,7 @@ let test_commit_of_hash ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in @@ -428,6 +438,7 @@ let test_commit_parents ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in @@ -460,6 +471,7 @@ let test_commit_v ~fs ~domain_mgr = Logs.set_level None; make_store ~fs shape0; Eio.Switch.run @@ fun sw -> + let root = root ~fs in let repo = Store.Repo.v ~sw ~fs (Store.config ~readonly:false ~fresh:false root) in diff --git a/test/irmin-pack/test_pack.ml b/test/irmin-pack/test_pack.ml index 2625090e4d..f6013e5515 100644 --- a/test/irmin-pack/test_pack.ml +++ b/test/irmin-pack/test_pack.ml @@ -17,7 +17,7 @@ open! Import open Common -let test_dir = Filename.concat "_build" "test-db-pack" +let test_dir ~fs = Eio.Path.(fs / "_build" / "test-db-pack") module Irmin_pack_store (Config : Irmin_pack.Conf.S) : Irmin_test.Generic_key = struct @@ -31,21 +31,24 @@ struct end) end -let suite_pack name_suffix indexing_strategy (module Config : Irmin_pack.Conf.S) - = +let suite_pack name_suffix ~fs indexing_strategy + (module Config : Irmin_pack.Conf.S) = let store = (module Irmin_pack_store (Config) : Irmin_test.Generic_key) in + let test_dir = test_dir ~fs in let config = Irmin_pack.config ~fresh:false ~lru_size:0 ~indexing_strategy test_dir in - let init ~config = + let init ~fs ~config = let test_dir = - Irmin.Backend.Conf.find_root config |> Option.value ~default:test_dir + Irmin.Backend.Conf.find_root config + |> Option.map (fun s -> Eio.Path.(fs / s)) + |> Option.value ~default:test_dir in rm_dir test_dir in let clean = init in Irmin_test.Suite.create_generic_key ~name:("PACK" ^ name_suffix) - ~import_supported:false ~init ~store ~config ~clean () + ~import_supported:false ~init:(init ~fs) ~store ~config ~clean () module Irmin_tezos_conf = struct include Irmin_tezos.Conf @@ -65,13 +68,14 @@ module Irmin_pack_mem_maker : Irmin_test.Generic_key = struct end) end -let suite_mem = +let suite_mem ~fs = let store = (module Irmin_pack_mem_maker : Irmin_test.Generic_key) in + let test_dir = test_dir ~fs in let config = Irmin_pack.config ~fresh:false ~lru_size:0 test_dir in Irmin_test.Suite.create_generic_key ~import_supported:false ~name:"PACK MEM" ~store ~config () -let suite = +let suite ~fs = let module Index = Irmin_pack.Indexing_strategy in let module Conf_small_nodes = struct (* Parameters chosen to be different from those in [Irmin_tezos.Conf]: *) @@ -82,9 +86,9 @@ let suite = let forbid_empty_dir_persistence = false end in [ - suite_pack " { Tezos }" Index.minimal (module Irmin_tezos_conf); - suite_pack " { Small_nodes }" Index.always (module Conf_small_nodes); - suite_mem; + suite_pack ~fs " { Tezos }" Index.minimal (module Irmin_tezos_conf); + suite_pack ~fs " { Small_nodes }" Index.always (module Conf_small_nodes); + suite_mem ~fs; ] module Context = Make_context (struct @@ -95,9 +99,11 @@ let flush fm = File_manager.flush fm |> Errs.raise_if_error let reload fm = File_manager.reload fm |> Errs.raise_if_error module Dict = struct - let test_dict () = + let test_dict ~fs () = Eio.Switch.run @@ fun sw -> - let (d : Context.d) = Context.get_dict ~sw ~readonly:false ~fresh:true () in + let (d : Context.d) = + Context.get_dict ~sw ~fs ~readonly:false ~fresh:true () + in let x1 = Dict.index d.dict "foo" in Alcotest.(check (option int)) "foo" (Some 0) x1; let x1 = Dict.index d.dict "foo" in @@ -112,7 +118,7 @@ module Dict = struct Alcotest.(check (option int)) "foo" (Some 0) x1; flush d.fm; let (d2 : Context.d) = - Context.get_dict ~sw ~name:d.name ~readonly:false ~fresh:false () + Context.get_dict ~sw ~fs ~name:d.name ~readonly:false ~fresh:false () in let x4 = Dict.index d2.dict "titiabc" in Alcotest.(check (option int)) "titiabc" (Some 3) x4; @@ -124,7 +130,7 @@ module Dict = struct Alcotest.(check (option string)) "find x3" (Some "toto") v3; Context.close_dict d; let (d3 : Context.d) = - Context.get_dict ~sw ~name:d.name ~readonly:false ~fresh:false () + Context.get_dict ~sw ~fs ~name:d.name ~readonly:false ~fresh:false () in let v1 = Dict.find d3.dict (get x1) in Alcotest.(check (option string)) "find x1" (Some "foo") v1; @@ -133,11 +139,13 @@ module Dict = struct let ignore_int (_ : int option) = () - let test_readonly_dict () = + let test_readonly_dict ~fs () = Eio.Switch.run @@ fun sw -> - let (d : Context.d) = Context.get_dict ~sw ~readonly:false ~fresh:true () in + let (d : Context.d) = + Context.get_dict ~sw ~fs ~readonly:false ~fresh:true () + in let (d2 : Context.d) = - Context.get_dict ~sw ~name:d.name ~readonly:true ~fresh:false () + Context.get_dict ~sw ~fs ~name:d.name ~readonly:true ~fresh:false () in let check_index k i = Alcotest.(check (option int)) k (Some i) (Dict.index d2.dict k) @@ -176,17 +184,17 @@ module Dict = struct Context.close_dict d; Context.close_dict d2 - let tests = + let tests ~fs = [ - Alcotest.test_case "dict" `Quick test_dict; - Alcotest.test_case "RO dict" `Quick test_readonly_dict; + Alcotest.test_case "dict" `Quick (test_dict ~fs); + Alcotest.test_case "RO dict" `Quick (test_readonly_dict ~fs); ] end module Pack = struct - let test_pack () = + let test_pack ~fs () = Eio.Switch.run @@ fun sw -> - let t = Context.get_rw_pack ~sw in + let t = Context.get_rw_pack ~sw ~fs in let x1 = "foo" in let x2 = "bar" in let x3 = "otoo" in @@ -216,15 +224,15 @@ module Pack = struct Alcotest.(check string) "x4" x4 y4 in test t.pack; - let t' = Context.get_ro_pack ~sw t.name in + let t' = Context.get_ro_pack ~sw ~fs t.name in test t'.pack; Context.close_pack t; Context.close_pack t' - let test_readonly_pack () = + let test_readonly_pack ~fs () = Eio.Switch.run @@ fun sw -> - let t = Context.get_rw_pack ~sw in - let t' = Context.get_ro_pack ~sw t.name in + let t = Context.get_rw_pack ~sw ~fs in + let t' = Context.get_ro_pack ~sw ~fs t.name in let () = let adds l = List.map @@ -258,10 +266,10 @@ module Pack = struct Context.close_pack t; Context.close_pack t' - let test_close_pack_more () = + let test_close_pack_more ~fs () = Eio.Switch.run @@ fun sw -> (*open and close in rw*) - let t = Context.get_rw_pack ~sw in + let t = Context.get_rw_pack ~sw ~fs in let x1 = "foo" in let h1 = sha1_contents x1 in let k1 = @@ -270,24 +278,24 @@ module Pack = struct flush t.fm; Context.close_pack t; (*open and close in ro*) - let t1 = Context.get_ro_pack ~sw t.name in + let t1 = Context.get_ro_pack ~sw ~fs t.name in let y1 = Pack.find t1.pack k1 |> get in Alcotest.(check string) "x1.1" x1 y1; Context.close_pack t1; (* reopen in rw *) - let t2 = Context.reopen_rw ~sw t.name in + let t2 = Context.reopen_rw ~sw ~fs t.name in let y1 = Pack.find t2.pack k1 |> get in Alcotest.(check string) "x1.2" x1 y1; (*reopen in ro *) - let t3 = Context.get_ro_pack ~sw t.name in + let t3 = Context.get_ro_pack ~sw ~fs t.name in let y1 = Pack.find t3.pack k1 |> get in Alcotest.(check string) "x1.3" x1 y1; Context.close_pack t2; Context.close_pack t3 - let test_close_pack () = + let test_close_pack ~fs () = Eio.Switch.run @@ fun sw -> - let t = Context.get_rw_pack ~sw in + let t = Context.get_rw_pack ~sw ~fs in let w = t.pack in let x1 = "foo" in let x2 = "bar" in @@ -302,7 +310,7 @@ module Pack = struct in Context.close_pack t; (*reopen in rw *) - let t' = Context.reopen_rw ~sw t.name in + let t' = Context.reopen_rw ~sw ~fs t.name in let y2 = Pack.find t'.pack k2 |> get in Alcotest.(check string) "x2.1" x2 y2; let y1 = Pack.find t'.pack k1 |> get in @@ -314,7 +322,7 @@ module Pack = struct in Context.close_pack t'; (*reopen in rw *) - let t2 = Context.reopen_rw ~sw t.name in + let t2 = Context.reopen_rw ~sw ~fs t.name in let y2 = Pack.find t2.pack k2 |> get in Alcotest.(check string) "x2.2" x2 y2; let y3 = Pack.find t2.pack k3 |> get in @@ -323,7 +331,7 @@ module Pack = struct Alcotest.(check string) "x1.2" x1 y1; Context.close_pack t2; (*reopen in ro *) - let t' = Context.get_ro_pack ~sw t.name in + let t' = Context.get_ro_pack ~sw ~fs t.name in let y1 = Pack.find t'.pack k1 |> get in Alcotest.(check string) "x1.3" x1 y1; let y2 = Pack.find t'.pack k2 |> get in @@ -333,10 +341,10 @@ module Pack = struct (** Index can be flushed to disk independently of pack, we simulate this in the tests using [Index.filter] and [Index.flush]. Regression test for PR 1008 in which values were indexed before being reachable in pack. *) - let readonly_reload_index_flush () = + let readonly_reload_index_flush ~fs () = Eio.Switch.run @@ fun sw -> - let t = Context.get_rw_pack ~sw in - let t' = Context.get_ro_pack ~sw t.name in + let t = Context.get_rw_pack ~sw ~fs in + let t' = Context.get_ro_pack ~sw ~fs t.name in let test w = let x1 = "foo" in let h1 = sha1_contents x1 in @@ -364,10 +372,10 @@ module Pack = struct Context.close_pack t; Context.close_pack t' - let readonly_find_index_flush () = + let readonly_find_index_flush ~fs () = Eio.Switch.run @@ fun sw -> - let t = Context.get_rw_pack ~sw in - let t' = Context.get_ro_pack ~sw t.name in + let t = Context.get_rw_pack ~sw ~fs in + let t' = Context.get_ro_pack ~sw ~fs t.name in let check h x msg = let y = Pack.find t'.pack h in Alcotest.(check (option string)) msg (Some x) y @@ -406,16 +414,16 @@ module Pack = struct Context.close_pack t; Context.close_pack t' - let tests = + let tests ~fs = [ - Alcotest.test_case "pack" `Quick test_pack; - Alcotest.test_case "RO pack" `Quick test_readonly_pack; - Alcotest.test_case "close" `Quick test_close_pack; - Alcotest.test_case "close readonly" `Quick test_close_pack_more; + Alcotest.test_case "pack" `Quick (test_pack ~fs); + Alcotest.test_case "RO pack" `Quick (test_readonly_pack ~fs); + Alcotest.test_case "close" `Quick (test_close_pack ~fs); + Alcotest.test_case "close readonly" `Quick (test_close_pack_more ~fs); Alcotest.test_case "readonly reload, index flush" `Quick - readonly_reload_index_flush; + (readonly_reload_index_flush ~fs); Alcotest.test_case "readonly find, index flush" `Quick - readonly_find_index_flush; + (readonly_find_index_flush ~fs); ] end @@ -428,7 +436,7 @@ module Branch = struct let pp_hash = Irmin.Type.pp Irmin.Hash.SHA1.t - let test_branch () = + let test_branch ~fs () = let branches = [ "foo"; "bar/toto"; "titi" ] in let test t = List.iter (fun k -> Branch.set t k (sha1 k)) branches; @@ -438,7 +446,7 @@ module Branch = struct in List.map check branches |> Eio.Fiber.all in - let name = Context.fresh_name "branch" in + let name = Context.fresh_name ~fs "branch" in Eio.Switch.run @@ fun sw -> Branch.v ~sw ~fresh:true name |> test; Branch.v ~sw ~fresh:true name |> test; @@ -462,7 +470,7 @@ module Branch = struct (List.filter (( <> ) "foo") branches) br - let test_close_branch () = + let test_close_branch ~fs () = Eio.Switch.run @@ fun sw -> let branches = [ "foo"; "bar/toto"; "titi" ] in let add t = @@ -473,16 +481,13 @@ module Branch = struct branches in let test t = - let check i h () = - Fmt.pr "%d->@." i; + let check h () = let v = Branch.find t h in - Fmt.pr "-%d-@." i; - Alcotest.(check (option hash)) h (Some (sha1 h)) v; - Fmt.pr "<-%d@." i + Alcotest.(check (option hash)) h (Some (sha1 h)) v in - List.mapi check branches |> Eio.Fiber.all + List.map check branches |> Eio.Fiber.all in - let name = Context.fresh_name "branch" in + let name = Context.fresh_name ~fs "branch" in let t = Branch.v ~sw ~fresh:true name in add t; test t; @@ -490,39 +495,42 @@ module Branch = struct let t = Branch.v ~sw ~fresh:false ~readonly:true name in test t; Branch.close t; - let name = Context.fresh_name "branch" in + let name = Context.fresh_name ~fs "branch" in let t1 = Branch.v ~sw ~fresh:true ~readonly:false name in let t2 = Branch.v ~sw ~fresh:false ~readonly:true name in add t1; Branch.close t1; test t2 - let tests = + let tests ~fs = [ - Alcotest.test_case "branch" `Quick test_branch; - Alcotest.test_case "branch close" `Quick test_close_branch; + Alcotest.test_case "branch" `Quick (test_branch ~fs); + Alcotest.test_case "branch close" `Quick (test_close_branch ~fs); ] end module Layout = struct - let test_classify_upper_filename () = + let basename path = snd @@ Option.get @@ Eio.Path.split path + + let test_classify_upper_filename ~fs () = let module V1_and_v2 = Irmin_pack.Layout.V1_and_v2 in let module V4 = Irmin_pack.Layout.V4 in let module Classification = Irmin_pack.Layout.Classification.Upper in let c = Alcotest.(check (testable_repr Classification.t)) "" in let classif = Classification.v in - c `V1_or_v2_pack (V1_and_v2.pack ~root:"" |> classif); - c `Branch (V4.branch ~root:"" |> classif); - c `Control (V4.control ~root:"" |> classif); - c `Control_tmp (V4.control_tmp ~root:"" |> classif); - c `Dict (V4.dict ~root:"" |> classif); - c (`Gc_result 0) (V4.gc_result ~generation:0 ~root:"" |> classif); - c (`Reachable 1) (V4.reachable ~generation:1 ~root:"" |> classif); - c (`Sorted 10) (V4.sorted ~generation:10 ~root:"" |> classif); - c (`Mapping 100) (V4.mapping ~generation:100 ~root:"" |> classif); - c (`Prefix 1000) (V4.prefix ~generation:1000 ~root:"" |> classif); - c (`Suffix 42) (V4.suffix_chunk ~chunk_idx:42 ~root:"" |> classif); - c `Unknown (V4.prefix ~generation:(-1) ~root:"" |> classif); + c `V1_or_v2_pack (V1_and_v2.pack ~root:fs |> basename |> classif); + c `Branch (V4.branch ~root:fs |> basename |> classif); + c `Control (V4.control ~root:fs |> basename |> classif); + c `Control_tmp (V4.control_tmp ~root:fs |> basename |> classif); + c `Dict (V4.dict ~root:fs |> basename |> classif); + c (`Gc_result 0) (V4.gc_result ~generation:0 ~root:fs |> basename |> classif); + c (`Reachable 1) (V4.reachable ~generation:1 ~root:fs |> basename |> classif); + c (`Sorted 10) (V4.sorted ~generation:10 ~root:fs |> basename |> classif); + c (`Mapping 100) (V4.mapping ~generation:100 ~root:fs |> basename |> classif); + c (`Prefix 1000) (V4.prefix ~generation:1000 ~root:fs |> basename |> classif); + c (`Suffix 42) + (V4.suffix_chunk ~chunk_idx:42 ~root:fs |> basename |> classif); + c `Unknown (V4.prefix ~generation:(-1) ~root:fs |> basename |> classif); c `Unknown (classif "store.toto"); c `Unknown (classif "store."); c `Unknown (classif "store"); @@ -531,15 +539,15 @@ module Layout = struct c `Unknown (classif "./store.0.prefix"); () - let test_classify_volume_filename () = + let test_classify_volume_filename ~fs () = let module V1_and_v2 = Irmin_pack.Layout.V1_and_v2 in let module V5 = Irmin_pack.Layout.V5.Volume in let module Classification = Irmin_pack.Layout.Classification.Volume in let c = Alcotest.(check (testable_repr Classification.t)) "" in let classif = Classification.v in - c `Control (V5.control ~root:"" |> classif); - c `Mapping (V5.mapping ~root:"" |> classif); - c `Data (V5.data ~root:"" |> classif); + c `Control (V5.control ~root:fs |> basename |> classif); + c `Mapping (V5.mapping ~root:fs |> basename |> classif); + c `Data (V5.data ~root:fs |> basename |> classif); c `Unknown (classif "store.toto"); c `Unknown (classif "store."); c `Unknown (classif "store"); @@ -548,43 +556,43 @@ module Layout = struct c `Unknown (classif "./store.0.prefix"); () - let tests = + let tests ~fs = [ Alcotest.test_case "classify upper files" `Quick - test_classify_upper_filename; + (test_classify_upper_filename ~fs); Alcotest.test_case "classify volume files" `Quick - test_classify_volume_filename; + (test_classify_volume_filename ~fs); ] end -let misc ~fs ~domain_mgr = +let misc ~sr ~fs ~domain_mgr = [ - ("hashes", Test_hashes.tests); - ("dict-files", Dict.tests); - ("pack-files", Pack.tests); - ("branch-files", Branch.tests); - ("read-only", Test_readonly.tests); - ("existing stores", Test_existing_stores.tests ~domain_mgr); - ("inodes", Test_inode.tests); - ("trees", Test_tree.tests); - ("version-bump", Test_pack_version_bump.tests); - ("snapshot", Test_snapshot.tests ~domain_mgr); - ("upgrade", Test_upgrade.tests ~domain_mgr); - ("gc", Test_gc.Gc.tests ~domain_mgr); - ("concurrent gc", Test_gc.Concurrent_gc.tests ~domain_mgr); - ("gc archival", Test_gc.Gc_archival.tests ~domain_mgr); - ("split", Test_gc.Split.tests ~domain_mgr); - ("flush", Test_flush_reload.tests); + ("hashes", Test_hashes.tests ~fs); + ("dict-files", Dict.tests ~fs); + ("pack-files", Pack.tests ~fs); + ("branch-files", Branch.tests ~fs); + ("read-only", Test_readonly.tests ~fs); + ("existing stores", Test_existing_stores.tests ~fs ~domain_mgr); + ("inodes", Test_inode.tests ~fs); + ("trees", Test_tree.tests ~fs); + ("version-bump", Test_pack_version_bump.tests ~sr ~fs); + ("snapshot", Test_snapshot.tests ~fs ~domain_mgr); + ("upgrade", Test_upgrade.tests ~fs ~domain_mgr); + ("gc", Test_gc.Gc.tests ~fs ~domain_mgr); + ("concurrent gc", Test_gc.Concurrent_gc.tests ~fs ~domain_mgr); + ("gc archival", Test_gc.Gc_archival.tests ~fs ~domain_mgr); + ("split", Test_gc.Split.tests ~fs ~domain_mgr); + ("flush", Test_flush_reload.tests ~fs); ("ranges", Test_ranges.tests); - ("mapping", Test_mapping.tests); + ("mapping", Test_mapping.tests ~fs); ("test_nearest_geq", Test_nearest_geq.tests); - ("layout", Layout.tests); + ("layout", Layout.tests ~fs); ("dispatcher", Test_dispatcher.tests ~fs ~domain_mgr); - ("corrupted", Test_corrupted.tests); - ("snapshot_gc", Test_gc.Snapshot.tests ~domain_mgr); + ("corrupted", Test_corrupted.tests ~fs); + ("snapshot_gc", Test_gc.Snapshot.tests ~fs ~domain_mgr); ("async tasks", Test_async.tests ~domain_mgr); - ("indexing strategy", Test_indexing_strategy.tests); - ("lower: direct", Test_lower.Direct.tests); - ("lower: store", Test_lower.Store.tests ~domain_mgr); - ("multicore", Test_multicore.tests ~domain_mgr); + ("indexing strategy", Test_indexing_strategy.tests ~fs); + ("lower: direct", Test_lower.Direct.tests ~fs); + ("lower: store", Test_lower.Store.tests ~fs ~domain_mgr); + ("multicore", Test_multicore.tests ~fs ~domain_mgr); ] diff --git a/test/irmin-pack/test_pack.mli b/test/irmin-pack/test_pack.mli index 03142f091b..97f893b0b9 100644 --- a/test/irmin-pack/test_pack.mli +++ b/test/irmin-pack/test_pack.mli @@ -14,7 +14,10 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -val suite : Irmin_test.Suite.t list +val suite : fs:Eio.Fs.dir_ty Eio.Path.t -> Irmin_test.Suite.t list val misc : - _ Eio.Domain_manager.t -> (string * unit Alcotest.test_case list) list + sr:Eio__Flow.source_ty Eio.Std.r -> + fs:Eio.Fs.dir_ty Eio.Path.t -> + domain_mgr:_ Eio.Domain_manager.t -> + (string * unit Alcotest.test_case list) list diff --git a/test/irmin-pack/test_pack_version_bump.ml b/test/irmin-pack/test_pack_version_bump.ml index 4bace34bae..63aa05187c 100644 --- a/test/irmin-pack/test_pack_version_bump.ml +++ b/test/irmin-pack/test_pack_version_bump.ml @@ -37,7 +37,20 @@ module Util = struct let exec_cmd = Common.exec_cmd let ( / ) = Filename.concat - let tmp_dir () = Filename.temp_file "test_pack_version_bump_" "" + + let tmp_dir ~sr ~fs prefix = + let cs = Cstruct.create 4 in + let rec f () = + Eio.Flow.read_exact sr cs; + let i = Cstruct.LE.get_uint16 cs 0 in + let path = Eio.Path.(fs / "/tmp" / (prefix ^ Int.to_string i)) in + match Eio.Path.kind ~follow:false path with + | `Not_found -> + Eio.Path.mkdir ~perm:0o700 path; + path + | _ -> f () + in + f () (** Copy src to dst; dst is assumed to not exist *) let copy_dir src dst = @@ -102,15 +115,16 @@ end open Util (** This sets up infrastructure to open the existing "version_1" store *) -module With_existing_store () = struct - let tmp_dir = tmp_dir () - let () = [%log.info "Using temporary directory %s" tmp_dir] - +module With_existing_store = struct (* Make a copy of the v1_store_archive_dir in tmp_dir *) - let () = + let init ~sr ~fs () = + let tmp_dir = tmp_dir ~sr ~fs "test_pack_version_bump_" in rm_dir tmp_dir; - copy_dir (project_root () / v1_store_archive_dir) tmp_dir; - () + [%log.info "Using temporary directory %s" (Eio.Path.native_exn tmp_dir)]; + copy_dir + (project_root () / v1_store_archive_dir) + (Eio.Path.native_exn tmp_dir); + tmp_dir (* [S] is the functionality we use from Private, together with an appropriate config *) @@ -118,44 +132,50 @@ module With_existing_store () = struct (* Code copied and modified from test_existing_stores.ml; this is the config for index and pack *) - let config ~readonly : Irmin.config = + let config ~tmp_dir ~readonly : Irmin.config = Irmin_pack.config ~readonly ~index_log_size:1000 ~fresh:false tmp_dir end (** {2 The tests} *) (** Cannot open a V1 store in RO mode. *) -let test_RO_no_migration () : unit = +let test_RO_no_migration ~sr ~fs () : unit = [%log.info "Executing test_RO_no_migration"]; Eio.Switch.run @@ fun sw -> - let open With_existing_store () in + let tmp_dir = With_existing_store.init ~sr ~fs () in assert (io_get_version ~root:tmp_dir = `V1); let () = Alcotest.check_raises "open V1 store in RO" (Irmin_pack_unix.Errors.Pack_error `Migration_needed) (fun () -> - let repo = S.Repo.v ~sw (config ~readonly:true) in - S.Repo.close repo) + let repo = + With_existing_store.S.Repo.v ~sw ~fs + (With_existing_store.config ~tmp_dir ~readonly:true) + in + With_existing_store.S.Repo.close repo) in (* maybe the version bump is only visible after, check again *) alco_check_version ~pos:__POS__ ~expected:`V1 ~actual:(io_get_version ~root:tmp_dir) (** Open a V1 store RW mode. Even if no writes, the store migrates to V3. *) -let test_open_RW () = +let test_open_RW ~sr ~fs () = [%log.info "Executing test_open_RW"]; Eio.Switch.run @@ fun sw -> - let open With_existing_store () in + let tmp_dir = With_existing_store.init ~sr ~fs () in assert (io_get_version ~root:tmp_dir = `V1); - let repo = S.Repo.v ~sw (config ~readonly:false) in - let () = S.Repo.close repo in + let repo = + With_existing_store.S.Repo.v ~sw ~fs + (With_existing_store.config ~tmp_dir ~readonly:false) + in + let () = With_existing_store.S.Repo.close repo in alco_check_version ~pos:__POS__ ~expected:`V3 ~actual:(io_get_version ~root:tmp_dir) -let tests = +let tests ~sr ~fs = let f g () = g () in Alcotest. [ - test_case "test_RO_no_migration" `Quick (f test_RO_no_migration); - test_case "test_open_RW" `Quick (f test_open_RW); + test_case "test_RO_no_migration" `Quick (f (test_RO_no_migration ~sr ~fs)); + test_case "test_open_RW" `Quick (f (test_open_RW ~sr ~fs)); ] diff --git a/test/irmin-pack/test_pack_version_bump.mli b/test/irmin-pack/test_pack_version_bump.mli index d38ba9a90a..452d01afb3 100644 --- a/test/irmin-pack/test_pack_version_bump.mli +++ b/test/irmin-pack/test_pack_version_bump.mli @@ -1 +1 @@ -val tests : unit Alcotest.test_case list +val tests : sr:Eio__Flow.source_ty Eio.Std.r -> fs:Eio.Fs.dir_ty Eio.Path.t -> unit Alcotest.test_case list diff --git a/test/irmin-pack/test_readonly.ml b/test/irmin-pack/test_readonly.ml index c014910b2c..bc9e5db5fe 100644 --- a/test/irmin-pack/test_readonly.ml +++ b/test/irmin-pack/test_readonly.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test-readonly" +let root ~fs = Eio.Path.(fs / "_build" / "test-readonly") let src = Logs.Src.create "tests.readonly" ~doc:"Tests read-only stores" module Log = (val Logs.src_log src : Logs.LOG) @@ -34,14 +34,15 @@ let config ?(readonly = false) ?(fresh = true) root = let info () = S.Info.empty -let open_ro_after_rw_closed () = +let open_ro_after_rw_closed ~fs () = + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~readonly:false ~fresh:true root) in + let rw = S.Repo.v ~sw ~fs (config ~readonly:false ~fresh:true root) in let t = S.main rw in let tree = S.Tree.singleton [ "a" ] "x" in S.set_tree_exn ~parents:[] ~info t [] tree; - let ro = S.Repo.v ~sw (config ~readonly:true ~fresh:false root) in + let ro = S.Repo.v ~sw ~fs (config ~readonly:true ~fresh:false root) in S.Repo.close rw; let t = S.main ro in let c = S.Head.get t in @@ -67,7 +68,7 @@ let check_binding ?msg repo commit key value = let x = S.Tree.find tree key in Alcotest.(check (option string)) msg (Some value) x -let ro_reload_after_add () = +let ro_reload_after_add ~fs () = let check ro c k v = match S.Commit.of_hash ro (S.Commit.hash c) with | None -> Alcotest.failf "commit not found" @@ -76,10 +77,11 @@ let ro_reload_after_add () = let x = S.Tree.find tree [ k ] in Alcotest.(check (option string)) "RO find" (Some v) x in + let root = root ~fs in rm_dir root; Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~readonly:false ~fresh:true root) in - let ro = S.Repo.v ~sw (config ~readonly:true ~fresh:false root) in + let rw = S.Repo.v ~sw ~fs (config ~readonly:false ~fresh:true root) in + let ro = S.Repo.v ~sw ~fs (config ~readonly:true ~fresh:false root) in let tree = S.Tree.singleton [ "a" ] "x" in let c1 = S.Commit.v rw ~parents:[] ~info:(info ()) tree in S.reload ro; @@ -97,12 +99,13 @@ let ro_reload_after_add () = S.Repo.close ro; S.Repo.close rw -let ro_reload_after_close () = +let ro_reload_after_close ~fs () = + let root = root ~fs in let binding f = f [ "a" ] "x" in rm_dir root; Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~readonly:false ~fresh:true root) in - let ro = S.Repo.v ~sw (config ~readonly:true ~fresh:false root) in + let rw = S.Repo.v ~sw ~fs (config ~readonly:false ~fresh:true root) in + let ro = S.Repo.v ~sw ~fs (config ~readonly:true ~fresh:false root) in let tree = binding (S.Tree.singleton ?metadata:None) in let c1 = S.Commit.v rw ~parents:[] ~info:(info ()) tree in S.Repo.close rw; @@ -110,21 +113,22 @@ let ro_reload_after_close () = binding (check_binding ro c1); S.Repo.close ro -let ro_batch () = +let ro_batch ~fs () = Eio.Switch.run @@ fun sw -> - let rw = S.Repo.v ~sw (config ~readonly:false ~fresh:true root) in - let ro = S.Repo.v ~sw (config ~readonly:true ~fresh:false root) in + let root = root ~fs in + let rw = S.Repo.v ~sw ~fs (config ~readonly:false ~fresh:true root) in + let ro = S.Repo.v ~sw ~fs (config ~readonly:true ~fresh:false root) in Alcotest.check_raises "Read-only store throws RO_not_allowed exception" Irmin_pack_unix.Errors.RO_not_allowed (fun () -> S.Backend.Repo.batch ro (fun _ _ _ -> ())); S.Repo.close ro; S.Repo.close rw -let tests = +let tests ~fs = let tc name test = Alcotest.test_case name `Quick test in [ - tc "Test open ro after rw closed" open_ro_after_rw_closed; - tc "Test ro reload after add" ro_reload_after_add; - tc "Test ro reload after close" ro_reload_after_close; - tc "Test ro batch" ro_batch; + tc "Test open ro after rw closed" (open_ro_after_rw_closed ~fs); + tc "Test ro reload after add" (ro_reload_after_add ~fs); + tc "Test ro reload after close" (ro_reload_after_close ~fs); + tc "Test ro batch" (ro_batch ~fs); ] diff --git a/test/irmin-pack/test_readonly.mli b/test/irmin-pack/test_readonly.mli index 2b40d2f891..9893a1a314 100644 --- a/test/irmin-pack/test_readonly.mli +++ b/test/irmin-pack/test_readonly.mli @@ -14,4 +14,4 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -val tests : unit Alcotest.test_case list +val tests : fs:Eio.Fs.dir_ty Eio.Path.t -> unit Alcotest.test_case list diff --git a/test/irmin-pack/test_snapshot.ml b/test/irmin-pack/test_snapshot.ml index af15fae27b..78db1261d2 100644 --- a/test/irmin-pack/test_snapshot.ml +++ b/test/irmin-pack/test_snapshot.ml @@ -17,8 +17,8 @@ open! Import open Common -let root_export = Filename.concat "_build" "test-snapshot-export" -let root_import = Filename.concat "_build" "test-snapshot-import" +let root_export ~fs = Eio.Path.(fs / "_build" / "test-snapshot-export") +let root_import ~fs = Eio.Path.(fs / "_build" / "test-snapshot-import") let src = Logs.Src.create "tests.snapshot" ~doc:"Tests" module Log = (val Logs.src_log src : Logs.LOG) @@ -125,7 +125,9 @@ let tree2 () = let t = S.Tree.add t [ "c" ] "y" in S.Tree.add t [ "d" ] "y" -let test_in_memory ~indexing_strategy () = +let test_in_memory ~fs ~indexing_strategy () = + let root_export = root_export ~fs in + let root_import = root_import ~fs in rm_dir root_export; rm_dir root_import; Eio.Switch.run @@ fun sw -> @@ -151,7 +153,9 @@ let test_in_memory_minimal = let test_in_memory_always = test_in_memory ~indexing_strategy:Irmin_pack.Indexing_strategy.always -let test_on_disk ~indexing_strategy () = +let test_on_disk ~fs ~indexing_strategy () = + let root_export = root_export ~fs in + let root_import = root_import ~fs in rm_dir root_export; rm_dir root_import; let index_on_disk = Eio.Path.(root_import / "index_on_disk") in @@ -176,9 +180,9 @@ let test_on_disk_minimal = let test_on_disk_always = test_on_disk ~indexing_strategy:Irmin_pack.Indexing_strategy.always -let start_gc domain_mgr repo commit = +let start_gc ~fs ~domain_mgr repo commit = let commit_key = S.Commit.key commit in - let launched = S.Gc.start_exn ~domain_mgr ~unlink:false repo commit_key in + let launched = S.Gc.start_exn ~fs ~domain_mgr ~unlink:false repo commit_key in assert launched let finalise_gc repo = @@ -187,7 +191,8 @@ let finalise_gc repo = | `Idle | `Running -> Alcotest.fail "expected finalised gc" | `Finalised _ -> () -let test_gc domain_mgr ~repo_export ~repo_import ?on_disk expected_visited = +let test_gc ~fs ~domain_mgr ~repo_export ~repo_import ?on_disk expected_visited + = (* create the store *) let tree1 = let t = S.Tree.singleton [ "b"; "a" ] "x0" in @@ -203,7 +208,7 @@ let test_gc domain_mgr ~repo_export ~repo_import ?on_disk expected_visited = in let c3 = S.Commit.v repo_export ~parents:[ k1 ] ~info tree3 in (* call gc on last commit *) - let () = start_gc domain_mgr repo_export c3 in + let () = start_gc ~fs ~domain_mgr repo_export c3 in let () = finalise_gc repo_export in let tree = S.Commit.tree c3 in let root_key = S.Tree.key tree |> Option.get in @@ -225,7 +230,9 @@ let test_gc domain_mgr ~repo_export ~repo_import ?on_disk expected_visited = let indexing_strategy = Irmin_pack.Indexing_strategy.minimal -let test_gced_store_in_memory domain_mgr () = +let test_gced_store_in_memory ~fs ~domain_mgr () = + let root_export = root_export ~fs in + let root_import = root_import ~fs in rm_dir root_export; rm_dir root_import; Eio.Switch.run @@ fun sw -> @@ -237,14 +244,16 @@ let test_gced_store_in_memory domain_mgr () = S.Repo.v ~sw ~fs (config ~readonly:false ~fresh:true ~indexing_strategy root_import) in - let () = test_gc domain_mgr ~repo_export ~repo_import 5 in + let () = test_gc ~fs ~domain_mgr ~repo_export ~repo_import 5 in let () = S.Repo.close repo_export in S.Repo.close repo_import -let test_gced_store_on_disk domain_mgr () = +let test_gced_store_on_disk ~fs ~domain_mgr () = + let root_export = root_export ~fs in + let root_import = root_import ~fs in rm_dir root_export; rm_dir root_import; - let index_on_disk = Filename.concat root_import "index_on_disk" in + let index_on_disk = Eio.Path.(root_import / "index_on_disk") in Eio.Switch.run @@ fun sw -> let repo_export = S.Repo.v ~sw ~fs @@ -255,13 +264,15 @@ let test_gced_store_on_disk domain_mgr () = (config ~readonly:false ~fresh:true ~indexing_strategy root_import) in let () = - test_gc domain_mgr ~repo_export ~repo_import ~on_disk:(`Path index_on_disk) - 5 + test_gc ~fs ~domain_mgr ~repo_export ~repo_import + ~on_disk:(`Path index_on_disk) 5 in let () = S.Repo.close repo_export in S.Repo.close repo_import -let test_export_import_reexport domain_mgr () = +let test_export_import_reexport ~fs ~domain_mgr () = + let root_export = root_export ~fs in + let root_import = root_import ~fs in rm_dir root_export; rm_dir root_import; Eio.Switch.run @@ fun sw -> @@ -297,7 +308,7 @@ let test_export_import_reexport domain_mgr () = let commit_hash = S.Commit.hash commit in (* export the gc-based snapshot in a clean root_export. *) let () = - S.create_one_commit_store ~domain_mgr repo_import commit_key root_export + S.create_one_commit_store ~fs ~domain_mgr repo_import commit_key root_export in let () = S.Repo.close repo_import in (* open the new store and check that everything is readable. *) @@ -312,15 +323,15 @@ let test_export_import_reexport domain_mgr () = Alcotest.(check (option string)) "find blob" (Some "x") got; S.Repo.close repo_export -let tests domain_mgr = +let tests ~fs ~domain_mgr = let tc name f = Alcotest.test_case name `Quick f in [ - tc "in memory minimal" test_in_memory_minimal; - tc "in memory always" test_in_memory_always; - tc "on disk minimal" test_on_disk_minimal; - tc "on disk always" test_on_disk_always; - tc "gced store, in memory" (test_gced_store_in_memory domain_mgr); - tc "gced store, on disk" (test_gced_store_on_disk domain_mgr); + tc "in memory minimal" (test_in_memory_minimal ~fs); + tc "in memory always" (test_in_memory_always ~fs); + tc "on disk minimal" (test_on_disk_minimal ~fs); + tc "on disk always" (test_on_disk_always ~fs); + tc "gced store, in memory" (test_gced_store_in_memory ~fs ~domain_mgr); + tc "gced store, on disk" (test_gced_store_on_disk ~fs ~domain_mgr); tc "import old snapshot, export gc based snapshot" - (test_export_import_reexport domain_mgr); + (test_export_import_reexport ~fs ~domain_mgr); ] diff --git a/test/irmin-pack/test_tree.ml b/test/irmin-pack/test_tree.ml index 7b16726646..8d50683876 100644 --- a/test/irmin-pack/test_tree.ml +++ b/test/irmin-pack/test_tree.ml @@ -17,7 +17,7 @@ open! Import open Common -let root = Filename.concat "_build" "test-tree" +let root ~fs = Eio.Path.(fs / "_build" / "test-tree") let src = Logs.Src.create "tests.tree" ~doc:"Tests" module Log = (val Logs.src_log src : Logs.LOG) @@ -46,7 +46,7 @@ module Make (Conf : Irmin_pack.Conf.S) = struct type context = { repo : Store.repo; tree : Store.tree } let export_tree_to_store ~sw ~fs tree = - let repo = Store.Repo.v ~sw ~fs (config ~fresh:true root) in + let repo = Store.Repo.v ~sw ~fs (config ~fresh:true (root ~fs)) in let store = Store.empty repo in let () = Store.set_tree_exn ~info store [] tree in let tree = Store.tree store in @@ -185,7 +185,7 @@ let another_random_steps = let zero = String.make 10 '0' let bindings steps = List.map (fun x -> ([ x ], zero)) steps -let test_fold ?export_tree_to_store:(export_tree_to_store' = true) ~order +let test_fold ~fs ?export_tree_to_store:(export_tree_to_store' = true) ~order bindings expected = Eio.Switch.run @@ fun sw -> let tree = Tree.empty () in @@ -216,32 +216,32 @@ let test_fold ?export_tree_to_store:(export_tree_to_store' = true) ~order equal_lists ~msg:(Fmt.str "Visit elements in %s order" msg) expected keys; close () -let test_fold_sorted () = +let test_fold_sorted ~fs () = let bindings = bindings steps in let expected = List.map fst bindings in - test_fold ~order:`Sorted bindings expected + test_fold ~fs ~order:`Sorted bindings expected -let test_fold_random () = +let test_fold_random ~fs () = let bindings = bindings some_steps in let state = Random.State.make [| 0 |] in - let () = test_fold ~order:(`Random state) bindings some_random_steps in + let () = test_fold ~fs ~order:(`Random state) bindings some_random_steps in let state = Random.State.make [| 1 |] in - let () = test_fold ~order:(`Random state) bindings another_random_steps in + let () = test_fold ~fs ~order:(`Random state) bindings another_random_steps in (* Random fold order should still be respected if [~force:`False]. This is a regression test for a bug in which the fold order of in-memory nodes during a non-forcing traversal was always sorted. *) let state = Random.State.make [| 1 |] in let () = - test_fold ~order:(`Random state) ~export_tree_to_store:false bindings + test_fold ~fs ~order:(`Random state) ~export_tree_to_store:false bindings another_random_steps in () -let test_fold_undefined () = +let test_fold_undefined ~fs () = let bindings = bindings steps in let expected = List.map fst bindings in - test_fold ~order:`Undefined bindings expected + test_fold ~fs ~order:`Undefined bindings expected let proof_of_bin s = match proof_of_bin s with Ok s -> s | Error (`Msg e) -> Alcotest.fail e @@ -327,7 +327,7 @@ let test_proofs ctxt ops = in () -let test_large_inode () = +let test_large_inode ~fs () = Eio.Switch.run @@ fun sw -> let bindings = bindings steps in let ctxt = init_tree ~sw ~fs bindings in @@ -340,14 +340,14 @@ let fewer_steps = "1a"; "1b"; "1c"; "1d"; "1e"; "1f"; "20"; "22"; "23"; "25"; "26"; "27"; "28"; "2a"; ][@@ocamlformat "disable"] -let test_small_inode () = +let test_small_inode ~fs () = Eio.Switch.run @@ fun sw -> let bindings = bindings fewer_steps in let ctxt = init_tree ~sw ~fs bindings in let ops = [ Add ([ "00" ], ""); Del [ "01" ] ] in test_proofs ctxt ops -let test_length_proof () = +let test_length_proof ~fs () = Eio.Switch.run @@ fun sw -> let bindings = bindings fewer_steps in let size = List.length fewer_steps in @@ -382,7 +382,7 @@ let test_length_proof () = in test_proofs ctxt ops -let test_deeper_proof () = +let test_deeper_proof ~fs () = Eio.Switch.run @@ fun sw -> let ctxt = let tree = Tree.empty () in @@ -421,7 +421,7 @@ module Binary = Make (struct end) (* test large compressed proofs *) -let test_large_proofs () = +let test_large_proofs ~fs () = (* Build a proof on a large store (branching factor = 32) *) let bindings = init_bindings 100_000 in let ops n = @@ -522,7 +522,7 @@ let check_contents_hash h s = let s' = Irmin.Type.(to_string Hash.t) h in Alcotest.(check string) "check hash" s s' -let test_extenders () = +let test_extenders ~fs () = let bindings = [ ([ "00000" ], "x"); ([ "00001" ], "y"); ([ "00010" ], "z") ] in @@ -567,7 +567,7 @@ let test_extenders () = in List.iter check_stream [ bindings; bindings2; bindings3 ] -let test_hardcoded_stream () = +let test_hardcoded_stream ~fs () = let bindings = [ ([ "00100" ], "x"); ([ "00101" ], "y"); ([ "00110" ], "z") ] in @@ -613,7 +613,7 @@ let test_hardcoded_stream () = state; if !counter <> 4 then Alcotest.fail "Not enough elements in the stream" -let test_hardcoded_proof () = +let test_hardcoded_proof ~fs () = let bindings = [ ([ "00000" ], "x"); ([ "00001" ], "y"); ([ "00010" ], "z") ] in @@ -722,9 +722,10 @@ let test_proof_exn _ = in () -let test_reexport_node () = +let test_reexport_node ~fs () = Eio.Switch.run @@ fun sw -> let tree = Store.Tree.add (Store.Tree.empty ()) [ "foo"; "a" ] "a" in + let root = root ~fs in let repo1 = Store.Repo.v ~sw ~fs (config ~fresh:true root) in let _ = Store.Backend.Repo.batch repo1 (fun c n _ -> Store.save_tree repo1 c n tree) @@ -756,24 +757,27 @@ let test_reexport_node () = in Store.Repo.close repo2 -let tests = +let tests ~fs = [ - Alcotest.test_case "fold over keys in sorted order" `Quick test_fold_sorted; - Alcotest.test_case "fold over keys in random order" `Quick test_fold_random; + Alcotest.test_case "fold over keys in sorted order" `Quick + (test_fold_sorted ~fs); + Alcotest.test_case "fold over keys in random order" `Quick + (test_fold_random ~fs); Alcotest.test_case "fold over keys in undefined order" `Quick - test_fold_undefined; + (test_fold_undefined ~fs); Alcotest.test_case "test Merkle proof for large inodes" `Quick - test_large_inode; + (test_large_inode ~fs); Alcotest.test_case "test Merkle proof for small inodes" `Quick - test_small_inode; + (test_small_inode ~fs); Alcotest.test_case "test Merkle proof for Tree.length" `Quick - test_length_proof; - Alcotest.test_case "test deeper Merkle proof" `Quick test_deeper_proof; - Alcotest.test_case "test large Merkle proof" `Slow test_large_proofs; - Alcotest.test_case "test extenders in stream proof" `Quick test_extenders; + (test_length_proof ~fs); + Alcotest.test_case "test deeper Merkle proof" `Quick (test_deeper_proof ~fs); + Alcotest.test_case "test large Merkle proof" `Slow (test_large_proofs ~fs); + Alcotest.test_case "test extenders in stream proof" `Quick + (test_extenders ~fs); Alcotest.test_case "test hardcoded stream proof" `Quick - test_hardcoded_stream; - Alcotest.test_case "test hardcoded proof" `Quick test_hardcoded_proof; + (test_hardcoded_stream ~fs); + Alcotest.test_case "test hardcoded proof" `Quick (test_hardcoded_proof ~fs); Alcotest.test_case "test stream proof exn" `Quick test_proof_exn; - Alcotest.test_case "test reexport node" `Quick test_reexport_node; + Alcotest.test_case "test reexport node" `Quick (test_reexport_node ~fs); ] diff --git a/test/irmin-pack/test_upgrade.ml b/test/irmin-pack/test_upgrade.ml index 4136939796..fed144687c 100644 --- a/test/irmin-pack/test_upgrade.ml +++ b/test/irmin-pack/test_upgrade.ml @@ -17,16 +17,22 @@ open! Import open Common -let ( / ) = Filename.concat -let archive_v2_minimal = "test" / "irmin-pack" / "data" / "version_2_minimal" -let archive_v2_always = "test" / "irmin-pack" / "data" / "version_2_always" -let archive_v3_minimal = "test" / "irmin-pack" / "data" / "version_3_minimal" -let archive_v3_always = "test" / "irmin-pack" / "data" / "version_3_always" +let archive_v2_minimal ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_2_minimal") -let archive_v3_minimal_gced = - "test" / "irmin-pack" / "data" / "version_3_minimal_gced" +let archive_v2_always ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_2_always") -let root_local_build = "_build" / "test-upgrade" +let archive_v3_minimal ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal") + +let archive_v3_always ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_always") + +let archive_v3_minimal_gced ~fs = + Eio.Path.(fs / "test" / "irmin-pack" / "data" / "version_3_minimal_gced") + +let root_local_build ~fs = Eio.Path.(fs / "_build" / "test-upgrade") type pack_entry = { h : Schema.Hash.t; @@ -245,9 +251,9 @@ module Store = struct let close = S.Repo.close let reload = S.reload - let gc domain_mgr repo = + let gc ~fs ~domain_mgr repo = let k = key_of_entry c1 in - let launched = S.Gc.start_exn ~domain_mgr ~unlink:true repo k in + let launched = S.Gc.start_exn ~fs ~domain_mgr ~unlink:true repo k in assert launched; let result = S.Gc.finalise_exn ~wait:true repo in match result with @@ -452,26 +458,27 @@ let check t = check_suffix repo model) (Option.to_list t.ro @ Option.to_list t.rw) -let create_test_env setup = +let create_test_env ~fs setup = + let root_local_build = root_local_build ~fs in rm_dir root_local_build; let () = match setup.start_mode with | From_scratch -> () | From_v2 -> let root_archive = - if setup.indexing_strategy = `always then archive_v2_always - else archive_v2_minimal + if setup.indexing_strategy = `always then archive_v2_always ~fs + else archive_v2_minimal ~fs in setup_test_env ~root_archive ~root_local_build | From_v3 -> let root_archive = - if setup.indexing_strategy = `always then archive_v3_always - else archive_v3_minimal + if setup.indexing_strategy = `always then archive_v3_always ~fs + else archive_v3_minimal ~fs in setup_test_env ~root_archive ~root_local_build | From_v3_c0_gced -> let root_archive = - if setup.indexing_strategy = `minimal then archive_v3_minimal_gced + if setup.indexing_strategy = `minimal then archive_v3_minimal_gced ~fs else assert false in setup_test_env ~root_archive ~root_local_build @@ -480,7 +487,7 @@ let create_test_env setup = { setup; rw = None; ro = None } (** One of the 4 rw mutations *) -let start_rw ~sw t = +let start_rw ~sw ~fs t = [%logs.app "*** start_rw %a" pp_setup t.setup]; let rw = match t.rw with @@ -496,7 +503,8 @@ let start_rw ~sw t = | From_scratch -> Model.v t.setup in let repo = - Store.v ~sw t.setup ~readonly:false ~fresh:false root_local_build + Store.v ~sw ~fs t.setup ~readonly:false ~fresh:false + (root_local_build ~fs) in (model, repo) in @@ -522,7 +530,7 @@ let write1_rw t = () (** One of the 4 rw mutations *) -let gc_rw domain_mgr t = +let gc_rw ~fs ~domain_mgr t = [%logs.app "*** gc_rw %a" pp_setup t.setup]; match t.rw with | None -> assert false @@ -535,11 +543,11 @@ let gc_rw domain_mgr t = Alcotest.check_raises "GC on V2/always" (Irmin_pack_unix.Errors.Pack_error (`Gc_disallowed "Store does not support GC")) - (fun () -> Store.gc domain_mgr repo) + (fun () -> Store.gc ~fs ~domain_mgr repo) in raise Skip_the_rest_of_that_test | (From_v3 | From_scratch | From_v3_c0_gced), `minimal -> - Store.gc domain_mgr repo + Store.gc ~fs ~domain_mgr repo in () @@ -554,7 +562,7 @@ let write2_rw t = () (** One of the 2 ro mutations *) -let open_ro ~sw t current_phase = +let open_ro ~sw ~fs t current_phase = [%logs.app "*** open_ro %a, %a" pp_setup t.setup pp_phase current_phase]; let ro = match t.ro with @@ -582,8 +590,8 @@ let open_ro ~sw t current_phase = Alcotest.check_raises "open empty/V2 store in RO" (Irmin_pack_unix.Errors.Pack_error error) (fun () -> let repo = - Store.v ~sw t.setup ~readonly:true ~fresh:false - root_local_build + Store.v ~sw ~fs t.setup ~readonly:true ~fresh:false + (root_local_build ~fs) in Store.close repo) in @@ -593,12 +601,14 @@ let open_ro ~sw t current_phase = match (t.setup.start_mode, current_phase) with | From_scratch, S1_before_start -> let missing_path = - Irmin_pack.Layout.V1_and_v2.pack ~root:root_local_build + Irmin_pack.Layout.V1_and_v2.pack ~root:(root_local_build ~fs) in - fail_and_skip (`No_such_file_or_directory missing_path) + fail_and_skip + (`No_such_file_or_directory (Eio.Path.native_exn missing_path)) | From_v2, S1_before_start -> fail_and_skip `Migration_needed | (From_v2 | From_v3 | From_v3_c0_gced | From_scratch), _ -> - Store.v ~sw t.setup ~readonly:true ~fresh:false root_local_build + Store.v ~sw ~fs t.setup ~readonly:true ~fresh:false + (root_local_build ~fs) in (model, repo) in @@ -625,30 +635,30 @@ let close_everything t = (fun (_, repo) -> Store.close repo) (Option.to_list t.ro @ Option.to_list t.rw) -let test_one domain_mgr t ~ro_open_at ~ro_sync_at = +let test_one ~domain_mgr ~fs t ~ro_open_at ~ro_sync_at = Eio.Switch.run @@ fun sw -> let aux phase = let () = check t in - let () = if ro_open_at = phase then open_ro ~sw t phase else () in + let () = if ro_open_at = phase then open_ro ~sw ~fs t phase else () in let () = check t in if ro_sync_at = phase then sync_ro t phase; check t in let () = aux S1_before_start in - let () = start_rw ~sw t in + let () = start_rw ~sw ~fs t in let () = aux S2_before_write in let () = write1_rw t in let () = aux S3_before_gc in - let () = gc_rw domain_mgr t in + let () = gc_rw ~domain_mgr ~fs t in let () = aux S4_before_write in let () = write2_rw t in aux S5_before_close -let test_one_guarded domain_mgr setup ~ro_open_at ~ro_sync_at = - let t = create_test_env setup in +let test_one_guarded ~domain_mgr ~fs setup ~ro_open_at ~ro_sync_at = + let t = create_test_env ~fs setup in try - let () = test_one domain_mgr t ~ro_open_at ~ro_sync_at in + let () = test_one ~domain_mgr ~fs t ~ro_open_at ~ro_sync_at in close_everything t with | Skip_the_rest_of_that_test -> @@ -658,9 +668,9 @@ let test_one_guarded domain_mgr setup ~ro_open_at ~ro_sync_at = (** All possible interleaving of the ro calls (open and sync) with the rw calls (open, write1, gc and write2). *) -let test domain_mgr start_mode indexing_strategy lru_size = +let test ~domain_mgr ~fs start_mode indexing_strategy lru_size = let setup = { start_mode; indexing_strategy; lru_size } in - let t = test_one_guarded domain_mgr setup in + let t = test_one_guarded ~domain_mgr ~fs setup in let () = t ~ro_open_at:S1_before_start ~ro_sync_at:S1_before_start in let () = t ~ro_open_at:S1_before_start ~ro_sync_at:S2_before_write in @@ -684,24 +694,24 @@ let test domain_mgr start_mode indexing_strategy lru_size = () (** Product on lru_size *) -let test domain_mgr start_mode indexing_strategy = - test domain_mgr start_mode indexing_strategy 0; - test domain_mgr start_mode indexing_strategy 100 +let test ~domain_mgr ~fs start_mode indexing_strategy = + test ~domain_mgr ~fs start_mode indexing_strategy 0; + test ~domain_mgr ~fs start_mode indexing_strategy 100 -let test_gced_store domain_mgr () = test domain_mgr From_v3_c0_gced `minimal +let test_gced_store ~domain_mgr () = test ~domain_mgr From_v3_c0_gced `minimal (** Product on indexing_strategy *) -let test domain_mgr start_mode () = - test domain_mgr start_mode `minimal; - test domain_mgr start_mode `always +let test ~fs ~domain_mgr start_mode () = + test ~fs ~domain_mgr start_mode `minimal; + test ~fs ~domain_mgr start_mode `always (** Product on start_mode *) -let tests domain_mgr = +let tests ~fs ~domain_mgr = [ - Alcotest.test_case "upgrade From_v3" `Quick (test domain_mgr From_v3); - Alcotest.test_case "upgrade From_v2" `Quick (test domain_mgr From_v2); + Alcotest.test_case "upgrade From_v3" `Quick (test ~fs ~domain_mgr From_v3); + Alcotest.test_case "upgrade From_v2" `Quick (test ~fs ~domain_mgr From_v2); Alcotest.test_case "upgrade From_scratch" `Quick - (test domain_mgr From_scratch); + (test ~fs ~domain_mgr From_scratch); Alcotest.test_case "upgrade From_v3 after Gc" `Quick - (test_gced_store domain_mgr); + (test_gced_store ~fs ~domain_mgr); ] diff --git a/test/irmin-tezos/generate.ml b/test/irmin-tezos/generate.ml index 450a5a94ec..fc7b81c792 100644 --- a/test/irmin-tezos/generate.ml +++ b/test/irmin-tezos/generate.ml @@ -14,11 +14,7 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) -let rm_dir data_dir = - if Sys.file_exists data_dir then - let cmd = Printf.sprintf "rm -rf %s" data_dir in - let _ = Sys.command cmd in - () +let rm_dir data_root = Eio.Path.rmtree ~missing_ok:true data_root module Generator = struct module Conf = struct @@ -40,11 +36,11 @@ module Generator = struct let info = Store.Info.empty - let create_store ~sw ?(before_closing = fun _repo _head -> ()) + let create_store ~sw ~fs ?(before_closing = fun _repo _head -> ()) indexing_strategy path = rm_dir path; let large_contents = String.make 4096 'Z' in - let rw = Store.Repo.v ~sw (config ~indexing_strategy path) in + let rw = Store.Repo.v ~sw ~fs (config ~indexing_strategy path) in let tree = Store.Tree.singleton [ "a"; "b1"; "c1"; "d1"; "e1" ] "x1" in let tree = Store.Tree.add tree [ "a"; "b1"; "c1"; "d2"; "e2" ] "x2" in let tree = Store.Tree.add tree [ "a"; "b1"; "c1"; "d3"; "e3" ] "x2" in @@ -63,44 +59,50 @@ module Generator = struct c3 - let create_gced_store ~sw domain_mgr path = + let create_gced_store ~sw ~fs ~domain_mgr path = let before_closing repo head = - let _ = Store.Gc.start_exn ~domain_mgr repo head in + let _ = Store.Gc.start_exn ~fs ~domain_mgr repo head in let _ = Store.Gc.wait repo in () in - create_store ~sw ~before_closing Irmin_pack.Indexing_strategy.minimal path + create_store ~sw ~fs ~before_closing Irmin_pack.Indexing_strategy.minimal + path - let create_snapshot_store ~sw domain_mgr ~src ~dest = + let create_snapshot_store ~sw ~fs ~domain_mgr ~src ~dest = let before_closing repo head = rm_dir dest; - Store.create_one_commit_store ~domain_mgr repo head dest + Store.create_one_commit_store ~fs ~domain_mgr repo head dest in - create_store ~sw ~before_closing Irmin_pack.Indexing_strategy.minimal src + create_store ~sw ~fs ~before_closing Irmin_pack.Indexing_strategy.minimal + src end let ensure_data_dir () = if not (Sys.file_exists "data") then Unix.mkdir "data" 0o755 -let generate domain_mgr () = +let generate ~fs ~domain_mgr () = ensure_data_dir (); Eio.Switch.run @@ fun sw -> let _ = - Generator.create_store ~sw Irmin_pack.Indexing_strategy.minimal - "data/minimal" + Generator.create_store ~sw ~fs Irmin_pack.Indexing_strategy.minimal + Eio.Path.(fs / "data/minimal") in let _ = - Generator.create_store ~sw Irmin_pack.Indexing_strategy.always "data/always" + Generator.create_store ~sw ~fs Irmin_pack.Indexing_strategy.always + Eio.Path.(fs / "data/always") in - let _ = Generator.create_gced_store ~sw domain_mgr "data/gced" in let _ = - Generator.create_snapshot_store domain_mgr ~sw ~src:"data/snapshot_src" - ~dest:"data/snapshot" + Generator.create_gced_store ~sw ~fs ~domain_mgr Eio.Path.(fs / "data/gced") + in + let _ = + Generator.create_snapshot_store ~domain_mgr ~sw ~fs + ~src:Eio.Path.(fs / "data/snapshot_src") + ~dest:Eio.Path.(fs / "data/snapshot") in () let () = Eio_main.run @@ fun env -> + let fs = Eio.Stdenv.fs env in let domain_mgr = Eio.Stdenv.domain_mgr env in - Irmin_pack_unix.Io.set_env (Eio.Stdenv.fs env); - generate domain_mgr () + generate ~fs ~domain_mgr () diff --git a/test/irmin-tezos/irmin_fsck.ml b/test/irmin-tezos/irmin_fsck.ml index d1cd52c2b1..33b2dc1da3 100644 --- a/test/irmin-tezos/irmin_fsck.ml +++ b/test/irmin-tezos/irmin_fsck.ml @@ -32,9 +32,9 @@ module Store_tz = Irmin_pack_unix.Checks.Make (Maker_tz) let () = Eio_main.run @@ fun env -> - Irmin_pack_unix.Io.set_env (Eio.Stdenv.fs env); + let fs = Eio.Stdenv.fs env in try let store_type = Sys.getenv "STORE" in - if store_type = "PACK" then match Store.cli () with _ -> . + if store_type = "PACK" then match Store.cli ~fs () with _ -> . else raise Not_found - with Not_found -> ( match Store_tz.cli () with _ -> .) + with Not_found -> ( match Store_tz.cli ~fs () with _ -> .) diff --git a/test/irmin/test_tree.ml b/test/irmin/test_tree.ml index a67c7fd74b..214254e211 100644 --- a/test/irmin/test_tree.ml +++ b/test/irmin/test_tree.ml @@ -464,7 +464,6 @@ let lazy_stats = Tree.{ nodes = 0; leafs = 0; skips = 1; depth = 0; width = 0 } (* Take a tree and persist it to some underlying store, making it lazy. *) let persist_tree ~fs ?clear : Store.tree -> Store.tree = fun tree -> - Fmt.pr "persist_tree@."; Eio.Switch.run @@ fun sw -> let store = Store.Repo.v ~sw ~fs (Irmin_mem.config ()) |> Store.empty in let () = Store.set_tree_exn ?clear ~info:Store.Info.none store [] tree in @@ -540,9 +539,7 @@ let test_minimal_reads ~fs () = (* Persist with clear *) Tree.reset_counters (); let _ = persist_tree ~fs ~clear:true t in - Fmt.pr "Hello@."; let _ = Tree.find_tree t [ "0" ] in - Fmt.pr "Hello@."; let cnt = Tree.counters () in Alcotest.(check int) "reads" 1 cnt.node_find