From ded1f5ee95cc6acd8a933986c9a7beff76082796 Mon Sep 17 00:00:00 2001 From: Alpha Issiaga DIALLO Date: Fri, 13 Sep 2024 00:59:37 +0200 Subject: [PATCH] pkg: build and make ocamlformat dev-tool available (#10647) Signed-off-by: Alpha DIALLO --- bin/build_cmd.ml | 14 ++ bin/lock_dev_tool.ml | 82 ++++++++ bin/lock_dev_tool.mli | 2 + bin/pkg/lock.ml | 10 +- bin/pkg/lock.mli | 9 + boot/configure.ml | 7 +- src/dune_pkg/dev_tool.ml | 27 +++ src/dune_pkg/dev_tool.mli | 12 ++ src/dune_pkg/dune_pkg.ml | 2 + src/dune_pkg/lock_dir.ml | 8 + src/dune_pkg/lock_dir.mli | 8 + src/dune_pkg/ocamlformat.ml | 16 ++ src/dune_pkg/ocamlformat.mli | 5 + src/dune_rules/fetch_rules.ml | 19 +- src/dune_rules/format_rules.ml | 68 +++++-- src/dune_rules/lock_dir.ml | 10 + src/dune_rules/lock_dir.mli | 1 + src/dune_rules/pkg_dev_tool.ml | 30 +++ src/dune_rules/pkg_dev_tool.mli | 16 ++ src/dune_rules/pkg_rules.ml | 177 +++++++++++++----- src/dune_rules/setup.defaults.ml | 1 + src/dune_rules/setup.mli | 1 + test/blackbox-tests/test-cases/pkg/dune | 7 +- .../test-cases/pkg/ocamlformat/dune | 3 + .../test-cases/pkg/ocamlformat/helpers.sh | 168 +++++++++++++++++ .../ocamlformat-avoid-conflict-with-project.t | 44 +++++ ...amlformat-avoid-taking-from-project-deps.t | 69 +++++++ ...rmat-dev-tool-deps-conflict-project-deps.t | 150 +++++++++++++++ .../ocamlformat-dev-tool-fails-to-build.t | 27 +++ .../pkg/ocamlformat/ocamlformat-e2e.t | 75 ++++++++ .../pkg/ocamlformat/ocamlformat-ignore.t | 58 ++++++ .../ocamlformat/ocamlformat-solving-fails.t | 23 +++ 32 files changed, 1076 insertions(+), 73 deletions(-) create mode 100644 bin/lock_dev_tool.ml create mode 100644 bin/lock_dev_tool.mli create mode 100644 src/dune_pkg/dev_tool.ml create mode 100644 src/dune_pkg/dev_tool.mli create mode 100644 src/dune_pkg/ocamlformat.ml create mode 100644 src/dune_pkg/ocamlformat.mli create mode 100644 src/dune_rules/pkg_dev_tool.ml create mode 100644 src/dune_rules/pkg_dev_tool.mli create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/dune create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-conflict-with-project.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-taking-from-project-deps.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-deps-conflict-project-deps.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t diff --git a/bin/build_cmd.ml b/bin/build_cmd.ml index b7e09e8fedd..66c636c72ae 100644 --- a/bin/build_cmd.ml +++ b/bin/build_cmd.ml @@ -231,6 +231,20 @@ let fmt = in let common, config = Common.init builder in let request (setup : Import.Main.build_system) = + let open Action_builder.O in + let* () = + if Lazy.force Lock_dev_tool.is_enabled + then + (* Note that generating the ocamlformat lockdir here means + that it will be created when a user runs `dune fmt` but not + when a user runs `dune build @fmt`. It's important that + this logic remain outside of `dune build`, as `dune + build` is intended to only build targets, and generating + a lockdir is not building a target. *) + Action_builder.of_memo + (Lock_dev_tool.lock_ocamlformat () |> Memo.of_non_reproducible_fiber) + else Action_builder.return () + in let dir = Path.(relative root) (Common.prefix_target common ".") in Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir |> Alias.request diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml new file mode 100644 index 00000000000..bcf676e1b49 --- /dev/null +++ b/bin/lock_dev_tool.ml @@ -0,0 +1,82 @@ +open Dune_config +open Import + +let enabled = + Config.make_toggle ~name:"lock_dev_tool" ~default:Dune_rules.Setup.lock_dev_tool +;; + +let is_enabled = + lazy + (match Config.get enabled with + | `Enabled -> true + | `Disabled -> false) +;; + +(* The solver satisfies dependencies for local packages, but dev tools + are not local packages. As a workaround, create an empty local package + which depends on the dev tool package. *) +let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version + : Dune_pkg.Local_package.t + = + let dev_tool_pkg_name = Dune_pkg.Dev_tool.package_name dev_tool in + let dependency = + let open Dune_lang in + let open Package_dependency in + let constraint_ = + Option.map dev_tool_version ~f:(fun version -> + Package_constraint.Uop + ( Relop.Eq + , Package_constraint.Value.String_literal (Package_version.to_string version) )) + in + { name = dev_tool_pkg_name; constraint_ } + in + let local_package_name = + Package_name.of_string (Package_name.to_string dev_tool_pkg_name ^ "_dev_tool_wrapper") + in + { Dune_pkg.Local_package.name = local_package_name + ; version = None + ; dependencies = [ dependency ] + ; conflicts = [] + ; depopts = [] + ; pins = Package_name.Map.empty + ; conflict_class = [] + ; loc = Loc.none + } +;; + +let solve ~local_packages ~lock_dirs = + let open Fiber.O in + let* solver_env_from_current_system = + Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) + |> Dune_pkg.Sys_poll.solver_env_from_current_system + >>| Option.some + and* workspace = + Memo.run + @@ + let open Memo.O in + let+ workspace = Workspace.workspace () in + workspace + in + Lock.solve + workspace + ~local_packages + ~project_sources:Dune_pkg.Pin_stanza.DB.empty + ~solver_env_from_current_system + ~version_preference:None + ~lock_dirs +;; + +let lock_ocamlformat () : unit Fiber.t = + let version = Dune_pkg.Ocamlformat.version_of_current_project's_ocamlformat_config () in + let ocamlformat_dev_tool_lock_dir = + Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat + in + if not (Path.exists @@ Path.source ocamlformat_dev_tool_lock_dir) + then ( + let local_pkg = + make_local_package_wrapping_dev_tool ~dev_tool:Ocamlformat ~dev_tool_version:version + in + let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in + solve ~local_packages ~lock_dirs:[ ocamlformat_dev_tool_lock_dir ]) + else Fiber.return () +;; diff --git a/bin/lock_dev_tool.mli b/bin/lock_dev_tool.mli new file mode 100644 index 00000000000..85f185ff83f --- /dev/null +++ b/bin/lock_dev_tool.mli @@ -0,0 +1,2 @@ +val is_enabled : bool Lazy.t +val lock_ocamlformat : unit -> unit Fiber.t diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml index 711ba402c20..b0865cdac53 100644 --- a/bin/pkg/lock.ml +++ b/bin/pkg/lock.ml @@ -144,16 +144,13 @@ let solve ~project_sources ~solver_env_from_current_system ~version_preference - ~lock_dirs_arg + ~lock_dirs = let open Fiber.O in (* a list of thunks that will perform all the file IO side effects after performing validation so that if materializing any lockdir would fail then no side effect takes place. *) (let+ errors, solutions = - let lock_dirs = - Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace - in let progress_indicator = List.map lock_dirs ~f:Progress_indicator.Per_lockdir.create in @@ -216,13 +213,16 @@ let lock ~version_preference ~lock_dirs_arg = and+ project_sources = project_sources in workspace, local_packages, project_sources in + let lock_dirs = + Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace + in solve workspace ~local_packages ~project_sources ~solver_env_from_current_system ~version_preference - ~lock_dirs_arg + ~lock_dirs ;; let term = diff --git a/bin/pkg/lock.mli b/bin/pkg/lock.mli index 6223a7744d8..dc6f5324048 100644 --- a/bin/pkg/lock.mli +++ b/bin/pkg/lock.mli @@ -1,4 +1,13 @@ open Import +val solve + : Workspace.t + -> local_packages:Dune_pkg.Local_package.t Package_name.Map.t + -> project_sources:Dune_pkg.Pin_stanza.DB.t + -> solver_env_from_current_system:Dune_pkg.Solver_env.t option + -> version_preference:Dune_pkg.Version_preference.t option + -> lock_dirs:Path.Source.t list + -> unit Fiber.t + (** Command to create lock directory *) val command : unit Cmd.t diff --git a/boot/configure.ml b/boot/configure.ml index 820fa6fa452..1af9e88da2b 100644 --- a/boot/configure.ml +++ b/boot/configure.ml @@ -18,7 +18,7 @@ let out = ;; let default_toggles : (string * [ `Disabled | `Enabled ]) list = - [ "toolchains", `Disabled; "pkg_build_progress", `Disabled ] + [ "toolchains", `Disabled; "pkg_build_progress", `Disabled; "lock_dev_tool", `Disabled ] ;; let () = @@ -87,6 +87,11 @@ let () = , Arg.Unit (toggle "pkg_build_progress") , " Enable the displaying of package build progress.\n\ \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--enable-lock-dev-tool" + , Arg.Unit (toggle "lock_dev_tool") + , " Enable ocamlformat dev-tool, allows 'dune fmt' to build ocamlformat and use \ + it, independently from the project depenedencies .\n\ + \ This flag is experimental and shouldn't be relied on by packagers." ) ] in let anon s = bad "Don't know what to do with %s" s in diff --git a/src/dune_pkg/dev_tool.ml b/src/dune_pkg/dev_tool.ml new file mode 100644 index 00000000000..0d2f26ad45f --- /dev/null +++ b/src/dune_pkg/dev_tool.ml @@ -0,0 +1,27 @@ +open! Import + +type t = Ocamlformat + +let equal a b = + match a, b with + | Ocamlformat, Ocamlformat -> true +;; + +let package_name = function + | Ocamlformat -> Package_name.of_string "ocamlformat" +;; + +let of_package_name package_name = + match Package_name.to_string package_name with + | "ocamlformat" -> Ocamlformat + | other -> User_error.raise [ Pp.textf "No such dev tool: %s" other ] +;; + +let exe_name = function + | Ocamlformat -> "ocamlformat" +;; + +let exe_path_components_within_package t = + match t with + | Ocamlformat -> [ "bin"; exe_name t ] +;; diff --git a/src/dune_pkg/dev_tool.mli b/src/dune_pkg/dev_tool.mli new file mode 100644 index 00000000000..dc8c0dfe626 --- /dev/null +++ b/src/dune_pkg/dev_tool.mli @@ -0,0 +1,12 @@ +open! Import + +type t = Ocamlformat + +val equal : t -> t -> bool +val package_name : t -> Package_name.t +val of_package_name : Package_name.t -> t +val exe_name : t -> string + +(** Returns the path to this tool's executable relative to the root of + this tool's package directory *) +val exe_path_components_within_package : t -> string list diff --git a/src/dune_pkg/dune_pkg.ml b/src/dune_pkg/dune_pkg.ml index fb0c2bd5b24..88c7bf78b13 100644 --- a/src/dune_pkg/dune_pkg.ml +++ b/src/dune_pkg/dune_pkg.ml @@ -22,3 +22,5 @@ module Variable_value = Variable_value module Resolved_package = Resolved_package module Pin_stanza = Pin_stanza module Package_name = Package_name +module Ocamlformat = Ocamlformat +module Dev_tool = Dev_tool diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 9b80a667288..a398854d7c6 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -392,6 +392,14 @@ let create_latest_version } ;; +let dev_tools_path = Path.Source.(relative root "dev-tools.locks") + +let dev_tool_lock_dir_path dev_tool = + Path.Source.relative + dev_tools_path + (Package_name.to_string (Dev_tool.package_name dev_tool)) +;; + let default_path = Path.Source.(relative root "dune.lock") let metadata_filename = "lock.dune" diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 75a80d7f24e..32721282976 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -36,6 +36,10 @@ module Pkg : sig val files_dir : Package_name.t -> lock_dir:Path.Source.t -> Path.Source.t end +module Package_filename : sig + val of_package_name : Package_name.t -> string +end + module Repositories : sig type t end @@ -74,6 +78,10 @@ val create_latest_version val default_path : Path.Source.t +(** Returns the path to the lockdir that will be used to lock the + given dev tool *) +val dev_tool_lock_dir_path : Dev_tool.t -> Path.Source.t + module Metadata : Dune_sexp.Versioned_file.S with type data := unit val metadata_filename : Filename.t diff --git a/src/dune_pkg/ocamlformat.ml b/src/dune_pkg/ocamlformat.ml new file mode 100644 index 00000000000..69d0dca3f01 --- /dev/null +++ b/src/dune_pkg/ocamlformat.ml @@ -0,0 +1,16 @@ +open Import + +let version_of_ocamlformat_config ocamlformat_config = + Io.lines_of_file ocamlformat_config + |> List.find_map ~f:(fun line -> + match String.split_on_char ~sep:'=' line |> List.map ~f:String.trim with + | [ "version"; value ] -> Some (Package_version.of_string value) + | _ -> None) +;; + +let version_of_current_project's_ocamlformat_config () = + let ocamlformat_config = Path.Source.of_string ".ocamlformat" |> Path.source in + match Path.exists ocamlformat_config with + | false -> None + | true -> version_of_ocamlformat_config ocamlformat_config +;; diff --git a/src/dune_pkg/ocamlformat.mli b/src/dune_pkg/ocamlformat.mli new file mode 100644 index 00000000000..eaf0f59183b --- /dev/null +++ b/src/dune_pkg/ocamlformat.mli @@ -0,0 +1,5 @@ +open! Import + +(** Returns the version from the current project's .ocamlformat file, + if it exists *) +val version_of_current_project's_ocamlformat_config : unit -> Package_version.t option diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index 6140f118c73..545c5386bf2 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -9,6 +9,7 @@ include struct module Pkg = Lock_dir.Pkg module OpamUrl = OpamUrl module Source = Source + module Ocamlformat = Ocamlformat end let context_name = Context_name.of_string "_fetch" @@ -154,16 +155,24 @@ let extract_checksums_and_urls (lockdir : Dune_pkg.Lock_dir.t) = ;; let find_checksum, find_url = + let add_checksums_and_urls (checksums, urls) lockdir = + let checksums', urls' = extract_checksums_and_urls lockdir in + Checksum.Map.superpose checksums checksums', Digest.Map.superpose urls urls' + in let all = Memo.lazy_ (fun () -> + let* init = + let init = Checksum.Map.empty, Digest.Map.empty in + Fs_memo.dir_exists + (In_source_dir (Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat)) + >>= function + | false -> Memo.return init + | true -> Lock_dir.of_dev_tool Ocamlformat >>| add_checksums_and_urls init + in Per_context.list () >>= Memo.parallel_map ~f:Lock_dir.get >>| List.filter_map ~f:Result.to_option - >>| List.fold_left - ~init:(Checksum.Map.empty, Digest.Map.empty) - ~f:(fun (checksums, urls) (lockdir : Dune_pkg.Lock_dir.t) -> - let checksums', urls' = extract_checksums_and_urls lockdir in - Checksum.Map.superpose checksums checksums', Digest.Map.superpose urls urls')) + >>| List.fold_left ~init ~f:add_checksums_and_urls) in let find_url digest = let+ _, urls = Memo.Lazy.force all in diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 78633231817..17f66f17a93 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -58,6 +58,11 @@ module Alias = struct end module Ocamlformat = struct + let dev_tool_lock_dir_exists () = + let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat in + Fs_memo.dir_exists (Path.source path |> Path.as_outside_build_dir_exn) + ;; + (* Config files for ocamlformat. When these are changed, running `dune fmt` should cause ocamlformat to re-format the ocaml files in the project. *) @@ -74,13 +79,34 @@ module Ocamlformat = struct | Intf -> "--intf" ;; - let action ~input kind = + let action_when_ocamlformat_is_locked ~input ~output kind = + let path = Path.build @@ Pkg_dev_tool.exe_path Ocamlformat in + let dir = Path.Build.parent_exn input in + let action = + (* An action which runs at on the file at [input] and stores the + resulting diff in the file at [output] *) + Action_builder.with_stdout_to + output + (let open Action_builder.O in + (* This ensures that at is installed as a dev tool before + running it. *) + let+ () = Action_builder.path path in + let args = [ flag_of_kind kind; Path.Build.basename input ] in + Action.chdir (Path.build dir) @@ Action.run (Ok path) args |> Action.Full.make) + in + let open Action_builder.With_targets.O in + (* Depend on [extra_deps] so if the ocamlformat config file + changes then ocamlformat will run again. *) + extra_deps dir >>> action + ;; + + let action_when_ocamlformat_isn't_locked ~input kind = let module S = String_with_vars in let dir = Path.Build.parent_exn input in ( Dune_lang.Action.chdir (S.make_pform Loc.none (Var Workspace_root)) (Dune_lang.Action.run - (S.make_text Loc.none "ocamlformat") + (S.make_text Loc.none (Pkg_dev_tool.exe_name Ocamlformat)) [ S.make_text Loc.none (flag_of_kind kind) ; S.make_pform Loc.none (Var Input_file) ]) @@ -89,20 +115,28 @@ module Ocamlformat = struct end let format_action format ~input ~output ~expander kind = - let loc, (action, extra_deps) = - match (format : Dialect.Format.t) with - | Ocamlformat -> Loc.none, Ocamlformat.action ~input kind - | Action (loc, action) -> loc, (action, With_targets.return ()) - in - let open Action_builder.With_targets.O in - extra_deps - >>> Pp_spec_rules.action_for_pp_with_target - ~sandbox:Sandbox_config.default - ~loc - ~expander - ~action - ~src:input - ~target:output + let open Memo.O in + let+ ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in + match (format : Dialect.Format.t) with + | Ocamlformat when ocamlformat_is_locked -> + Ocamlformat.action_when_ocamlformat_is_locked ~input ~output kind + | _ -> + assert (not ocamlformat_is_locked); + let loc, (action, extra_deps) = + match format with + | Ocamlformat -> + Loc.none, Ocamlformat.action_when_ocamlformat_isn't_locked ~input kind + | Action (loc, action) -> loc, (action, With_targets.return ()) + in + let open Action_builder.With_targets.O in + extra_deps + >>> Pp_spec_rules.action_for_pp_with_target + ~sandbox:Sandbox_config.default + ~loc + ~expander + ~action + ~src:input + ~target:output ;; let gen_rules_output @@ -138,7 +172,7 @@ let gen_rules_output | Some _ -> None) in format_action format ~input ~output ~expander kind - |> Super_context.add_rule sctx ~mode:Standard ~loc ~dir + |> Memo.bind ~f:(Super_context.add_rule sctx ~mode:Standard ~loc ~dir) >>> add_diff sctx loc alias_formatted ~dir ~input:(Path.build input) ~output) |> Memo.Option.iter ~f:Fun.id in diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index c3904fd6fbf..92be6043bb9 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -145,6 +145,16 @@ let get ctx = let get_exn ctx = get ctx >>| User_error.ok_exn +let of_dev_tool dev_tool = + let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool in + Fs_memo.dir_exists (In_source_dir path) + >>= function + | true -> Load.load_exn path + | false -> + User_error.raise + [ Pp.textf "%s does not exist" (Path.Source.to_string_maybe_quoted path) ] +;; + let lock_dir_active ctx = if !Clflags.ignore_lock_dir then Memo.return false diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index d49c7a4c600..2942710067e 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -5,6 +5,7 @@ type t := Dune_pkg.Lock_dir.t val get : Context_name.t -> (t, User_message.t) result Memo.t val get_exn : Context_name.t -> t Memo.t +val of_dev_tool : Dune_pkg.Dev_tool.t -> t Memo.t val lock_dir_active : Context_name.t -> bool Memo.t val get_path : Context_name.t -> Path.Source.t option Memo.t diff --git a/src/dune_rules/pkg_dev_tool.ml b/src/dune_rules/pkg_dev_tool.ml new file mode 100644 index 00000000000..26b1ae8b9a3 --- /dev/null +++ b/src/dune_rules/pkg_dev_tool.ml @@ -0,0 +1,30 @@ +open! Import +include Dune_pkg.Dev_tool + +let install_path_base_dir_name = ".dev-tool" + +let install_path_base = + lazy + (let dev_tool_context_name = Dune_engine.Context_name.default in + Path.Build.L.relative + Private_context.t.build_dir + [ Dune_engine.Context_name.to_string dev_tool_context_name + ; install_path_base_dir_name + ]) +;; + +let universe_install_path t = + Path.Build.relative + (Lazy.force install_path_base) + (Package.Name.to_string @@ package_name t) +;; + +let package_install_path t = + Path.Build.relative (universe_install_path t) (Package.Name.to_string @@ package_name t) +;; + +let exe_path t = + Path.Build.L.relative + (package_install_path t) + ("target" :: exe_path_components_within_package t) +;; diff --git a/src/dune_rules/pkg_dev_tool.mli b/src/dune_rules/pkg_dev_tool.mli new file mode 100644 index 00000000000..fc48474b233 --- /dev/null +++ b/src/dune_rules/pkg_dev_tool.mli @@ -0,0 +1,16 @@ +open! Import +include module type of Dune_pkg.Dev_tool + +val install_path_base_dir_name : string + +(** The path to the package universe inside the _build directory + containing the package dependency closure for the package + containing the given dev tool *) +val universe_install_path : t -> Path.Build.t + +(** The path to the directory inside the _build directory containing + the installation of the package containing the given dev tool *) +val package_install_path : t -> Path.Build.t + +(** The path to the executable for running the given dev tool *) +val exe_path : t -> Path.Build.t diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 2c9c10f2f38..b1b170f4125 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -47,6 +47,44 @@ module Variable = struct ;; end +module Package_universe = struct + (* A type of group of packages that are co-installed. Different + package universes are unaware of each other. For example the + dependencies of the project and the dependencies of one of the dev + tools don't need to be mutually co-installable as they are in + different universes. *) + type t = + | Project_dependencies of Context_name.t + | Dev_tool of Dune_pkg.Dev_tool.t + + let equal a b = + match a, b with + | Project_dependencies a, Project_dependencies b -> Context_name.equal a b + | Dev_tool a, Dev_tool b -> Dune_pkg.Dev_tool.equal a b + | _ -> false + ;; + + let context_name = function + | Project_dependencies context_name -> context_name + | Dev_tool _ -> + (* Dev tools can only be built in the default context. *) + Context_name.default + ;; + + let lock_dir t = + match t with + | Project_dependencies ctx -> Lock_dir.get_exn ctx + | Dev_tool dev_tool -> Lock_dir.of_dev_tool dev_tool + ;; + + let lock_dir_path t = + match t with + | Project_dependencies ctx -> Lock_dir.get_path ctx + | Dev_tool dev_tool -> + Memo.return (Some (Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool)) + ;; +end + module Paths = struct (* The [paths] of a package are the information about the artifacts that we know {e without} executing any commands. *) @@ -99,11 +137,19 @@ module Paths = struct Path.Build.append_local t.extra_sources extra_source ;; - let make name (ctx : Context_name.t) = - let build_dir = - Path.Build.relative Private_context.t.build_dir (Context_name.to_string ctx) + let make package_universe name = + let universe_root = + match (package_universe : Package_universe.t) with + | Dev_tool dev_tool -> Pkg_dev_tool.universe_install_path dev_tool + | Project_dependencies _ -> + let build_dir = + Path.Build.relative + Private_context.t.build_dir + (Context_name.to_string (Package_universe.context_name package_universe)) + in + Path.Build.relative build_dir ".pkg" in - let root = Path.Build.L.relative build_dir [ ".pkg"; Package.Name.to_string name ] in + let root = Path.Build.relative universe_root (Package.Name.to_string name) in of_root name ~root ;; @@ -1132,24 +1178,43 @@ module DB = struct && Package.Name.Set.equal t.system_provided system_provided ;; - let get = + let get package_universe = let dune = Package.Name.Set.singleton (Package.Name.of_string "dune") in - fun context -> - let+ all = Lock_dir.get_exn context in - { all = all.packages; system_provided = dune } + let+ all = Package_universe.lock_dir package_universe in + { all = all.packages; system_provided = dune } ;; end module rec Resolve : sig val resolve : DB.t - -> Context_name.t -> Loc.t * Package.Name.t + -> Package_universe.t -> [ `Inside_lock_dir of Pkg.t | `System_provided ] Memo.t end = struct open Resolve - let resolve_impl ((db : DB.t), ctx, (name : Package.Name.t)) = + module Input = struct + type t = + { db : DB.t + ; package : Package.Name.t + ; universe : Package_universe.t + } + + let equal { db; package; universe } t = + DB.equal db t.db + && Package.Name.equal package t.package + && Package_universe.equal universe t.universe + ;; + + let hash { db; package; universe } = + Poly.hash (Poly.hash db, Package.Name.hash package, Poly.hash universe) + ;; + + let to_dyn = Dyn.opaque + end + + let resolve_impl { Input.db; package = name; universe = package_universe } = match Package.Name.Map.find db.all name with | None -> Memo.return None | Some @@ -1158,19 +1223,21 @@ end = struct assert (Package.Name.equal name info.name); let* depends = Memo.parallel_map depends ~f:(fun name -> - resolve db ctx name + resolve db name package_universe >>| function | `Inside_lock_dir pkg -> Some pkg | `System_provided -> None) >>| List.filter_opt and+ files_dir = - let+ lock_dir = Lock_dir.get_path ctx >>| Option.value_exn in + let+ lock_dir = + Package_universe.lock_dir_path package_universe >>| Option.value_exn + in Path.Build.append_source - (Context_name.build_dir ctx) + (Context_name.build_dir (Package_universe.context_name package_universe)) (Dune_pkg.Lock_dir.Pkg.files_dir info.name ~lock_dir) in let id = Pkg.Id.gen () in - let write_paths = Paths.make name ctx ~relative:Path.Build.relative in + let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in let* paths, build_command, install_command = let paths = Paths.map_path write_paths ~f:Path.build in match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name with @@ -1217,7 +1284,9 @@ end = struct } in let+ exported_env = - let* expander = Action_expander.expander ctx t in + let* expander = + Action_expander.expander (Package_universe.context_name package_universe) t + in Memo.parallel_map exported_env ~f:(Action_expander.exported_env expander) in t.exported_env <- exported_env; @@ -1225,27 +1294,19 @@ end = struct ;; let resolve = - let module Input = struct - type t = DB.t * Context_name.t * Package.Name.t - - let equal = Tuple.T3.equal DB.equal Context_name.equal Package.Name.equal - let hash = Tuple.T3.hash Poly.hash Context_name.hash Package.Name.hash - let to_dyn = Dyn.opaque - end - in let memo = Memo.create "pkg-resolve" ~input:(module Input) - ~human_readable_description:(fun (_db, _ctx, pkg) -> - Pp.textf "- package %s" (Package.Name.to_string pkg)) + ~human_readable_description:(fun t -> + Pp.textf "- package %s" (Package.Name.to_string t.package)) resolve_impl in - fun (db : DB.t) ctx (loc, name) -> + fun (db : DB.t) (loc, name) package_universe -> if Package.Name.Set.mem db.system_provided name then Memo.return `System_provided else - Memo.exec memo (db, ctx, name) + Memo.exec memo { db; package = name; universe = package_universe } >>| function | Some s -> `Inside_lock_dir s | None -> @@ -1816,11 +1877,11 @@ let gen_rules context_name (pkg : Pkg.t) = module Gen_rules = Build_config.Gen_rules -let setup_package_rules context ~dir ~pkg_name : Gen_rules.result Memo.t = +let setup_package_rules ~package_universe ~dir ~pkg_name : Gen_rules.result Memo.t = let name = User_error.ok_exn (Package.Name.of_string_user_error (Loc.none, pkg_name)) in + let* db = DB.get package_universe in let* pkg = - let* db = DB.get context in - Resolve.resolve db context (Loc.none, name) + Resolve.resolve db (Loc.none, name) package_universe >>| function | `Inside_lock_dir pkg -> pkg | `System_provided -> @@ -1831,7 +1892,7 @@ let setup_package_rules context ~dir ~pkg_name : Gen_rules.result Memo.t = (Package.Name.to_string name) ] in - let paths = Paths.make name context ~relative:Path.Build.relative in + let paths = Paths.make package_universe name ~relative:Path.Build.relative in let+ directory_targets = let map = let target_dir = paths.target_dir in @@ -1849,34 +1910,63 @@ let setup_package_rules context ~dir ~pkg_name : Gen_rules.result Memo.t = let build_dir_only_sub_dirs = Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.empty in - let rules = Rules.collect_unit (fun () -> gen_rules context pkg) in + let context_name = Package_universe.context_name package_universe in + let rules = Rules.collect_unit (fun () -> gen_rules context_name pkg) in Gen_rules.make ~directory_targets ~build_dir_only_sub_dirs rules ;; let setup_rules ~components ~dir ctx = - match components with - | [ ".pkg" ] -> + (* Note that the path components in the following patterns must + correspond to the paths returned by [Paths.make]. The string + ".dev-tool" is hardcoded into several patterns, and must match + the value of [Pkg_dev_tool.install_path_base_dir_name]. *) + assert (String.equal Pkg_dev_tool.install_path_base_dir_name ".dev-tool"); + match Context_name.is_default ctx, components with + | true, [ ".dev-tool"; pkg_name; pkg_dep_name ] -> + setup_package_rules + ~package_universe: + (Dev_tool (Package.Name.of_string pkg_name |> Dune_pkg.Dev_tool.of_package_name)) + ~dir + ~pkg_name:pkg_dep_name + | true, [ ".dev-tool" ] -> Gen_rules.make ~build_dir_only_sub_dirs: (Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all) (Memo.return Rules.empty) |> Memo.return - | [ ".pkg"; pkg_name ] -> setup_package_rules ctx ~dir ~pkg_name - | ".pkg" :: _ :: _ -> Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty - | [] -> + | _, [ ".pkg" ] -> + Gen_rules.make + ~build_dir_only_sub_dirs: + (Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all) + (Memo.return Rules.empty) + |> Memo.return + | _, [ ".pkg"; pkg_name ] -> + setup_package_rules ~package_universe:(Project_dependencies ctx) ~dir ~pkg_name + | _, ".pkg" :: _ :: _ -> + Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty + | true, ".dev-tool" :: _ :: _ :: _ -> + Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty + | is_default, [] -> + let sub_dirs = ".pkg" :: (if is_default then [ ".dev-tool" ] else []) in let build_dir_only_sub_dirs = - Gen_rules.Build_only_sub_dirs.singleton ~dir @@ Subdir_set.of_list [ ".pkg" ] + Gen_rules.Build_only_sub_dirs.singleton ~dir @@ Subdir_set.of_list sub_dirs in Memo.return @@ Gen_rules.make ~build_dir_only_sub_dirs (Memo.return Rules.empty) | _ -> Memo.return @@ Gen_rules.rules_here Gen_rules.Rules.empty ;; +let db_project context = DB.get (Project_dependencies context) + +let resolve_pkg_project context pkg = + let* db = db_project context in + Resolve.resolve db pkg (Project_dependencies context) +;; + let ocaml_toolchain context = (let* lock_dir = Lock_dir.get_exn context in - let* db = DB.get context in match lock_dir.ocaml with | None -> Memo.return `System_provided - | Some ocaml -> Resolve.resolve db context ocaml) + | Some ocaml -> resolve_pkg_project context ocaml) >>| function | `System_provided -> None | `Inside_lock_dir pkg -> @@ -1896,11 +1986,11 @@ let ocaml_toolchain context = ;; let all_packages context = - let* db = DB.get context in + let* db = db_project context in Dune_lang.Package_name.Map.values db.all |> Memo.parallel_map ~f:(fun (package : Lock_dir.Pkg.t) -> let package = package.info.name in - Resolve.resolve db context (Loc.none, package) + resolve_pkg_project context (Loc.none, package) >>| function | `Inside_lock_dir pkg -> Some pkg | `System_provided -> None) @@ -1946,8 +2036,7 @@ let find_package ctx pkg = >>= function | false -> Memo.return None | true -> - let* db = DB.get ctx in - Resolve.resolve db ctx (Loc.none, pkg) + resolve_pkg_project ctx (Loc.none, pkg) >>| (function | `System_provided -> Action_builder.return () | `Inside_lock_dir pkg -> diff --git a/src/dune_rules/setup.defaults.ml b/src/dune_rules/setup.defaults.ml index 388850558cf..db49a4e26b0 100644 --- a/src/dune_rules/setup.defaults.ml +++ b/src/dune_rules/setup.defaults.ml @@ -13,3 +13,4 @@ let roots : string option Install.Roots.t = let toolchains = `Disabled let pkg_build_progress = `Disabled +let lock_dev_tool = `Disabled diff --git a/src/dune_rules/setup.mli b/src/dune_rules/setup.mli index 73dfe7fc994..6863d42ca4b 100644 --- a/src/dune_rules/setup.mli +++ b/src/dune_rules/setup.mli @@ -12,3 +12,4 @@ val roots : string option Install.Roots.t val toolchains : Dune_config.Config.Toggle.t val pkg_build_progress : Dune_config.Config.Toggle.t +val lock_dev_tool : Dune_config.Config.Toggle.t diff --git a/test/blackbox-tests/test-cases/pkg/dune b/test/blackbox-tests/test-cases/pkg/dune index d901e655d3d..9cb17adcaad 100644 --- a/test/blackbox-tests/test-cases/pkg/dune +++ b/test/blackbox-tests/test-cases/pkg/dune @@ -43,13 +43,18 @@ unavailable-source-package compute-checksums-when-missing e2e + ocamlformat-dev-tool source-caching tarball extra-sources)) (cram (deps %{bin:md5sum}) - (applies_to source-caching extra-sources)) + (applies_to + source-caching + extra-sources + ocamlformat-dev-tool + dev-tool-conflict-test)) (cram (deps %{bin:tar}) diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/dune b/test/blackbox-tests/test-cases/pkg/ocamlformat/dune new file mode 100644 index 00000000000..552dd6cf4a9 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/dune @@ -0,0 +1,3 @@ +(cram + (deps helpers.sh) + (applies_to :whole_subtree)) diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh new file mode 100644 index 00000000000..be957f2b572 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh @@ -0,0 +1,168 @@ +. ../helpers.sh + +make_fake_ocamlformat() { + version=$1 + if [ "$#" -eq "1" ] + then + ml_file="" + else + ml_file="$2" + fi + mkdir ocamlformat + cat > ocamlformat/dune-project < ocamlformat/ocamlformat.ml < ocamlformat/dune < dune-project < foo.ml < dune < dune-workspace < printer/dune-project < printer/printer.ml < printer/printer.ml < printer/dune < .bin/ocamlformat < dune < (executable + > (public_name foo)) + > (rule + > (target none) + > (action + > (progn + > (run ocamlformat foo.ml) + > (run touch none)))) + > EOF + +Add a fake executable in the PATH + $ make_fake_ocamlformat_from_path + $ which ocamlformat + $TESTCASE_ROOT/.bin/ocamlformat + +Build the OCamlFormat binary dev-tool + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + File "dune", line 1, characters 0-0: + Error: Files _build/default/dune and _build/default/.formatted/dune differ. + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + +When the dev-tool feature is disabled dune runs the OCamlFormat binary from the +PATH and not the dev-tool one. + $ dune build + fake ocamlformat from PATH diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-taking-from-project-deps.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-taking-from-project-deps.t new file mode 100644 index 00000000000..109293b638f --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-taking-from-project-deps.t @@ -0,0 +1,69 @@ +If the dev-tool feature is enabled then "dune fmt" should invoke the "ocamlformat" +executable from the dev-tool and not the one from the project's regular package +dependencies. + +If the dev-tool feature is not enabled then "dune fmt" should invoke the +"ocamlformat" executable from the project's regular package dependencies. + + $ . ./helpers.sh + $ mkrepo + + $ make_fake_ocamlformat "0.26.2" + $ make_fake_ocamlformat "0.26.3" + + $ make_ocamlformat_opam_pkg "0.26.2" + $ make_ocamlformat_opam_pkg "0.26.3" + + +Make a project that depends on the fake ocamlformat.0.26.2: + $ make_project_with_dev_tool_lockdir + +Update dune-project to add the dependency on OCamlFormat. + $ cat > dune-project < (lang dune 3.13) + > (package + > (name foo) + > (depends (ocamlformat (= 0.26.2)))) + > EOF + +Lock and build the project to make OCamlFormat from the project dependencies available. + $ dune pkg lock + Solution for dune.lock: + - ocamlformat.0.26.2 + +Run "dune fmt" without the dev-tools feature enabled. This should invoke the ocamlformat +executable from the package dependencies (ie., 'ocamlformat.0.26.2'). + $ dune fmt --preview + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted with version 0.26.2 + +Format using the dev-tools feature, it does not invoke the OCamlFormat binary from +the project dependencies (0.26.2) but instead builds and runs the OCamlFormat binary as a +dev-tool (0.26.3). + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.3 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + Promoting _build/default/.formatted/foo.ml to foo.ml. + [1] + $ cat foo.ml + formatted with version 0.26.3 + +Retry, without dev-tools feature and without cleaning. This time it uses the OCamlFormat +binary from the project dependencies rather than the dev-tool. This exercises the +behavior when OCamlFormat is installed simultaneously as both a dev-tool and as a +regular package dependency. + $ rm -rf dev-tools.locks/ocamlformat + $ dune fmt --preview + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted with version 0.26.2 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-deps-conflict-project-deps.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-deps-conflict-project-deps.t new file mode 100644 index 00000000000..dbb5ab92dff --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-deps-conflict-project-deps.t @@ -0,0 +1,150 @@ +Testing the conflicts that could occur between the dependencies of "dune-project" +and dev-tool dependencies. + +The scenario here is that the fake OCamlFormat dev-tool depends on +printer.1.0, and the project depends on a different version, printer.2.0. +It shows those two do not conflict, and the dev-tools dependencies do not leak +into the user build environment. + + $ . ./helpers.sh + $ mkrepo + +Make a fake OCamlFormat which depends on printer lib: + $ mkdir ocamlformat + $ cd ocamlformat + $ cat > dune-project < (lang dune 3.13) + > (package (name ocamlformat)) + > EOF + $ cat > ocamlformat.ml < let () = Printer.print () + > EOF + $ cat > dune < (executable + > (public_name ocamlformat) + > (libraries printer)) + > EOF + $ cd .. + $ tar -czf ocamlformat.tar.gz ocamlformat + $ rm -rf ocamlformat + +Make a printer lib(version 1) that prints "formatted": + $ make_printer_lib "1.0" + $ make_opam_printer "1.0" + +Make a printer lib(version 2) that prints "Hello world!": + $ make_printer_lib "2.0" + $ make_opam_printer "2.0" + +Make a package for the fake OCamlFormat library which depends on printer.1.0: + $ mkpkg ocamlformat 0.26.2 < depends: [ + > "printer" {= "1.0"} + > ] + > build: [ + > [ + > "dune" + > "build" + > "-p" + > name + > "@install" + > ] + > ] + > url { + > src: "file://$PWD/ocamlformat.tar.gz" + > checksum: [ + > "md5=$(md5sum ocamlformat.tar.gz | cut -f1 -d' ')" + > ] + > } + > EOF + +Make dune-project that uses the mocked dev-tool opam-reposiotry. + $ make_project_with_dev_tool_lockdir + +Update the project to depends on printer.2.0: + $ cat > dune-project < (lang dune 3.13) + > (package + > (name foo) + > (depends (printer (= 2.0)))) + > EOF + $ cat > foo.ml < let () = Printer.print () + > EOF + $ cat > dune < (executable + > (public_name foo) + > (libraries printer)) + > EOF + +Add ".ocamlformat" file. + $ cat > .ocamlformat < version = 0.26.2 + > EOF + +Lock the to trigger package management + $ dune pkg lock + Solution for dune.lock: + - printer.2.0 + +It shows that the project uses printer.2.0 + $ dune exec -- foo + Hello World! + +Format foo.ml, "dune fmt" uses printer.1.0 instead. There is no conflict with different +versions of the same dependency. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + - printer.1.0 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted + +Update "dune-project", removing the dependency on the "printer" package. This +demonstrates that even though OCamlFormat depends on the "printer" package, building the +project will not work because foo's dependency on the library "printer" (specified in +the "dune" file) cannot be resolved. This is because dependencies of dev-tools and +dependencies of the project are isolated from one another. + $ cat > dune-project < (lang dune 3.13) + > (package + > (name foo)) + > EOF + +Relock the project. + $ dune pkg lock + Solution for dune.lock: + (no dependencies to lock) + +There is no leak here. It is not taking the "printer" lib from dev-tools. + $ dune exec -- foo + File "dune", line 3, characters 12-19: + 3 | (libraries printer)) + ^^^^^^^ + Error: Library "printer" not found. + -> required by _build/default/.foo.eobjs/byte/dune__exe__Foo.cmi + -> required by _build/default/.foo.eobjs/native/dune__exe__Foo.cmx + -> required by _build/default/foo.exe + -> required by _build/install/default/bin/foo + [1] + +Update the executable "foo" to not depend on the library "printer", but "foo.ml" still +refers to the "Printer" module. This won't compile, demonstrating that modules from +dev-tools don't leak into the project. + $ cat > dune < (executable + > (public_name foo)) + > EOF + +There is no leak here. It is not taking Printer module from the printer of dev-tools dependency. + $ dune exec -- foo + File "foo.ml", line 1, characters 9-22: + 1 | let () = Printer.print () + ^^^^^^^^^^^^^ + Error: Unbound module Printer + Hint: Did you mean Printexc or Printf? + [1] diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t new file mode 100644 index 00000000000..33043a8666f --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-dev-tool-fails-to-build.t @@ -0,0 +1,27 @@ +With a faulty version of OCamlFormat, "dune fmt" is supposed to stop with the +build error of "ocamlformat". + + $ . ./helpers.sh + $ mkrepo + +Make a fake ocamlformat with a missing ocamlformat.ml file: + $ make_fake_ocamlformat "0.26.4" "no-ml-file" + $ make_ocamlformat_opam_pkg "0.26.4" + +Make dune-project that uses the mocked dev-tool opam-reposiotry. + $ make_project_with_dev_tool_lockdir + +It fails during the build because of missing OCamlFormat module. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.4 + File "dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10: + 4 | (run dune build -p %{pkg-self:name} @install)) + ^^^^ + Error: Logs for package ocamlformat + File "dune", line 2, characters 14-25: + 2 | (public_name ocamlformat)) + ^^^^^^^^^^^ + Error: Module "Ocamlformat" doesn't exist. + + [1] diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t new file mode 100644 index 00000000000..c5e64a995ec --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t @@ -0,0 +1,75 @@ +Exercises end to end, locking and building ocamlformat dev tool. + + $ . ./helpers.sh + $ mkrepo + + $ make_fake_ocamlformat "0.26.2" + $ make_fake_ocamlformat "0.26.3" + +Add the tar file for the fake curl to copy it: + $ echo ocamlformat-0.26.2.tar.gz > fake-curls + $ PORT=1 + + $ make_ocamlformat_opam_pkg "0.26.2" $PORT + +Add the tar file for the fake curl to copy it: + $ echo ocamlformat-0.26.3.tar.gz >> fake-curls + $ PORT=2 + +We consider this version of OCamlFormat as the latest version: + $ make_ocamlformat_opam_pkg "0.26.3" $PORT + +Make dune-project that uses the mocked dev-tool opam-reposiotry. + $ make_project_with_dev_tool_lockdir + +Without a ".ocamlformat" file, "dune fmt" takes the latest version of +OCamlFormat. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.3 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted with version 0.26.3 + +Create .ocamlformat file + $ cat > .ocamlformat < version = 0.26.2 + > EOF + +An important cleaning here, "dune fmt" will relock and build the new version(0.26.2) of OCamlFormat. + $ rm -r dev-tools.locks/ocamlformat + $ dune clean + +With a ".ocamlformat" file, "dune fmt" takes the version mentioned inside ".ocamlformat" +file. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted with version 0.26.2 + +Formating a second time would not trigger the lock/solve. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + formatted with version 0.26.2 + +When "dev-tools.locks" is removed, the solving/lock is renewed + $ rm -r dev-tools.locks/ocamlformat + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t new file mode 100644 index 00000000000..dcf827f1dca --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t @@ -0,0 +1,58 @@ +Make sure the format rules depends on ".ocamlformat-ignore" file when it exists. + + $ . ./helpers.sh + $ mkrepo + + $ make_fake_ocamlformat "0.26.2" + $ make_ocamlformat_opam_pkg "0.26.2" + +Make a project that uses the fake ocamlformat: + $ make_project_with_dev_tool_lockdir + +Add a fake binary in the PATH + $ make_fake_ocamlformat_from_path + $ which ocamlformat + $TESTCASE_ROOT/.bin/ocamlformat + +Check without ".ocamlformat-ignore" file and the feature. + $ dune fmt --preview + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ cat _build/default/.formatted/foo.ml + fake ocamlformat from PATH + +Create ".ocamlformat-ignore" + $ touch .ocamlformat-ignore + +Check with the feature when ".ocamlformat-ignore" file exists. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview + Solution for dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + [1] + $ ls _build/default/.ocamlformat-ignore + _build/default/.ocamlformat-ignore + $ cat _build/default/.formatted/foo.ml + ignoring some files + formatted with version 0.26.2 + +An important cleaning here, "dune fmt" takes the dev-tool when the lock directory +exists even if the dev-tool feature is disabled. + $ rm -r dev-tools.locks/ocamlformat + +Check without the feature when ".ocamlformat-ignore" file exists. + $ DUNE_CONFIG__LOCK_DEV_TOOL=disabled dune fmt + File "foo.ml", line 1, characters 0-0: + Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml + differ. + Promoting _build/default/.formatted/foo.ml to foo.ml. + [1] + $ ls _build/default/.ocamlformat-ignore + _build/default/.ocamlformat-ignore + $ cat foo.ml + ignoring some files + fake ocamlformat from PATH diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t new file mode 100644 index 00000000000..f9ecbc9dacf --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t @@ -0,0 +1,23 @@ +When an OCamlFormat version does not exist, "dune fmt" would fail with a +solving error. + + $ . ./helpers.sh + $ mkrepo + +Make a project with no dependency on OCamlFormat. + $ make_project_with_dev_tool_lockdir + +Update ".ocamlformat" file with unknown version of OCamlFormat. + $ cat > .ocamlformat < version = 0.26.9 + > EOF + +Format, it shows the solving error. + $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt + Error: Unable to solve dependencies for the following lock directories: + Lock directory dev-tools.locks/ocamlformat: + Can't find all required versions. + Selected: ocamlformat_dev_tool_wrapper.dev + - ocamlformat -> (problem) + No known implementations at all + [1]