From b3a5fa4d4db0a69777f4ed78c8098cb55220bd62 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 4 Nov 2025 15:54:14 +0100 Subject: [PATCH 01/14] Move dev-tool lock dirs from source into into build folder Signed-off-by: Marek Kubica --- src/dune_pkg/lock_dir.ml | 15 ++++- src/dune_rules/format_rules.ml | 5 +- src/dune_rules/lock_dir.ml | 4 +- src/dune_rules/lock_rules.ml | 58 +++++++++++++++++-- src/dune_rules/pkg_rules.ml | 30 ++++------ .../test-cases/pkg/ocamlformat/gh10991.t | 2 +- .../test-cases/pkg/ocamlformat/gh11037.t | 2 +- .../test-cases/pkg/ocamlformat/helpers.sh | 4 +- .../ocamlformat-avoid-conflict-with-project.t | 2 +- ...amlformat-avoid-taking-from-project-deps.t | 4 +- ...rmat-dev-tool-deps-conflict-project-deps.t | 2 +- .../ocamlformat-dev-tool-fails-to-build.t | 4 +- .../pkg/ocamlformat/ocamlformat-e2e.t | 13 +++-- .../pkg/ocamlformat/ocamlformat-ignore.t | 4 +- .../pkg/ocamlformat/ocamlformat-install.t | 2 +- .../ocamlformat-patch-extra-files.t | 6 +- .../ocamlformat-relaxed-version-constraints.t | 10 ++-- .../ocamlformat-relock-on-corrupt-lockdir.t | 6 +- .../ocamlformat/ocamlformat-solving-fails.t | 2 +- .../ocamlformat/ocamlformat-version-change.t | 4 +- .../pkg/ocamlformat/ocamlformat-which.t | 2 +- .../pkg/ocamlformat/ocamlformat-wrapper.t | 2 +- .../pkg/ocamllsp/dev-tool-ocamllsp-basic.t | 2 +- .../ocamllsp/dev-tool-ocamllsp-env-path-var.t | 2 +- ...-ocamllsp-relock-on-ocaml-version-change.t | 8 +-- .../test-cases/pkg/ocamllsp/helpers.sh | 4 +- .../test-cases/pkg/odoc/dev-tool-odoc-basic.t | 2 +- ...tool-odoc-relock-on-ocaml-version-change.t | 6 +- .../test-cases/pkg/odoc/helpers.sh | 4 +- 29 files changed, 136 insertions(+), 75 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 8f95eae40bd..4f85a619d89 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1789,9 +1789,18 @@ let loc_in_source_tree loc = loc |> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) -> let path = Path.of_string pos_fname in - let new_path = in_source_tree path in - let pos_fname = Path.Source.to_string new_path in - { pos with pos_fname }) + match Path.of_string pos_fname with + | External _ | In_source_tree _ -> pos + | In_build_dir b -> + (match Path.Build.explode b with + | ".dev-tools.locks" :: _ -> + (* we're excluding the hidden dev-tools.locks folders in the build folder + from rewriting *) + pos + | _otherwise -> + let new_path = in_source_tree path in + let pos_fname = Path.Source.to_string new_path in + { pos with pos_fname })) ;; let check_if_solved_for_platform { solved_for_platforms; _ } ~platform = diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 1ddd5a14878..f0f6ca091f0 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -33,8 +33,7 @@ end module Ocamlformat = struct let dev_tool_lock_dir_exists () = - let path = Lock_dir.dev_tool_source_lock_dir Ocamlformat in - Source_tree.find_dir path >>| Option.is_some + Lock_dir.dev_tool_source_lock_dir Ocamlformat |> Path.source |> Path.Untracked.exists ;; (* Config files for ocamlformat. When these are changed, running @@ -129,7 +128,7 @@ let gen_rules_output let loc = Format_config.loc config in let dir = Path.Build.parent_exn output_dir in let alias_formatted = Alias.fmt ~dir:output_dir in - let* ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in + let ocamlformat_is_locked = Ocamlformat.dev_tool_lock_dir_exists () in let setup_formatting file = (let input_basename = Path.Source.basename file in let input = Path.Build.relative dir input_basename in diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index c3343249a1d..c61925efd38 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -148,7 +148,9 @@ let dev_tool_to_path_segment dev_tool = ;; let dev_tool_source_lock_dir dev_tool = - let dev_tools_path = Path.Source.(relative root "dev-tools.locks") in + let dev_tools_path = + Path.Source.L.relative Path.Source.root [ "_build"; ".dev-tools.locks" ] + in let dev_tool_segment = dev_tool_to_path_segment dev_tool in Path.Source.append_local dev_tools_path dev_tool_segment ;; diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index 818a7e118be..f65935a5c76 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -425,12 +425,60 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files = ~dirs:(Path.Build.Set.singleton target)) ;; -let setup_copy_rules ~dir:target ~lock_dir = - let+ deps, files = Source_deps.files (Path.source lock_dir) in +let files dir = + let rec recurse dir = + match Path.Untracked.readdir_unsorted_with_kinds dir with + | Ok entries -> + entries + |> List.fold_left + ~init:(Path.Set.empty, Path.Set.empty) + ~f:(fun (files, empty_directories) (entry, kind) -> + let path = Path.relative dir entry in + match (kind : Unix.file_kind) with + | S_REG -> + let files = Path.Set.add files path in + files, empty_directories + | S_DIR -> + let files', empty_directories' = recurse path in + (match Path.Set.is_empty files', Path.Set.is_empty empty_directories' with + | true, true -> + let empty_directories = Path.Set.add empty_directories path in + files, empty_directories + | _, _ -> + let files = Path.Set.union files files' in + let empty_directories = + Path.Set.union empty_directories empty_directories' + in + files, empty_directories) + | otherwise -> + Code_error.raise + "unsupported kind of file in folder" + [ "path", Path.to_dyn path; "kind", File_kind.to_dyn otherwise ]) + | Error (ENOENT, _, _) -> Path.Set.empty, Path.Set.empty + | Error unix_error -> + User_error.raise + [ Pp.textf + "Failed to read lock dir files of %s:" + (Path.to_string_maybe_quoted dir) + ; Pp.text (Unix_error.Detailed.to_string_hum unix_error) + ] + in + let files, empty_directories = recurse dir in + Dep.Set.of_source_files ~files ~empty_directories, files +;; + +let setup_copy_rules ~dir:target ~assume_src_exists ~lock_dir = + let+ () = Memo.return () in + let deps, files = files (Path.source lock_dir) in let directory_targets, rules = match Path.Set.is_empty files with | true -> Path.Build.Map.empty, Rules.empty | false -> + let deps = + match assume_src_exists with + | false -> deps + | true -> Dep.Set.empty + in let directory_targets = Path.Build.Map.singleton target Loc.none in let { Action_builder.With_targets.build; targets } = copy_lock_dir ~target ~lock_dir ~deps ~files @@ -452,7 +500,7 @@ let setup_lock_rules_with_source (workspace : Workspace.t) ~dir ~lock_dir = match source with | `Source_tree lock_dir -> let dir = Path.Build.append_source dir lock_dir in - setup_copy_rules ~dir ~lock_dir + setup_copy_rules ~assume_src_exists:false ~dir ~lock_dir | `Generated -> Memo.return (setup_lock_rules ~dir ~lock_dir) ;; @@ -461,7 +509,9 @@ let setup_dev_tool_lock_rules ~dir dev_tool = let dev_tool_name = Dune_lang.Package_name.to_string package_name in let dir = Path.Build.relative dir dev_tool_name in let lock_dir = Lock_dir.dev_tool_source_lock_dir dev_tool in - setup_copy_rules ~dir ~lock_dir + (* dev tool lock files are created in _build outside of the build system + so we have to tell the build system not to try to create them *) + setup_copy_rules ~dir ~assume_src_exists:true ~lock_dir ;; let setup_rules ~components ~dir = diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index f803f939f41..1f5de67c9f7 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -1494,10 +1494,10 @@ end = struct in resolve db dep_loc dep_pkg_digest package_universe) and+ files_dir = - let* lock_dir = + let+ lock_dir = Package_universe.lock_dir_path package_universe >>| Option.value_exn in - let+ files_dir = + let files_dir = let module Pkg = Dune_pkg.Lock_dir.Pkg in (* TODO(steve): simplify this once portable lockdirs become the default. This logic currently handles both the cases where @@ -1509,17 +1509,15 @@ end = struct let path_with_version = Pkg.source_files_dir info.name (Some info.version) ~lock_dir in - let* path_with_version_exists = - Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir path_with_version) + let path_with_version_exists = + Path.Untracked.exists (Path.source path_with_version) in match path_with_version_exists with - | true -> - Memo.return @@ Some (Pkg.files_dir info.name (Some info.version) ~lock_dir) + | true -> Some (Pkg.files_dir info.name (Some info.version) ~lock_dir) | false -> let path_without_version = Pkg.source_files_dir info.name None ~lock_dir in - let+ path_without_version_exists = - Fs_memo.dir_exists - (Path.Outside_build_dir.In_source_dir path_without_version) + let path_without_version_exists = + Path.Untracked.exists (Path.source path_without_version) in (match path_without_version_exists with | true -> Some (Pkg.files_dir info.name None ~lock_dir) @@ -1533,18 +1531,14 @@ end = struct "Package files directory is external source directory, this is unsupported" [ "dir", Path.External.to_dyn e ] | In_source_tree s -> - (match Path.Source.explode s with - | [ "dev-tools.locks"; dev_tool; files_dir ] -> + Code_error.raise "Unexpected files_dir path" [ "dir", Path.Source.to_dyn s ] + | In_build_dir b -> + (match Path.Build.explode b with + | [ ".dev-tools.locks"; dev_tool; files_dir ] -> Path.Build.L.relative Private_context.t.build_dir [ "default"; ".dev-tool-locks"; dev_tool; files_dir ] - | otherwise -> - Code_error.raise - "Unexpected files_dir path" - [ "components", (Dyn.list Dyn.string) otherwise ]) - | In_build_dir b -> - (* it's already a build path, no need to do anything *) - b) + | _otherwise -> b)) in let id = Pkg.Id.gen () in let write_paths = diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/gh10991.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/gh10991.t index 8c125460e05..176a4206ce3 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/gh10991.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/gh10991.t @@ -19,7 +19,7 @@ Initial file: let () = print_endline "Hello, world" $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.0.1 File "foo.ml", line 1, characters 0-0: Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/gh11037.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/gh11037.t index d34be7caa6f..77c243bc7ec 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/gh11037.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/gh11037.t @@ -40,7 +40,7 @@ attempt to build the package "foo". $ cat foo.ml let () = print_endline "Hello, world" $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.0.1 File "foo.ml", line 1, characters 0-0: Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh index 9da80a7fe99..b466a7d8f5e 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh @@ -1,5 +1,7 @@ . ../helpers.sh +dev_tool_lock_dir="_build/.dev-tools.locks/ocamlformat" + make_fake_ocamlformat() { version=$1 if [ "$#" -eq "1" ] @@ -97,7 +99,7 @@ EOF (lang dune 3.20) (lock_dir - (path "dev-tools.locks/ocamlformat") + (path "${dev_tool_lock_dir}") (repositories mock)) (lock_dir diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-conflict-with-project.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-conflict-with-project.t index 4dc4d326f60..cebddd16a0b 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-conflict-with-project.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-avoid-conflict-with-project.t @@ -29,7 +29,7 @@ Add a fake executable in the PATH Build the OCamlFormat binary dev-tool $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.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. 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 index ab9b5210bab..371c85d6124 100644 --- 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 @@ -45,7 +45,7 @@ Format using the dev-tools feature, it does not invoke the OCamlFormat binary fr 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: + Solution for _build/.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 @@ -59,7 +59,7 @@ Retry, without dev-tools feature and without cleaning. This time it uses the OCa 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 + $ rm -r "${dev_tool_lock_dir}" $ dune fmt --preview File "foo.ml", line 1, characters 0-0: Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml 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 index 9415d29afd8..46f20527d8d 100644 --- 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 @@ -94,7 +94,7 @@ It shows that the project uses printer.2.0 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: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.2 - printer.1.0 File "foo.ml", line 1, characters 0-0: 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 index 33043a8666f..10febef5b4c 100644 --- 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 @@ -13,9 +13,9 @@ Make dune-project that uses the mocked dev-tool opam-reposiotry. It fails during the build because of missing OCamlFormat module. $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.4 - File "dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10: + File "_build/.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 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t index 5d75ae6e522..eacb0979b03 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-e2e.t @@ -25,7 +25,7 @@ Make dune-project that uses the mocked dev-tool opam-reposiotry. 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: + Solution for _build/.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 @@ -40,13 +40,13 @@ Create .ocamlformat file > 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 + $ rm -r "${dev_tool_lock_dir}" $ 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: + Solution for _build/.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 @@ -64,10 +64,11 @@ Formating a second time would not trigger the lock/solve. $ 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 +When the lock dir is removed, the solving/lock is renewed: + + $ rm -r "${dev_tool_lock_dir}" $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt --preview - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.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 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t index dcf827f1dca..8c5638fe0ca 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-ignore.t @@ -28,7 +28,7 @@ Create ".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: + Solution for _build/.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 @@ -42,7 +42,7 @@ Check with the feature when ".ocamlformat-ignore" file exists. 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 + $ rm -r "${dev_tool_lock_dir}" Check without the feature when ".ocamlformat-ignore" file exists. $ DUNE_CONFIG__LOCK_DEV_TOOL=disabled dune fmt diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-install.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-install.t index dbaf1364137..f8ad81b9631 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-install.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-install.t @@ -8,7 +8,7 @@ Test `dune tools which ocamlformat`: Install ocamlformat as a dev tool: $ dune tools install ocamlformat - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.2 Verify that ocamlformat is installed: diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-patch-extra-files.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-patch-extra-files.t index d909909fd35..0f31868f428 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-patch-extra-files.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-patch-extra-files.t @@ -1,7 +1,7 @@ -'dune fmt' produce lock files inside "dev-tools.locks/ocamlformat" before it starts building +'dune fmt' produces lock files inside the dev tool lock directory before it starts building ocamlformat and its dependencies during the same run of the "dune fmt" command. The source tree is loaded before the lock files are produced, this is why any 'patch' file inside -'dev-tools.locks/ocmalformat' is not copied inside the 'build' directory when a rule depends on it. +the dev tool lock dir is not copied inside the 'build' directory when a rule depends on it. The issue was that there is a rule that depends on an 'patch' file in order to copy the file inside '_private/default/..' directory, since the file could not be copied, the rule is not activated. @@ -61,7 +61,7 @@ Make a project that uses the fake ocamlformat: First run of 'dune fmt' is supposed to format the fail. $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.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 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relaxed-version-constraints.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relaxed-version-constraints.t index 15d9700091c..0ff5e495d48 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relaxed-version-constraints.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relaxed-version-constraints.t @@ -28,7 +28,7 @@ Initial file: This should choose the 0.24+foo version: $ echo "version=0.24" > .ocamlformat $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.24+foo File "foo.ml", line 1, characters 0-0: Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml @@ -41,9 +41,9 @@ This should choose the 0.24+foo version: This should choose the 0.24+bar version: $ echo "version=0.25" > .ocamlformat - $ rm -rf dev-tools.locks + $ rm -r "${dev_tool_lock_dir}" $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.25+bar File "foo.ml", line 1, characters 0-0: Error: Files _build/default/foo.ml and _build/default/.formatted/foo.ml @@ -57,10 +57,10 @@ This should choose the 0.24+bar version: This should fail as there is no version matching 0.24.1: $ echo "version=0.24.1" > .ocamlformat - $ rm -rf dev-tools.locks + $ rm -r "${dev_tool_lock_dir}" $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt Error: Unable to solve dependencies for the following lock directories: - Lock directory dev-tools.locks/ocamlformat: + Lock directory _build/.dev-tools.locks/ocamlformat: Couldn't solve the package dependency formula. Selected candidates: ocamlformat_dev_tool_wrapper.dev - ocamlformat -> (problem) diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relock-on-corrupt-lockdir.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relock-on-corrupt-lockdir.t index 8e55fb00e4c..61f71d1bf2b 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relock-on-corrupt-lockdir.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-relock-on-corrupt-lockdir.t @@ -12,11 +12,11 @@ Make a fake ocamlformat package Install ocamlformat once to generate the lockdir. $ dune tools install ocamlformat - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.0 Delete ocamlformat's lockfile. - $ rm dev-tools.locks/ocamlformat/ocamlformat.pkg + $ rm "${dev_tool_lock_dir}"/ocamlformat.pkg Reinstall ocamlformat. $ dune tools install ocamlformat @@ -24,5 +24,5 @@ Reinstall ocamlformat. contain a lockfile for the package "ocamlformat". This may indicate that the lock directory has been tampered with. Please avoid making manual changes to tool lock directories. The tool will now be relocked. - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.0 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 index 6fc6a2449d5..60e58691ef2 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-solving-fails.t @@ -15,7 +15,7 @@ Update ".ocamlformat" file with unknown version of OCamlFormat. 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: + Lock directory _build/.dev-tools.locks/ocamlformat: Couldn't solve the package dependency formula. The following packages couldn't be found: ocamlformat [1] diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-version-change.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-version-change.t index f8a38e7a61e..9d5bf404073 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-version-change.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-version-change.t @@ -22,7 +22,7 @@ Create .ocamlformat file Install ocamlformat. 0.26.0 should be installed because that's the version in .ocamlformat. $ dune tools install ocamlformat - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.0 Change the version in .ocamlformat. @@ -35,5 +35,5 @@ Install ocamlformat again. Dune should detect that the version has changed and r The lock directory for the tool "ocamlformat" exists but contains a solution for 0.26.0 of the tool, whereas version 0.27.0 now needs to be installed. The tool will now be re-locked. - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.27.0 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-which.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-which.t index e2b704ef4a3..d9d8bbb49f2 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-which.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-which.t @@ -21,7 +21,7 @@ The command will fail because the dev tool is not installed: Install the dev tool: $ dune tools exec ocamlformat - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.2 Running 'ocamlformat' formatted with version 0.26.2 diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-wrapper.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-wrapper.t index 2302e2d1f93..cd43c90e1dd 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-wrapper.t +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-wrapper.t @@ -8,7 +8,7 @@ Exercise running the ocamlformat wrapper command. $ make_project_with_dev_tool_lockdir $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune tools exec ocamlformat - Solution for dev-tools.locks/ocamlformat: + Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.2 Running 'ocamlformat' formatted with version 0.26.2 diff --git a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-basic.t b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-basic.t index 825b827d051..8746d7e4ab5 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-basic.t +++ b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-basic.t @@ -25,7 +25,7 @@ a lockdir containing an "ocaml" lockfile. > EOF $ dune tools exec ocamllsp - Solution for dev-tools.locks/ocaml-lsp-server: + Solution for _build/.dev-tools.locks/ocaml-lsp-server: - ocaml.5.2.0 - ocaml-lsp-server.0.0.1 Running 'ocamllsp' diff --git a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-env-path-var.t b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-env-path-var.t index cd647d07d6f..e4f484c47f0 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-env-path-var.t +++ b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-env-path-var.t @@ -24,7 +24,7 @@ Make a fake ocamllsp package that prints out the PATH variable: Confirm that each dev tool's bin directory is now in PATH: $ dune tools exec ocamllsp | tr : '\n' | grep '_build/_private/default/.dev-tool' - Solution for dev-tools.locks/ocaml-lsp-server: + Solution for _build/.dev-tools.locks/ocaml-lsp-server: - ocaml.5.2.0 - ocaml-lsp-server.0.0.1 Running 'ocamllsp' diff --git a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-relock-on-ocaml-version-change.t b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-relock-on-ocaml-version-change.t index f1328778b3a..ac5bef6401d 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-relock-on-ocaml-version-change.t +++ b/test/blackbox-tests/test-cases/pkg/ocamllsp/dev-tool-ocamllsp-relock-on-ocaml-version-change.t @@ -29,12 +29,12 @@ same version of the ocaml compiler as the code that it's analyzing. Initially ocamllsp will be depend on ocaml.5.2.0 to match the project. $ dune tools exec ocamllsp - Solution for dev-tools.locks/ocaml-lsp-server: + Solution for _build/.dev-tools.locks/ocaml-lsp-server: - ocaml.5.2.0 - ocaml-lsp-server.0.0.1 Running 'ocamllsp' hello from fake ocamllsp - $ cat dev-tools.locks/ocaml-lsp-server/ocaml.pkg + $ cat "${dev_tool_lock_dir}"/ocaml.pkg (version 5.2.0) We can re-run "dune tools exec ocamllsp" without relocking or rebuilding. @@ -54,10 +54,10 @@ before running. Ocamllsp now depends on ocaml.5.1.0. changed to 5.1.0 (formerly the compiler version was 5.2.0). The dev-tool "ocaml-lsp-server" will be re-locked and rebuilt with this version of the compiler. - Solution for dev-tools.locks/ocaml-lsp-server: + Solution for _build/.dev-tools.locks/ocaml-lsp-server: - ocaml.5.1.0 - ocaml-lsp-server.0.0.1 Running 'ocamllsp' hello from fake ocamllsp - $ cat dev-tools.locks/ocaml-lsp-server/ocaml.pkg + $ cat "${dev_tool_lock_dir}"/ocaml.pkg (version 5.1.0) diff --git a/test/blackbox-tests/test-cases/pkg/ocamllsp/helpers.sh b/test/blackbox-tests/test-cases/pkg/ocamllsp/helpers.sh index 74c372c7ad6..135f2602285 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamllsp/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/ocamllsp/helpers.sh @@ -1,10 +1,12 @@ +dev_tool_lock_dir="_build/.dev-tools.locks/ocaml-lsp-server" + # Create a dune-workspace file with mock repos set up for the main # project and the ocamllsp lockdir. setup_ocamllsp_workspace() { cat > dune-workspace < EOF $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc - Solution for dev-tools.locks/odoc: + Solution for _build/.dev-tools.locks/odoc: - ocaml.5.2.0 - odoc.0.0.1 hello from fake odoc diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t index 2d905271be5..43b48415de2 100644 --- a/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t +++ b/test/blackbox-tests/test-cases/pkg/odoc/dev-tool-odoc-relock-on-ocaml-version-change.t @@ -29,7 +29,7 @@ same version of the ocaml compiler as the code that it's analyzing. Initially odoc will be depend on ocaml.5.2.0 to match the project. $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune ocaml doc - Solution for dev-tools.locks/odoc: + Solution for _build/.dev-tools.locks/odoc: - ocaml.5.2.0 - odoc.0.0.1 hello from fake odoc @@ -40,7 +40,7 @@ Initially odoc will be depend on ocaml.5.2.0 to match the project. Error: Rule failed to generate the following targets: - _doc/_odoc/pkg/foo/page-index.odoc [1] - $ cat dev-tools.locks/odoc/ocaml.pkg + $ cat "${dev_tool_lock_dir}"/ocaml.pkg (version 5.2.0) We can re-run "dune ocaml doc" without relocking or rebuilding. @@ -65,7 +65,7 @@ before running. Odoc now depends on ocaml.5.1.0. The version of the compiler package ("ocaml") in this project's lockdir has changed to 5.1.0 (formerly the compiler version was 5.2.0). The dev-tool "odoc" will be re-locked and rebuilt with this version of the compiler. - Solution for dev-tools.locks/odoc: + Solution for _build/.dev-tools.locks/odoc: - ocaml.5.1.0 - odoc.0.0.1 hello from fake odoc diff --git a/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh b/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh index 999a0c947ef..959add5b364 100644 --- a/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/odoc/helpers.sh @@ -1,3 +1,5 @@ +dev_tool_lock_dir="_build/.dev-tools.locks/odoc" + # Create a dune-workspace file with mock repos set up for the main # project and the odoc lockdir. setup_odoc_workspace() { @@ -5,7 +7,7 @@ setup_odoc_workspace() { (lang dune 3.20) (pkg enabled) (lock_dir - (path "dev-tools.locks/odoc") + (path "${dev_tool_lock_dir}") (repositories mock)) (lock_dir (repositories mock)) From e688f7604e4d81646c91455c51b00387f7570fd0 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Mon, 10 Nov 2025 14:43:56 +0100 Subject: [PATCH 02/14] Use `Path` type Signed-off-by: Marek Kubica --- bin/lock_dev_tool.ml | 9 +++------ bin/ocaml/utop.ml | 4 ++-- src/dune_pkg/lock_dir.ml | 20 +++++++++++++++----- src/dune_rules/fetch_rules.ml | 4 ++-- src/dune_rules/format_rules.ml | 2 +- src/dune_rules/lock_dir.ml | 22 ++++++++++++---------- src/dune_rules/lock_dir.mli | 2 +- src/dune_rules/lock_rules.ml | 15 +++++++-------- src/dune_rules/merlin/ocaml_index.ml | 2 +- src/dune_rules/pkg_rules.ml | 6 +----- src/dune_rules/utop.ml | 12 ++++++------ src/dune_rules/utop.mli | 2 +- src/source/workspace.ml | 9 ++++++++- 13 files changed, 60 insertions(+), 49 deletions(-) diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index fc8683b21c3..ea417a960e7 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -80,7 +80,7 @@ let solve ~dev_tool ~local_packages = | `Disabled -> workspace in (* as we want to write to the source, we're using the source lock dir here *) - let lock_dir = Dune_rules.Lock_dir.dev_tool_source_lock_dir dev_tool |> Path.source in + let lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in Memo.of_reproducible_fiber @@ Pkg.Lock.solve workspace @@ -174,14 +174,11 @@ let extra_dependencies dev_tool = let lockdir_status dev_tool = let open Memo.O in - let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_source_lock_dir dev_tool in - let* lock_dir_exists = - Dune_engine.Fs_memo.dir_exists (In_source_dir dev_tool_lock_dir) - in + let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in + let lock_dir_exists = Path.exists dev_tool_lock_dir in match lock_dir_exists with | false -> Memo.return `No_lockdir | true -> - let dev_tool_lock_dir = Path.source dev_tool_lock_dir in (match Lock_dir.read_disk dev_tool_lock_dir with | Error _ -> Memo.return `No_lockdir | Ok { packages; _ } -> diff --git a/bin/ocaml/utop.ml b/bin/ocaml/utop.ml index 0d0e18c76f3..9c449e9da29 100644 --- a/bin/ocaml/utop.ml +++ b/bin/ocaml/utop.ml @@ -61,8 +61,8 @@ let term = [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ] | true -> let* () = Build_system.build_file utop_exe in - let* utop_dev_tool_lock_dir_exists = - Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists + let utop_dev_tool_lock_dir_exists = + Lazy.force Utop.utop_dev_tool_lock_dir_exists in let* () = if utop_dev_tool_lock_dir_exists diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 4f85a619d89..13c374afc32 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -524,10 +524,20 @@ let in_source_tree path = (match Path.Source.explode in_source with | "default" :: ".lock" :: components -> Path.Source.L.relative Path.Source.root components - | _otherwise -> - Code_error.raise - "Unexpected location of lock directory in build directory" - [ "path", Path.Build.to_dyn b; "in_source", Path.Source.to_dyn in_source ]) + | source_components -> + (match Path.Build.explode b with + | ".dev-tools.locks" :: dev_tool :: components -> + Path.Source.L.relative + Path.Source.root + ([ "_build"; ".dev-tools.locks"; dev_tool ] @ components) + | build_components -> + Code_error.raise + "Unexpected location of lock directory in build directory" + [ "path", Path.Build.to_dyn b + ; "in_source", Path.Source.to_dyn in_source + ; "source_components", Dyn.(list string) source_components + ; "build_components", Dyn.(list string) build_components + ])) | External e -> Code_error.raise "External path returned when loading a lock dir" @@ -1789,7 +1799,7 @@ let loc_in_source_tree loc = loc |> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) -> let path = Path.of_string pos_fname in - match Path.of_string pos_fname with + match path with | External _ | In_source_tree _ -> pos | In_build_dir b -> (match Path.Build.explode b with diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index f4f5206d9d8..9dd78fedf58 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -189,11 +189,11 @@ let find_checksum, find_url = Dune_pkg.Dev_tool.all ~init:(Checksum.Map.empty, Digest.Map.empty) ~f:(fun acc dev_tool -> - let dir = Lock_dir.dev_tool_source_lock_dir dev_tool in + let dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in let exists = (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's lockdir may be generated part way through a build. *) - Path.Untracked.exists (Path.source dir) + Path.Untracked.exists dir in match exists with | false -> Memo.return acc diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index f0f6ca091f0..556b393b0be 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -33,7 +33,7 @@ end module Ocamlformat = struct let dev_tool_lock_dir_exists () = - Lock_dir.dev_tool_source_lock_dir Ocamlformat |> Path.source |> Path.Untracked.exists + Lock_dir.dev_tool_untracked_lock_dir Ocamlformat |> Path.Untracked.exists ;; (* Config files for ocamlformat. When these are changed, running diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index c61925efd38..f2ea3a00c63 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -147,14 +147,16 @@ let dev_tool_to_path_segment dev_tool = dev_tool |> Dev_tool.package_name |> Package_name.to_string |> Path.Local.of_string ;; -let dev_tool_source_lock_dir dev_tool = - let dev_tools_path = - Path.Source.L.relative Path.Source.root [ "_build"; ".dev-tools.locks" ] - in +(* This function returns the lock dir that is created outside the build system. *) +let dev_tool_untracked_lock_dir dev_tool = + let dev_tools_path = Path.Build.relative Path.Build.root ".dev-tools.locks" in let dev_tool_segment = dev_tool_to_path_segment dev_tool in - Path.Source.append_local dev_tools_path dev_tool_segment + Path.Build.append_local dev_tools_path dev_tool_segment |> Path.build ;; +(* This function returns the lock dir location where the build system can create + the lock directory. This is where lock files should be loaded from and it + is populated either by copy rules or the solver running. *) let dev_tool_lock_dir dev_tool = (* dev tools always live in default *) let ctx_name = Context_name.default |> Context_name.to_string in @@ -228,20 +230,20 @@ let get ctx = get_with_path ctx >>| Result.map ~f:snd let get_exn ctx = get ctx >>| User_error.ok_exn let of_dev_tool dev_tool = - let source_path = dev_tool_source_lock_dir dev_tool in - Load.load_exn (Path.source source_path) + let path = dev_tool_untracked_lock_dir dev_tool in + Load.load_exn path ;; let of_dev_tool_if_lock_dir_exists dev_tool = - let source_path = dev_tool_source_lock_dir dev_tool in + let path = dev_tool_untracked_lock_dir dev_tool in let exists = (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's lockdir may be generated part way through a build. *) - Path.Untracked.exists (Path.source source_path) + Path.Untracked.exists path in if exists then - let+ t = Load.load_exn (Path.source source_path) in + let+ t = Load.load_exn path in Some t else Memo.return None ;; diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index d88ba4fc45c..e2f133df95b 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -21,7 +21,7 @@ val default_path : Path.t val default_source_path : Path.Source.t (** The location in the source tree where a dev tool lock dir is expected *) -val dev_tool_source_lock_dir : Dune_pkg.Dev_tool.t -> Path.Source.t +val dev_tool_untracked_lock_dir : Dune_pkg.Dev_tool.t -> Path.t (** Returns the path to the lock_dir that will be used to lock the given dev tool *) diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index f65935a5c76..9c0fc1ee73f 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -410,11 +410,10 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files = let open Action_builder.O in Action_builder.deps deps >>> (Path.Set.to_list_map files ~f:(fun src -> - let dst = - Path.drop_prefix_exn src ~prefix:(Path.source lock_dir) - |> Path.Build.append_local target - in - Action.progn [ Action.mkdir (Path.Build.parent_exn dst); Action.copy src dst ]) + let suffix = Path.drop_prefix_exn src ~prefix:lock_dir in + let dst = Path.Build.append_local target suffix in + let parent = Path.Build.parent_exn dst in + Action.progn [ Action.mkdir parent; Action.copy src dst ]) |> Action.concurrent |> Action.Full.make |> Action_builder.return) @@ -469,7 +468,7 @@ let files dir = let setup_copy_rules ~dir:target ~assume_src_exists ~lock_dir = let+ () = Memo.return () in - let deps, files = files (Path.source lock_dir) in + let deps, files = files lock_dir in let directory_targets, rules = match Path.Set.is_empty files with | true -> Path.Build.Map.empty, Rules.empty @@ -500,7 +499,7 @@ let setup_lock_rules_with_source (workspace : Workspace.t) ~dir ~lock_dir = match source with | `Source_tree lock_dir -> let dir = Path.Build.append_source dir lock_dir in - setup_copy_rules ~assume_src_exists:false ~dir ~lock_dir + setup_copy_rules ~assume_src_exists:false ~dir ~lock_dir:(Path.source lock_dir) | `Generated -> Memo.return (setup_lock_rules ~dir ~lock_dir) ;; @@ -508,7 +507,7 @@ let setup_dev_tool_lock_rules ~dir dev_tool = let package_name = Dev_tool.package_name dev_tool in let dev_tool_name = Dune_lang.Package_name.to_string package_name in let dir = Path.Build.relative dir dev_tool_name in - let lock_dir = Lock_dir.dev_tool_source_lock_dir dev_tool in + let lock_dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in (* dev tool lock files are created in _build outside of the build system so we have to tell the build system not to try to create them *) setup_copy_rules ~dir ~assume_src_exists:true ~lock_dir diff --git a/src/dune_rules/merlin/ocaml_index.ml b/src/dune_rules/merlin/ocaml_index.ml index 605b381b459..1cfcd81f535 100644 --- a/src/dune_rules/merlin/ocaml_index.ml +++ b/src/dune_rules/merlin/ocaml_index.ml @@ -9,7 +9,7 @@ let ocaml_index_dev_tool_exe_path_building_if_necessary () = ;; let ocaml_index_dev_tool_exists () = - Lock_dir.dev_tool_source_lock_dir Ocaml_index |> Path.source |> Path.Untracked.exists + Lock_dir.dev_tool_untracked_lock_dir Ocaml_index |> Path.Untracked.exists ;; let ocaml_index sctx ~dir = diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 1f5de67c9f7..f0cc6d18ceb 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -86,11 +86,7 @@ module Package_universe = struct | Dependencies ctx -> Lock_dir.get_path ctx | Dev_tool dev_tool -> (* CR-Leonidas-from-XIV: It probably isn't always [Some] *) - dev_tool - |> Lock_dir.dev_tool_source_lock_dir - |> Path.source - |> Option.some - |> Memo.return + dev_tool |> Lock_dir.dev_tool_untracked_lock_dir |> Option.some |> Memo.return ;; end diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 4e3e3173bd8..7a265b1ab42 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -147,9 +147,9 @@ let requires ~loc ~db ~libs = ;; let utop_dev_tool_lock_dir_exists = - Memo.Lazy.create (fun () -> - let path = Lock_dir.dev_tool_source_lock_dir Utop in - Fs_memo.dir_exists (In_source_dir path)) + lazy + (let path = Lock_dir.dev_tool_untracked_lock_dir Utop in + Path.Untracked.exists path) ;; let utop_findlib_conf = Filename.concat utop_dir_basename "findlib.conf" @@ -168,8 +168,8 @@ let utop_ocamlpath = Memo.Lazy.create (fun () -> Pkg_rules.dev_tool_ocamlpath Ut we need to tell findlib where to look for libraries by means of a custom findlib.conf file. *) let findlib_conf sctx ~dir = - Memo.Lazy.force utop_dev_tool_lock_dir_exists - >>= function + Lazy.force utop_dev_tool_lock_dir_exists + |> function | false -> (* If there isn't lockdir don't create the findlib.conf rule. *) Memo.return () @@ -187,7 +187,7 @@ let findlib_conf sctx ~dir = let lib_db sctx ~dir = let* scope = Scope.DB.find_by_dir dir in - let* lock_dir_exists = Memo.Lazy.force utop_dev_tool_lock_dir_exists in + let lock_dir_exists = Lazy.force utop_dev_tool_lock_dir_exists in match lock_dir_exists with | false -> Memo.return (Scope.libs scope) | true -> diff --git a/src/dune_rules/utop.mli b/src/dune_rules/utop.mli index 9c9a2ad8b3f..383efc59cf3 100644 --- a/src/dune_rules/utop.mli +++ b/src/dune_rules/utop.mli @@ -8,7 +8,7 @@ val utop_exe : Filename.t val utop_dir_basename : Filename.t val utop_findlib_conf : Filename.t -val utop_dev_tool_lock_dir_exists : bool Memo.Lazy.t +val utop_dev_tool_lock_dir_exists : bool Lazy.t val libs_under_dir : Super_context.t -> db:Lib.DB.t -> dir:Path.t -> Lib.t list Memo.t val setup : Super_context.t -> dir:Path.Build.t -> unit Memo.t diff --git a/src/source/workspace.ml b/src/source/workspace.ml index 25000292f38..5fb3d3217cf 100644 --- a/src/source/workspace.ml +++ b/src/source/workspace.ml @@ -742,7 +742,14 @@ let source_path_of_lock_dir_path path = | In_build_dir b -> (match Path.Build.explode b with | [ _; _; ".lock"; lock_dir ] -> Path.Source.of_string lock_dir - | _ -> Code_error.raise "Unsupported build path" [ "dir", Path.Build.to_dyn b ]) + | [ ".dev-tools.locks"; dev_tool_name ] -> + Path.Source.L.relative + Path.Source.root + [ "_build"; ".dev-tools.locks"; dev_tool_name ] + | components -> + Code_error.raise + "Unsupported build path" + [ "dir", Path.Build.to_dyn b; "components", Dyn.(list string) components ]) | External e -> Code_error.raise "External lock dir path is unsupported" From 495845dec04164c51c9b4d2ec69cffa704c78e5d Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 12 Nov 2025 14:33:17 +0100 Subject: [PATCH 03/14] Turn the dev-tool path to a `Path.External.t` Signed-off-by: Marek Kubica --- bin/lock_dev_tool.ml | 11 ++++-- bin/ocaml/utop.ml | 4 +-- bin/pkg/lock.ml | 19 +++++++++-- src/dune_pkg/lock_dir.ml | 20 +++++------ src/dune_pkg/workspace.ml | 34 +++++++++++++++++++ src/dune_pkg/workspace.mli | 2 ++ src/dune_rules/fetch_rules.ml | 4 +-- src/dune_rules/format_rules.ml | 4 ++- src/dune_rules/lock_dir.ml | 13 ++++--- src/dune_rules/lock_dir.mli | 2 +- src/dune_rules/lock_rules.ml | 2 +- src/dune_rules/merlin/ocaml_index.ml | 4 ++- src/dune_rules/pkg_rules.ml | 29 ++++++++++------ src/dune_rules/utop.ml | 12 +++---- src/dune_rules/utop.mli | 2 +- src/source/workspace.ml | 9 +---- .../ocamlformat-dev-tool-fails-to-build.t | 7 +++- 17 files changed, 121 insertions(+), 57 deletions(-) diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index ea417a960e7..678a611d724 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -80,7 +80,9 @@ let solve ~dev_tool ~local_packages = | `Disabled -> workspace in (* as we want to write to the source, we're using the source lock dir here *) - let lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in + let lock_dir = + Dune_rules.Lock_dir.dev_tool_external_lock_dir dev_tool |> Path.external_ + in Memo.of_reproducible_fiber @@ Pkg.Lock.solve workspace @@ -174,11 +176,14 @@ let extra_dependencies dev_tool = let lockdir_status dev_tool = let open Memo.O in - let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_untracked_lock_dir dev_tool in - let lock_dir_exists = Path.exists dev_tool_lock_dir in + let dev_tool_lock_dir = Dune_rules.Lock_dir.dev_tool_external_lock_dir dev_tool in + let* lock_dir_exists = + Dune_engine.Fs_memo.dir_exists (Path.Outside_build_dir.External dev_tool_lock_dir) + in match lock_dir_exists with | false -> Memo.return `No_lockdir | true -> + let dev_tool_lock_dir = Path.external_ dev_tool_lock_dir in (match Lock_dir.read_disk dev_tool_lock_dir with | Error _ -> Memo.return `No_lockdir | Ok { packages; _ } -> diff --git a/bin/ocaml/utop.ml b/bin/ocaml/utop.ml index 9c449e9da29..0d0e18c76f3 100644 --- a/bin/ocaml/utop.ml +++ b/bin/ocaml/utop.ml @@ -61,8 +61,8 @@ let term = [ Pp.textf "no library is defined in %s" (String.maybe_quoted dir) ] | true -> let* () = Build_system.build_file utop_exe in - let utop_dev_tool_lock_dir_exists = - Lazy.force Utop.utop_dev_tool_lock_dir_exists + let* utop_dev_tool_lock_dir_exists = + Memo.Lazy.force Utop.utop_dev_tool_lock_dir_exists in let* () = if utop_dev_tool_lock_dir_exists diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml index d7ddc5258eb..be16349388c 100644 --- a/bin/pkg/lock.ml +++ b/bin/pkg/lock.ml @@ -197,6 +197,13 @@ let solve_multiple_platforms |> Platforms_by_message.all_solver_errors_raising_if_any_manifest_errors ) ;; +let user_lock_dir_path path = + match (path : Path.t) with + | In_source_tree _ -> path + | In_build_dir _ -> path + | External e -> Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e |> Path.source +;; + let summary_message ~portable_lock_dir ~lock_dir_path @@ -259,7 +266,9 @@ let summary_message in (Pp.tag User_message.Style.Success - (Pp.textf "Solution for %s" (Path.to_string_maybe_quoted lock_dir_path)) + (Pp.textf + "Solution for %s" + (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) :: Pp.nop :: Pp.text "Dependencies common to all supported platforms:" :: pp_package_set common_packages @@ -268,7 +277,9 @@ let summary_message else (Pp.tag User_message.Style.Success - (Pp.textf "Solution for %s:" (Path.to_string_maybe_quoted lock_dir_path)) + (Pp.textf + "Solution for %s:" + (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with | [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)" | packages -> pp_packages packages) @@ -493,7 +504,9 @@ let solve ([ Pp.text "Unable to solve dependencies for the following lock directories:" ] @ List.concat_map errors ~f:(fun (path, errors) -> let messages = List.map errors ~f:fst in - [ Pp.textf "Lock directory %s:" (Path.to_string_maybe_quoted path) + [ Pp.textf + "Lock directory %s:" + (Path.to_string_maybe_quoted (user_lock_dir_path path)) ; Pp.vbox (Pp.concat ~sep:Pp.cut messages) ])) | Ok write_disks_with_summaries -> diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 13c374afc32..4d511d32eac 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -538,10 +538,7 @@ let in_source_tree path = ; "source_components", Dyn.(list string) source_components ; "build_components", Dyn.(list string) build_components ])) - | External e -> - Code_error.raise - "External path returned when loading a lock dir" - [ "path", Path.External.to_dyn e ] + | External e -> Workspace.dev_tool_path_to_source_dir e ;; module Pkg = struct @@ -887,14 +884,9 @@ module Pkg = struct ^ extension) ;; + (* TODO remove *) let files_dir package_name maybe_package_version ~lock_dir = - match files_dir_generic package_name maybe_package_version ~lock_dir with - | In_source_tree _ as path -> path - | In_build_dir _ as path -> path - | External e -> - Code_error.raise - "file_dir is an external path, this is unsupported" - [ "path", Path.External.to_dyn e ] + files_dir_generic package_name maybe_package_version ~lock_dir ;; let source_files_dir package_name maybe_package_version ~lock_dir = @@ -1402,7 +1394,11 @@ module Write_disk = struct let safely_remove_lock_dir_if_exists_thunk path = match check_existing_lock_dir path with | Ok `Non_existant -> Fun.const () - | Ok `Is_existing_lock_dir -> fun () -> Path.rm_rf path + | Ok `Is_existing_lock_dir -> + fun () -> + (* dev-tool lock dirs are external paths despite living in _build, they're + safe to remove *) + Path.rm_rf ~allow_external:true path | Error e -> raise_user_error_on_check_existance path e ;; diff --git a/src/dune_pkg/workspace.ml b/src/dune_pkg/workspace.ml index 0e2dbe37455..eb948c5b282 100644 --- a/src/dune_pkg/workspace.ml +++ b/src/dune_pkg/workspace.ml @@ -70,3 +70,37 @@ module Repository = struct let opam_url { name = _; url } = url end + +let dev_tool_path_to_source_dir path = + let of_ = + Path.Build.relative Path.Build.root ".dev-tools.locks" + |> Path.build + |> Path.to_absolute_filename + |> Path.External.of_string + in + let in_dev_tool_dir = Path.External.is_descendant ~of_ path in + match in_dev_tool_dir with + | false -> + Code_error.raise + "External lock dir path is unsupported" + [ "dir", Path.External.to_dyn path ] + | true -> + let prefix = Path.External.to_string of_ in + let as_string = Path.External.to_string path in + let relative = + String.sub + as_string + ~pos:(String.length prefix) + ~len:(String.length as_string - String.length prefix) + in + let exploded = String.split ~on:'/' relative in + (match exploded with + | "" :: dev_tool_name :: components -> + Path.Source.L.relative + Path.Source.root + ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) + | components -> + Code_error.raise + "Unexpected external path" + [ "dir", Path.External.to_dyn path; "components", Dyn.(list string) components ]) +;; diff --git a/src/dune_pkg/workspace.mli b/src/dune_pkg/workspace.mli index 471f77e3529..9187e3d88e7 100644 --- a/src/dune_pkg/workspace.mli +++ b/src/dune_pkg/workspace.mli @@ -25,3 +25,5 @@ module Repository : sig val name : t -> Name.t end + +val dev_tool_path_to_source_dir : Path.External.t -> Path.Source.t diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index 9dd78fedf58..14cb4cb0b58 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -189,11 +189,11 @@ let find_checksum, find_url = Dune_pkg.Dev_tool.all ~init:(Checksum.Map.empty, Digest.Map.empty) ~f:(fun acc dev_tool -> - let dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in + let dir = Lock_dir.dev_tool_external_lock_dir dev_tool in let exists = (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's lockdir may be generated part way through a build. *) - Path.Untracked.exists dir + Path.Untracked.exists (Path.external_ dir) in match exists with | false -> Memo.return acc diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 556b393b0be..dd4b87240bb 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -33,7 +33,9 @@ end module Ocamlformat = struct let dev_tool_lock_dir_exists () = - Lock_dir.dev_tool_untracked_lock_dir Ocamlformat |> Path.Untracked.exists + Lock_dir.dev_tool_external_lock_dir Ocamlformat + |> Path.external_ + |> Path.Untracked.exists ;; (* Config files for ocamlformat. When these are changed, running diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index f2ea3a00c63..326ad7d593d 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -148,10 +148,13 @@ let dev_tool_to_path_segment dev_tool = ;; (* This function returns the lock dir that is created outside the build system. *) -let dev_tool_untracked_lock_dir dev_tool = - let dev_tools_path = Path.Build.relative Path.Build.root ".dev-tools.locks" in +let dev_tool_external_lock_dir dev_tool = + let external_root = + Path.Build.root |> Path.build |> Path.to_absolute_filename |> Path.External.of_string + in + let dev_tools_path = Path.External.relative external_root ".dev-tools.locks" in let dev_tool_segment = dev_tool_to_path_segment dev_tool in - Path.Build.append_local dev_tools_path dev_tool_segment |> Path.build + Path.External.append_local dev_tools_path dev_tool_segment ;; (* This function returns the lock dir location where the build system can create @@ -230,12 +233,12 @@ let get ctx = get_with_path ctx >>| Result.map ~f:snd let get_exn ctx = get ctx >>| User_error.ok_exn let of_dev_tool dev_tool = - let path = dev_tool_untracked_lock_dir dev_tool in + let path = dev_tool |> dev_tool_external_lock_dir |> Path.external_ in Load.load_exn path ;; let of_dev_tool_if_lock_dir_exists dev_tool = - let path = dev_tool_untracked_lock_dir dev_tool in + let path = dev_tool |> dev_tool_external_lock_dir |> Path.external_ in let exists = (* Note we use [Path.Untracked] here rather than [Fs_memo] because a tool's lockdir may be generated part way through a build. *) diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index e2f133df95b..494eb20590c 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -21,7 +21,7 @@ val default_path : Path.t val default_source_path : Path.Source.t (** The location in the source tree where a dev tool lock dir is expected *) -val dev_tool_untracked_lock_dir : Dune_pkg.Dev_tool.t -> Path.t +val dev_tool_external_lock_dir : Dune_pkg.Dev_tool.t -> Path.External.t (** Returns the path to the lock_dir that will be used to lock the given dev tool *) diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index 9c0fc1ee73f..01f7c274656 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -507,7 +507,7 @@ let setup_dev_tool_lock_rules ~dir dev_tool = let package_name = Dev_tool.package_name dev_tool in let dev_tool_name = Dune_lang.Package_name.to_string package_name in let dir = Path.Build.relative dir dev_tool_name in - let lock_dir = Lock_dir.dev_tool_untracked_lock_dir dev_tool in + let lock_dir = dev_tool |> Lock_dir.dev_tool_external_lock_dir |> Path.external_ in (* dev tool lock files are created in _build outside of the build system so we have to tell the build system not to try to create them *) setup_copy_rules ~dir ~assume_src_exists:true ~lock_dir diff --git a/src/dune_rules/merlin/ocaml_index.ml b/src/dune_rules/merlin/ocaml_index.ml index 1cfcd81f535..908e54da972 100644 --- a/src/dune_rules/merlin/ocaml_index.ml +++ b/src/dune_rules/merlin/ocaml_index.ml @@ -9,7 +9,9 @@ let ocaml_index_dev_tool_exe_path_building_if_necessary () = ;; let ocaml_index_dev_tool_exists () = - Lock_dir.dev_tool_untracked_lock_dir Ocaml_index |> Path.Untracked.exists + Lock_dir.dev_tool_external_lock_dir Ocaml_index + |> Path.external_ + |> Path.Untracked.exists ;; let ocaml_index sctx ~dir = diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index f0cc6d18ceb..59b571e895a 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -86,7 +86,11 @@ module Package_universe = struct | Dependencies ctx -> Lock_dir.get_path ctx | Dev_tool dev_tool -> (* CR-Leonidas-from-XIV: It probably isn't always [Some] *) - dev_tool |> Lock_dir.dev_tool_untracked_lock_dir |> Option.some |> Memo.return + dev_tool + |> Lock_dir.dev_tool_external_lock_dir + |> Path.external_ + |> Option.some + |> Memo.return ;; end @@ -1523,18 +1527,23 @@ end = struct |> Option.map ~f:(fun (p : Path.t) -> match p with | External e -> - Code_error.raise - "Package files directory is external source directory, this is unsupported" - [ "dir", Path.External.to_dyn e ] - | In_source_tree s -> - Code_error.raise "Unexpected files_dir path" [ "dir", Path.Source.to_dyn s ] - | In_build_dir b -> - (match Path.Build.explode b with - | [ ".dev-tools.locks"; dev_tool; files_dir ] -> + let source_path = Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e in + (match Path.Source.explode source_path with + | [ "_build"; ".dev-tools.locks"; dev_tool; files_dir ] -> Path.Build.L.relative Private_context.t.build_dir [ "default"; ".dev-tool-locks"; dev_tool; files_dir ] - | _otherwise -> b)) + | components -> + Code_error.raise + "Package files directory is external source directory, this is \ + unsupported" + [ "external", Path.External.to_dyn e + ; "source", Path.Source.to_dyn source_path + ; "components", Dyn.(list string) components + ]) + | In_source_tree s -> + Code_error.raise "Unexpected files_dir path" [ "dir", Path.Source.to_dyn s ] + | In_build_dir b -> b) in let id = Pkg.Id.gen () in let write_paths = diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 7a265b1ab42..1d06d6d3a7b 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -147,9 +147,9 @@ let requires ~loc ~db ~libs = ;; let utop_dev_tool_lock_dir_exists = - lazy - (let path = Lock_dir.dev_tool_untracked_lock_dir Utop in - Path.Untracked.exists path) + Memo.Lazy.create (fun () -> + let path = Lock_dir.dev_tool_external_lock_dir Utop in + Fs_memo.dir_exists (Path.Outside_build_dir.External path)) ;; let utop_findlib_conf = Filename.concat utop_dir_basename "findlib.conf" @@ -168,8 +168,8 @@ let utop_ocamlpath = Memo.Lazy.create (fun () -> Pkg_rules.dev_tool_ocamlpath Ut we need to tell findlib where to look for libraries by means of a custom findlib.conf file. *) let findlib_conf sctx ~dir = - Lazy.force utop_dev_tool_lock_dir_exists - |> function + Memo.Lazy.force utop_dev_tool_lock_dir_exists + >>= function | false -> (* If there isn't lockdir don't create the findlib.conf rule. *) Memo.return () @@ -187,7 +187,7 @@ let findlib_conf sctx ~dir = let lib_db sctx ~dir = let* scope = Scope.DB.find_by_dir dir in - let lock_dir_exists = Lazy.force utop_dev_tool_lock_dir_exists in + let* lock_dir_exists = Memo.Lazy.force utop_dev_tool_lock_dir_exists in match lock_dir_exists with | false -> Memo.return (Scope.libs scope) | true -> diff --git a/src/dune_rules/utop.mli b/src/dune_rules/utop.mli index 383efc59cf3..9c9a2ad8b3f 100644 --- a/src/dune_rules/utop.mli +++ b/src/dune_rules/utop.mli @@ -8,7 +8,7 @@ val utop_exe : Filename.t val utop_dir_basename : Filename.t val utop_findlib_conf : Filename.t -val utop_dev_tool_lock_dir_exists : bool Lazy.t +val utop_dev_tool_lock_dir_exists : bool Memo.Lazy.t val libs_under_dir : Super_context.t -> db:Lib.DB.t -> dir:Path.t -> Lib.t list Memo.t val setup : Super_context.t -> dir:Path.Build.t -> unit Memo.t diff --git a/src/source/workspace.ml b/src/source/workspace.ml index 5fb3d3217cf..20a8b70fed2 100644 --- a/src/source/workspace.ml +++ b/src/source/workspace.ml @@ -742,18 +742,11 @@ let source_path_of_lock_dir_path path = | In_build_dir b -> (match Path.Build.explode b with | [ _; _; ".lock"; lock_dir ] -> Path.Source.of_string lock_dir - | [ ".dev-tools.locks"; dev_tool_name ] -> - Path.Source.L.relative - Path.Source.root - [ "_build"; ".dev-tools.locks"; dev_tool_name ] | components -> Code_error.raise "Unsupported build path" [ "dir", Path.Build.to_dyn b; "components", Dyn.(list string) components ]) - | External e -> - Code_error.raise - "External lock dir path is unsupported" - [ "dir", Path.External.to_dyn e ] + | External e -> Dune_pkg.Pkg_workspace.dev_tool_path_to_source_dir e ;; let find_lock_dir t path = 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 index 10febef5b4c..c52ec4843b3 100644 --- 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 @@ -15,7 +15,7 @@ It fails during the build because of missing OCamlFormat module. $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.4 - File "_build/.dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10: + File "$TESTCASE_ROOT/_build/.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 @@ -24,4 +24,9 @@ It fails during the build because of missing OCamlFormat module. ^^^^^^^^^^^ Error: Module "Ocamlformat" doesn't exist. + -> required by + _build/_private/default/.dev-tool/ocamlformat/target/bin/ocamlformat + -> required by _build/default/.formatted/foo.ml + -> required by alias .formatted/fmt + -> required by alias fmt [1] From 5966f6e7c30ea0419facbf7752b0772f3e63e894 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 12 Nov 2025 15:02:43 +0100 Subject: [PATCH 04/14] Fix after rebase Signed-off-by: Marek Kubica --- src/source/workspace.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/source/workspace.ml b/src/source/workspace.ml index 20a8b70fed2..7584de333a8 100644 --- a/src/source/workspace.ml +++ b/src/source/workspace.ml @@ -742,6 +742,8 @@ let source_path_of_lock_dir_path path = | In_build_dir b -> (match Path.Build.explode b with | [ _; _; ".lock"; lock_dir ] -> Path.Source.of_string lock_dir + | [ ".dev-tools.locks"; dev_tool ] -> + Path.Source.L.relative Path.Source.root [ "_build"; ".dev-tools.locks"; dev_tool ] | components -> Code_error.raise "Unsupported build path" From f0608227e3450dff5b0f9d682b5b35ee3d2acabc Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 12 Nov 2025 17:03:03 +0100 Subject: [PATCH 05/14] Remove unused indirection Signed-off-by: Marek Kubica --- src/dune_pkg/lock_dir.ml | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 4d511d32eac..fc9b46d8c39 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -869,7 +869,7 @@ module Pkg = struct ;; (* More general version of [files_dir] which works on generic paths *) - let files_dir_generic package_name maybe_package_version ~lock_dir = + let files_dir package_name maybe_package_version ~lock_dir = (* TODO(steve): Once portable lockdirs are enabled by default, make the package version non-optional *) let extension = ".files" in @@ -884,11 +884,6 @@ module Pkg = struct ^ extension) ;; - (* TODO remove *) - let files_dir package_name maybe_package_version ~lock_dir = - files_dir_generic package_name maybe_package_version ~lock_dir - ;; - let source_files_dir package_name maybe_package_version ~lock_dir = let source = in_source_tree lock_dir in let package_name = Package_name.to_string package_name in @@ -1494,10 +1489,7 @@ module Write_disk = struct let maybe_package_version = if portable_lock_dir then Some package_version else None in - Pkg.files_dir_generic - package_name - maybe_package_version - ~lock_dir:lock_dir_path + Pkg.files_dir package_name maybe_package_version ~lock_dir:lock_dir_path in Path.mkdir_p files_dir; List.iter files ~f:(fun { File_entry.original; local_file } -> From 056e949b39a32380826edda56a99064c4c06b5fb Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Mon, 17 Nov 2025 15:57:18 +0100 Subject: [PATCH 06/14] Rewrite absolute external paths into relative paths Signed-off-by: Marek Kubica --- src/dune_pkg/lock_dir.ml | 15 +++------------ .../ocamlformat-dev-tool-fails-to-build.t | 7 +------ 2 files changed, 4 insertions(+), 18 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index fc9b46d8c39..80e3d2dcd60 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1787,18 +1787,9 @@ let loc_in_source_tree loc = loc |> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) -> let path = Path.of_string pos_fname in - match path with - | External _ | In_source_tree _ -> pos - | In_build_dir b -> - (match Path.Build.explode b with - | ".dev-tools.locks" :: _ -> - (* we're excluding the hidden dev-tools.locks folders in the build folder - from rewriting *) - pos - | _otherwise -> - let new_path = in_source_tree path in - let pos_fname = Path.Source.to_string new_path in - { pos with pos_fname })) + let new_path = in_source_tree path in + let pos_fname = Path.Source.to_string new_path in + { pos with pos_fname }) ;; let check_if_solved_for_platform { solved_for_platforms; _ } ~platform = 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 index c52ec4843b3..10febef5b4c 100644 --- 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 @@ -15,7 +15,7 @@ It fails during the build because of missing OCamlFormat module. $ DUNE_CONFIG__LOCK_DEV_TOOL=enabled dune fmt Solution for _build/.dev-tools.locks/ocamlformat: - ocamlformat.0.26.4 - File "$TESTCASE_ROOT/_build/.dev-tools.locks/ocamlformat/ocamlformat.pkg", line 4, characters 6-10: + File "_build/.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 @@ -24,9 +24,4 @@ It fails during the build because of missing OCamlFormat module. ^^^^^^^^^^^ Error: Module "Ocamlformat" doesn't exist. - -> required by - _build/_private/default/.dev-tool/ocamlformat/target/bin/ocamlformat - -> required by _build/default/.formatted/foo.ml - -> required by alias .formatted/fmt - -> required by alias fmt [1] From 06cd03625b39d6f6f47d41cdf90ef7bbd0218501 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 10:34:21 +0100 Subject: [PATCH 07/14] Bring back `Fs_memo` Signed-off-by: Marek Kubica --- src/dune_rules/pkg_rules.ml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 59b571e895a..167c3c3aa7c 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -1494,10 +1494,10 @@ end = struct in resolve db dep_loc dep_pkg_digest package_universe) and+ files_dir = - let+ lock_dir = + let* lock_dir = Package_universe.lock_dir_path package_universe >>| Option.value_exn in - let files_dir = + let+ files_dir = let module Pkg = Dune_pkg.Lock_dir.Pkg in (* TODO(steve): simplify this once portable lockdirs become the default. This logic currently handles both the cases where @@ -1509,15 +1509,17 @@ end = struct let path_with_version = Pkg.source_files_dir info.name (Some info.version) ~lock_dir in - let path_with_version_exists = - Path.Untracked.exists (Path.source path_with_version) + let* path_with_version_exists = + Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir path_with_version) in match path_with_version_exists with - | true -> Some (Pkg.files_dir info.name (Some info.version) ~lock_dir) + | true -> + Memo.return @@ Some (Pkg.files_dir info.name (Some info.version) ~lock_dir) | false -> let path_without_version = Pkg.source_files_dir info.name None ~lock_dir in - let path_without_version_exists = - Path.Untracked.exists (Path.source path_without_version) + let+ path_without_version_exists = + Fs_memo.dir_exists + (Path.Outside_build_dir.In_source_dir path_without_version) in (match path_without_version_exists with | true -> Some (Pkg.files_dir info.name None ~lock_dir) From 63afd579e2e0dfee0da03e3fb71414fd9b0aabc6 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 10:53:22 +0100 Subject: [PATCH 08/14] Improve implementation of external to source mapping Signed-off-by: Marek Kubica --- src/dune_pkg/workspace.ml | 50 +++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 26 deletions(-) diff --git a/src/dune_pkg/workspace.ml b/src/dune_pkg/workspace.ml index eb948c5b282..97489c6e786 100644 --- a/src/dune_pkg/workspace.ml +++ b/src/dune_pkg/workspace.ml @@ -72,35 +72,33 @@ module Repository = struct end let dev_tool_path_to_source_dir path = - let of_ = - Path.Build.relative Path.Build.root ".dev-tools.locks" - |> Path.build - |> Path.to_absolute_filename - |> Path.External.of_string + let lock_dir_location = + Path.Build.relative Path.Build.root ".dev-tools.locks" |> Path.build in - let in_dev_tool_dir = Path.External.is_descendant ~of_ path in - match in_dev_tool_dir with + let absolute = Path.to_absolute_filename lock_dir_location in + match Path.External.is_descendant ~of_:(Path.External.of_string absolute) path with | false -> Code_error.raise - "External lock dir path is unsupported" - [ "dir", Path.External.to_dyn path ] + "External path is not pointing to lock dir location" + [ "external", Path.External.to_dyn path + ; "dev tool lock dir location", Path.to_dyn lock_dir_location + ] | true -> - let prefix = Path.External.to_string of_ in let as_string = Path.External.to_string path in - let relative = - String.sub - as_string - ~pos:(String.length prefix) - ~len:(String.length as_string - String.length prefix) - in - let exploded = String.split ~on:'/' relative in - (match exploded with - | "" :: dev_tool_name :: components -> - Path.Source.L.relative - Path.Source.root - ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) - | components -> - Code_error.raise - "Unexpected external path" - [ "dir", Path.External.to_dyn path; "components", Dyn.(list string) components ]) + (match String.drop_prefix ~prefix:absolute as_string with + | None -> + (* we checked for descendants before, thus it has to match the prefix *) + assert false + | Some suffix -> + (match String.split ~on:'/' suffix with + | "" :: dev_tool_name :: components -> + Path.Source.L.relative + Path.Source.root + ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) + | components -> + Code_error.raise + "Unexpected external path" + [ "dir", Path.External.to_dyn path + ; "components", Dyn.(list string) components + ])) ;; From 83968d92ab1cca8f89a60bf893d64338107b6fc7 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 11:32:59 +0100 Subject: [PATCH 09/14] Closer to style of `main` Signed-off-by: Marek Kubica --- src/dune_rules/lock_rules.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index 01f7c274656..2910764afc1 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -410,10 +410,10 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files = let open Action_builder.O in Action_builder.deps deps >>> (Path.Set.to_list_map files ~f:(fun src -> - let suffix = Path.drop_prefix_exn src ~prefix:lock_dir in - let dst = Path.Build.append_local target suffix in - let parent = Path.Build.parent_exn dst in - Action.progn [ Action.mkdir parent; Action.copy src dst ]) + let dst = + Path.drop_prefix_exn src ~prefix:lock_dir |> Path.Build.append_local target + in + Action.progn [ Action.mkdir (Path.Build.parent_exn dst); Action.copy src dst ]) |> Action.concurrent |> Action.Full.make |> Action_builder.return) From 284acb6fd9e6ac37dbe24fb9c81a8f974e7003ab Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 11:59:38 +0100 Subject: [PATCH 10/14] Add validation that path to be deleted is in fact managed Signed-off-by: Marek Kubica --- src/dune_pkg/lock_dir.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 80e3d2dcd60..27fc10410a9 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1391,9 +1391,14 @@ module Write_disk = struct | Ok `Non_existant -> Fun.const () | Ok `Is_existing_lock_dir -> fun () -> - (* dev-tool lock dirs are external paths despite living in _build, they're - safe to remove *) - Path.rm_rf ~allow_external:true path + let path = + match path with + | In_source_tree _ | In_build_dir _ -> path + | External e -> + (* it might be a dev-tool path, try to convert *) + Workspace.dev_tool_path_to_source_dir e |> Path.source + in + Path.rm_rf path | Error e -> raise_user_error_on_check_existance path e ;; From 422a10e95937bdc4061541d7dad116c9ceae3343 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 14:22:39 +0100 Subject: [PATCH 11/14] Use `try_localize` instead of rolling my own version of it Signed-off-by: Marek Kubica --- src/dune_pkg/workspace.ml | 40 +++++++++++++-------------------------- 1 file changed, 13 insertions(+), 27 deletions(-) diff --git a/src/dune_pkg/workspace.ml b/src/dune_pkg/workspace.ml index 97489c6e786..293cd7b6093 100644 --- a/src/dune_pkg/workspace.ml +++ b/src/dune_pkg/workspace.ml @@ -72,33 +72,19 @@ module Repository = struct end let dev_tool_path_to_source_dir path = - let lock_dir_location = - Path.Build.relative Path.Build.root ".dev-tools.locks" |> Path.build - in - let absolute = Path.to_absolute_filename lock_dir_location in - match Path.External.is_descendant ~of_:(Path.External.of_string absolute) path with - | false -> + match Path.Expert.try_localize_external (Path.external_ path) with + | External _ | In_source_tree _ -> Code_error.raise "External path is not pointing to lock dir location" - [ "external", Path.External.to_dyn path - ; "dev tool lock dir location", Path.to_dyn lock_dir_location - ] - | true -> - let as_string = Path.External.to_string path in - (match String.drop_prefix ~prefix:absolute as_string with - | None -> - (* we checked for descendants before, thus it has to match the prefix *) - assert false - | Some suffix -> - (match String.split ~on:'/' suffix with - | "" :: dev_tool_name :: components -> - Path.Source.L.relative - Path.Source.root - ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) - | components -> - Code_error.raise - "Unexpected external path" - [ "dir", Path.External.to_dyn path - ; "components", Dyn.(list string) components - ])) + [ "external", Path.External.to_dyn path ] + | In_build_dir b -> + (match Path.Build.explode b with + | ".dev-tools.locks" :: dev_tool_name :: components -> + Path.Source.L.relative + Path.Source.root + ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) + | components -> + Code_error.raise + "Unexpected external path" + [ "dir", Path.External.to_dyn path; "components", Dyn.(list string) components ]) ;; From 53ee2930bda42a5451d823e553004c48636ef9b2 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Tue, 18 Nov 2025 16:51:40 +0100 Subject: [PATCH 12/14] Do not assume build dir name Signed-off-by: Marek Kubica --- src/dune_pkg/lock_dir.ml | 9 +++++---- src/dune_pkg/workspace.ml | 7 +++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 27fc10410a9..4c2caf0e8f3 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -526,10 +526,11 @@ let in_source_tree path = Path.Source.L.relative Path.Source.root components | source_components -> (match Path.Build.explode b with - | ".dev-tools.locks" :: dev_tool :: components -> - Path.Source.L.relative - Path.Source.root - ([ "_build"; ".dev-tools.locks"; dev_tool ] @ components) + | (".dev-tools.locks" as prefix) :: dev_tool :: components -> + let build_as_source = + Path.build_dir |> Path.to_string |> Path.Source.of_string + in + Path.Source.L.relative build_as_source (prefix :: dev_tool :: components) | build_components -> Code_error.raise "Unexpected location of lock directory in build directory" diff --git a/src/dune_pkg/workspace.ml b/src/dune_pkg/workspace.ml index 293cd7b6093..64cf00beeb9 100644 --- a/src/dune_pkg/workspace.ml +++ b/src/dune_pkg/workspace.ml @@ -79,10 +79,9 @@ let dev_tool_path_to_source_dir path = [ "external", Path.External.to_dyn path ] | In_build_dir b -> (match Path.Build.explode b with - | ".dev-tools.locks" :: dev_tool_name :: components -> - Path.Source.L.relative - Path.Source.root - ([ "_build"; ".dev-tools.locks"; dev_tool_name ] @ components) + | (".dev-tools.locks" as prefix) :: dev_tool_name :: components -> + let build_as_source = Path.build_dir |> Path.to_string |> Path.Source.of_string in + Path.Source.L.relative build_as_source (prefix :: dev_tool_name :: components) | components -> Code_error.raise "Unexpected external path" From 64c51f7ee26b50d6601f6fbf9db6f06948d8f05c Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 19 Nov 2025 10:54:15 +0100 Subject: [PATCH 13/14] Add cram test to show that custom build dirs work Signed-off-by: Marek Kubica --- .../ocamlformat-custom-build-dir.t | 48 +++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-custom-build-dir.t diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-custom-build-dir.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-custom-build-dir.t new file mode 100644 index 00000000000..aef91fae41a --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-custom-build-dir.t @@ -0,0 +1,48 @@ +Checks whether dev-tool locking takes custom build directories correctly into account. + + $ . ./helpers.sh + +Set up some ocamlformat that we want to install. + + $ ocamlformat_version="0.26.2" + $ make_fake_ocamlformat "${ocamlformat_version}" + $ make_ocamlformat_opam_pkg "${ocamlformat_version}" + + $ cat > .ocamlformat < version = ${ocamlformat_version} + > EOF + +Override the build directory that we want to build in. We do this by replacing +the build directory in `$dev_tool_lock_dir` with our custom build directory. + + $ default_build_dir="_build" + $ custom_build_dir="_other_build" + $ default_dev_tool_lock_dir="${dev_tool_lock_dir}" + $ dev_tool_lock_dir=$(echo "${dev_tool_lock_dir}" | sed "s/^$default_build_dir/$custom_build_dir/") + +Create a configuration with this custom build directory + + $ make_project_with_dev_tool_lockdir + $ enable_pkg + +Make sure we don't have a lock dir + + $ [ -e "${dev_tool_lock_dir}"/lock.dune ] || echo "Lock dir does not exist in custom location" + Lock dir does not exist in custom location + $ [ -e "${default_dev_tool_lock_dir}"/lock.dune ] || echo "Lock dir does not exist in default location" + Lock dir does not exist in default location + +Install our fake ocamlformat, making sure to override the build directory. + + $ dune tools install ocamlformat --build-dir="${custom_build_dir}" + Solution for _other_build/.dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + +This should've worked and picked up our ocamlformat using the lock dir +configuration from the dune-workspace. But also, we should now have a lock dir +at the right location, in our custom build dir. + + $ [ -e "${dev_tool_lock_dir}"/lock.dune ] && echo "Lock dir created in the correct, custom location" + Lock dir created in the correct, custom location + $ [ -e "${default_dev_tool_lock_dir}"/lock.dune ] || echo "Lock dir does not exist in default location" + Lock dir does not exist in default location From 7f8be0c09d0eef498c59bfaab7318351b9c180f0 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Wed, 19 Nov 2025 16:28:37 +0000 Subject: [PATCH 14/14] use fs_memo to scan lock directories Signed-off-by: Ali Caglayan --- src/dune_rules/lock_rules.ml | 78 ++++++++++++++---------------------- 1 file changed, 30 insertions(+), 48 deletions(-) diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index 2910764afc1..99202153000 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -424,60 +424,44 @@ let copy_lock_dir ~target ~lock_dir ~deps ~files = ~dirs:(Path.Build.Set.singleton target)) ;; -let files dir = - let rec recurse dir = - match Path.Untracked.readdir_unsorted_with_kinds dir with - | Ok entries -> - entries - |> List.fold_left - ~init:(Path.Set.empty, Path.Set.empty) - ~f:(fun (files, empty_directories) (entry, kind) -> - let path = Path.relative dir entry in - match (kind : Unix.file_kind) with - | S_REG -> - let files = Path.Set.add files path in - files, empty_directories - | S_DIR -> - let files', empty_directories' = recurse path in - (match Path.Set.is_empty files', Path.Set.is_empty empty_directories' with - | true, true -> - let empty_directories = Path.Set.add empty_directories path in - files, empty_directories - | _, _ -> - let files = Path.Set.union files files' in - let empty_directories = - Path.Set.union empty_directories empty_directories' - in - files, empty_directories) - | otherwise -> - Code_error.raise - "unsupported kind of file in folder" - [ "path", Path.to_dyn path; "kind", File_kind.to_dyn otherwise ]) - | Error (ENOENT, _, _) -> Path.Set.empty, Path.Set.empty +let scan_lock_directory = + let rec scan dir = + let open Memo.O in + Fs_memo.dir_contents (Path.as_outside_build_dir_exn dir) + >>= function + | Error (ENOENT, _, _) -> Memo.return Path.Set.empty | Error unix_error -> User_error.raise - [ Pp.textf - "Failed to read lock dir files of %s:" - (Path.to_string_maybe_quoted dir) - ; Pp.text (Unix_error.Detailed.to_string_hum unix_error) + [ Pp.textf "Failed to read directory %s:" (Path.to_string_maybe_quoted dir) + ; Unix_error.Detailed.pp unix_error ] + | Ok entries -> + Fs_cache.Dir_contents.to_list entries + |> Memo.parallel_map ~f:(fun (entry, kind) -> + let path = Path.relative dir entry in + match (kind : File_kind.t) with + | S_REG -> Memo.return (Path.Set.singleton path) + | S_DIR -> scan path + | kind -> + User_error.raise + [ Pp.textf + "Lock directory contains file %S with unsupported kind %S" + (Path.to_string_maybe_quoted path) + (File_kind.to_string kind) + ]) + >>| Path.Set.union_all in - let files, empty_directories = recurse dir in - Dep.Set.of_source_files ~files ~empty_directories, files + fun lock_dir_path -> + let+ files = scan lock_dir_path in + Dep.Set.of_source_files ~files ~empty_directories:Path.Set.empty, files ;; -let setup_copy_rules ~dir:target ~assume_src_exists ~lock_dir = - let+ () = Memo.return () in - let deps, files = files lock_dir in +let setup_copy_rules ~dir:target ~lock_dir = + let+ deps, files = scan_lock_directory lock_dir in let directory_targets, rules = match Path.Set.is_empty files with | true -> Path.Build.Map.empty, Rules.empty | false -> - let deps = - match assume_src_exists with - | false -> deps - | true -> Dep.Set.empty - in let directory_targets = Path.Build.Map.singleton target Loc.none in let { Action_builder.With_targets.build; targets } = copy_lock_dir ~target ~lock_dir ~deps ~files @@ -499,7 +483,7 @@ let setup_lock_rules_with_source (workspace : Workspace.t) ~dir ~lock_dir = match source with | `Source_tree lock_dir -> let dir = Path.Build.append_source dir lock_dir in - setup_copy_rules ~assume_src_exists:false ~dir ~lock_dir:(Path.source lock_dir) + setup_copy_rules ~dir ~lock_dir:(Path.source lock_dir) | `Generated -> Memo.return (setup_lock_rules ~dir ~lock_dir) ;; @@ -508,9 +492,7 @@ let setup_dev_tool_lock_rules ~dir dev_tool = let dev_tool_name = Dune_lang.Package_name.to_string package_name in let dir = Path.Build.relative dir dev_tool_name in let lock_dir = dev_tool |> Lock_dir.dev_tool_external_lock_dir |> Path.external_ in - (* dev tool lock files are created in _build outside of the build system - so we have to tell the build system not to try to create them *) - setup_copy_rules ~dir ~assume_src_exists:true ~lock_dir + setup_copy_rules ~dir ~lock_dir ;; let setup_rules ~components ~dir =