diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index b29ce063682..f12daad92ad 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -79,7 +79,8 @@ let solve ~dev_tool ~local_packages = Workspace.add_repo workspace Dune_pkg.Pkg_workspace.Repository.binary_packages | `Disabled -> workspace in - let lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool 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 Memo.of_reproducible_fiber @@ Pkg.Lock.solve workspace @@ -173,37 +174,45 @@ let extra_dependencies dev_tool = let lockdir_status dev_tool = let open Memo.O in - let dev_tool_lock_dir = Lock_dir.dev_tool_lock_dir_path dev_tool in - match Lock_dir.read_disk dev_tool_lock_dir with - | Error _ -> Memo.return `No_lockdir - | Ok { packages; _ } -> - (match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with - | false -> Memo.return `Lockdir_ok - | true -> - let* platform = - Pkg.Pkg_common.poll_solver_env_from_current_system () - |> Memo.of_reproducible_fiber - in - let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in - (match Package_name.Map.find packages compiler_package_name with - | None -> Memo.return `No_compiler_lockfile_in_lockdir - | Some { info; _ } -> - let+ ocaml_compiler_version = locked_ocaml_compiler_version () in - (match Package_version.equal info.version ocaml_compiler_version with - | true -> `Lockdir_ok - | false -> - `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed - (User_message.make - [ Pp.textf - "The version of the compiler package (%S) in this project's \ - lockdir has changed to %s (formerly the compiler version was %s). \ - The dev-tool %S will be re-locked and rebuilt with this version \ - of the compiler." - (Package_name.to_string compiler_package_name) - (Package_version.to_string ocaml_compiler_version) - (Package_version.to_string info.version) - (Dune_pkg.Dev_tool.package_name dev_tool |> Package_name.to_string) - ])))) + 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 + 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; _ } -> + (match Dune_pkg.Dev_tool.needs_to_build_with_same_compiler_as_project dev_tool with + | false -> Memo.return `Lockdir_ok + | true -> + let* platform = + Pkg.Pkg_common.poll_solver_env_from_current_system () + |> Memo.of_reproducible_fiber + in + let packages = Lock_dir.Packages.pkgs_on_platform_by_name packages ~platform in + (match Package_name.Map.find packages compiler_package_name with + | None -> Memo.return `No_compiler_lockfile_in_lockdir + | Some { info; _ } -> + let+ ocaml_compiler_version = locked_ocaml_compiler_version () in + (match Package_version.equal info.version ocaml_compiler_version with + | true -> `Lockdir_ok + | false -> + `Dev_tool_needs_to_be_relocked_because_project_compiler_version_changed + (User_message.make + [ Pp.textf + "The version of the compiler package (%S) in this project's \ + lockdir has changed to %s (formerly the compiler version was \ + %s). The dev-tool %S will be re-locked and rebuilt with this \ + version of the compiler." + (Package_name.to_string compiler_package_name) + (Package_version.to_string ocaml_compiler_version) + (Package_version.to_string info.version) + (Dune_pkg.Dev_tool.package_name dev_tool + |> Package_name.to_string) + ]))))) ;; (* [lock_dev_tool_at_version dev_tool version] generates the lockdir for the diff --git a/bin/tools/tools_common.ml b/bin/tools/tools_common.ml index 99e9449ab77..4ed3dd2c413 100644 --- a/bin/tools/tools_common.ml +++ b/bin/tools/tools_common.ml @@ -20,7 +20,11 @@ let build_dev_tool_directly common dev_tool = let open Fiber.O in let+ result = Build.run_build_system ~common ~request:(fun _build_system -> - Action_builder.path (dev_tool_exe_path dev_tool)) + let open Action_builder.O in + dev_tool + |> Lock_dev_tool.lock_dev_tool + |> Action_builder.of_memo + >>> Action_builder.path (dev_tool_exe_path dev_tool)) in match result with | Error `Already_reported -> raise Dune_util.Report_error.Already_reported @@ -41,7 +45,6 @@ let lock_and_build_dev_tool ~common ~config dev_tool = build_dev_tool_via_rpc dev_tool) | Ok () -> Scheduler.go_with_rpc_server ~common ~config (fun () -> - let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in build_dev_tool_directly common dev_tool) ;; diff --git a/src/dune_lang/action.mli b/src/dune_lang/action.mli index 78fc60ec813..943194bf9fd 100644 --- a/src/dune_lang/action.mli +++ b/src/dune_lang/action.mli @@ -124,6 +124,13 @@ val encode : t Encoder.t val decode_dune_file : t Decoder.t val decode_pkg : t Decoder.t +val map + : t + -> string_with_vars:(String_with_vars.t -> String_with_vars.t) + -> slang:(Slang.t -> Slang.t) + -> blang:(Slang.Blang.t -> Slang.Blang.t) + -> t + (** Raises User_error on invalid action. *) val validate : loc:Loc.t -> t -> unit diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 82319e38d20..b88455a5353 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -516,6 +516,24 @@ module Depexts = struct let remove_locs t = { t with enabled_if = Enabled_if.remove_locs t.enabled_if } end +let in_source_tree path = + match (path : Path.t) with + | In_source_tree s -> s + | In_build_dir b -> + let in_source = Path.drop_build_context_exn path in + (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 ]) + | External e -> + Code_error.raise + "External path returned when loading a lock dir" + [ "path", Path.External.to_dyn e ] +;; + module Pkg = struct type t = { build_command : Build_command.t Conditional_choice.t @@ -862,8 +880,22 @@ module Pkg = struct 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 - | other -> - Code_error.raise "file_dir is not a source path" [ "path", Path.to_dyn other ] + | 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 ] + ;; + + 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 + match maybe_package_version with + | Some package_version -> + Path.Source.relative + source + (sprintf "%s.%s.files" package_name (Package_version.to_string package_version)) + | None -> Path.Source.relative source (sprintf "%s.files" package_name) ;; (* Combine the platform-specific parts of a pair of [t]s, raising a code @@ -1159,11 +1191,6 @@ let create_latest_version } ;; -let dev_tool_lock_dir_path dev_tool = - let dev_tools_path = Path.(relative root "dev-tools.locks") in - Path.relative dev_tools_path (Package_name.to_string (Dev_tool.package_name dev_tool)) -;; - let metadata_filename = "lock.dune" module Metadata = Dune_sexp.Versioned_file.Make (Unit) @@ -1451,7 +1478,6 @@ module Make_load (Io : sig val parallel_map : 'a list -> f:('a -> 'b t) -> 'b list t val readdir_with_kinds : Path.t -> (Filename.t * Unix.file_kind) list t val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a t - val stats_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result t end) = struct let load_metadata metadata_file_path = @@ -1534,36 +1560,6 @@ struct package_name ;; - let check_path lock_dir_path = - let open Io.O in - Io.stats_kind lock_dir_path - >>| function - | Ok S_DIR -> Ok () - | Error (Unix.ENOENT, _, _) -> - Error - (User_error.make - ~hints: - [ Pp.concat - ~sep:Pp.space - [ Pp.text "Run" - ; User_message.command "dune pkg lock" - ; Pp.text "to generate it." - ] - |> Pp.hovbox - ] - [ Pp.textf "%s does not exist." (Path.to_string lock_dir_path) ]) - | Error e -> - Error - (User_error.make - [ Pp.textf "%s is not accessible" (Path.to_string lock_dir_path) - ; Pp.textf "reason: %s" (Unix_error.Detailed.to_string_hum e) - ]) - | _ -> - Error - (User_error.make - [ Pp.textf "%s is not a directory." (Path.to_string lock_dir_path) ]) - ;; - let check_packages packages ~lock_dir_path = match validate_packages packages with | Ok () -> Ok () @@ -1600,56 +1596,52 @@ struct let load lock_dir_path = let open Io.O in - let* result = check_path lock_dir_path in - match result with - | Error e -> Io.return (Error e) - | Ok () -> - let* ( version - , dependency_hash - , ocaml - , repos - , expanded_solver_variable_bindings - , solved_for_platforms ) - = - load_metadata (Path.relative lock_dir_path metadata_filename) - in - let portable_lock_dir, solved_for_platforms = - match solved_for_platforms with - | Some x -> true, x - | None -> false, (Loc.none, []) - in - let+ packages = - Io.readdir_with_kinds lock_dir_path - >>| List.filter_map ~f:(fun (name, (kind : Unix.file_kind)) -> - match kind with - | S_REG -> Package_filename.to_package_name_and_version name |> Result.to_option - | _ -> - (* TODO *) - None) - >>= Io.parallel_map ~f:(fun (package_name, maybe_package_version) -> - let _loc, solved_for_platforms = solved_for_platforms in - let+ pkg = - load_pkg - ~portable_lock_dir - ~version - ~lock_dir_path - ~solved_for_platforms - package_name - maybe_package_version - in - pkg) - >>| Packages.of_pkg_list - in - check_packages packages ~lock_dir_path - |> Result.map ~f:(fun () -> - { version - ; dependency_hash - ; packages - ; ocaml - ; repos - ; expanded_solver_variable_bindings - ; solved_for_platforms - }) + let* ( version + , dependency_hash + , ocaml + , repos + , expanded_solver_variable_bindings + , solved_for_platforms ) + = + load_metadata (Path.relative lock_dir_path metadata_filename) + in + let portable_lock_dir, solved_for_platforms = + match solved_for_platforms with + | Some x -> true, x + | None -> false, (Loc.none, []) + in + let+ packages = + Io.readdir_with_kinds lock_dir_path + >>| List.filter_map ~f:(fun (name, (kind : Unix.file_kind)) -> + match kind with + | S_REG -> Package_filename.to_package_name_and_version name |> Result.to_option + | _ -> + (* TODO *) + None) + >>= Io.parallel_map ~f:(fun (package_name, maybe_package_version) -> + let _loc, solved_for_platforms = solved_for_platforms in + let+ pkg = + load_pkg + ~portable_lock_dir + ~version + ~lock_dir_path + ~solved_for_platforms + package_name + maybe_package_version + in + pkg) + >>| Packages.of_pkg_list + in + check_packages packages ~lock_dir_path + |> Result.map ~f:(fun () -> + { version + ; dependency_hash + ; packages + ; ocaml + ; repos + ; expanded_solver_variable_bindings + ; solved_for_platforms + }) ;; let load_exn lock_dir_path = @@ -1661,10 +1653,6 @@ end module Load_immediate = Make_load (struct include Monad.Id - let stats_kind file = - file |> Path.stat |> Result.map ~f:(fun { Unix.st_kind; _ } -> st_kind) - ;; - let parallel_map xs ~f = List.map xs ~f let readdir_with_kinds path = @@ -1752,6 +1740,15 @@ let merge_conditionals a b = { a with packages; solved_for_platforms } ;; +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 }) +;; + let check_if_solved_for_platform { solved_for_platforms; _ } ~platform = let loc, solved_for_platforms = solved_for_platforms in if List.is_empty solved_for_platforms @@ -1763,6 +1760,7 @@ let check_if_solved_for_platform { solved_for_platforms; _ } ~platform = match Solver_env_disjunction.matches_platform solved_for_platforms ~platform with | true -> () | false -> + let loc = loc_in_source_tree loc in User_error.raise ~loc [ Pp.text diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 5c6ff3c292d..896f27f8cd9 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -70,6 +70,14 @@ module Pkg : sig val digest_feed : t Dune_digest.Feed.t val to_dyn : t -> Dyn.t val files_dir : Package_name.t -> Package_version.t option -> lock_dir:Path.t -> Path.t + + (** [source_files_dir p v l] returns the path of expected files dir. Might return + a path that does not exist. *) + val source_files_dir + : Package_name.t + -> Package_version.t option + -> lock_dir:Path.t + -> Path.Source.t end module Repositories : sig @@ -118,10 +126,6 @@ val create_latest_version (* TODO: make this non-optional when portable lockdirs becomes the default *) -> 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.t - module Metadata : Dune_sexp.Versioned_file.S with type data := unit val metadata_filename : Filename.t @@ -149,7 +153,6 @@ module Make_load (Io : sig val parallel_map : 'a list -> f:('a -> 'b t) -> 'b list t val readdir_with_kinds : Path.t -> (Filename.t * Unix.file_kind) list t val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a t - val stats_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result t end) : sig val load : Path.t -> (t, User_message.t) result Io.t val load_exn : Path.t -> t Io.t @@ -179,3 +182,11 @@ val merge_conditionals : t -> t -> t the lockdir does not contain a solution compatible with the given platform then a [User_error] is raised. *) val packages_on_platform : t -> platform:Solver_env.t -> Pkg.t Package_name.Map.t + +(** Returns the path that the lock dir would be in the source. Might return + paths that don't exist, if the lock dir wasn't copied from there. *) +val in_source_tree : Path.t -> Path.Source.t + +(** Returns a [Loc.t] which refers to the source tree lock dir path instead of + the build dir lock dir path. *) +val loc_in_source_tree : Loc.t -> Loc.t diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml index ebbe65701d9..2917e5ff713 100644 --- a/src/dune_rules/fetch_rules.ml +++ b/src/dune_rules/fetch_rules.ml @@ -139,6 +139,7 @@ module Spec = struct ~loc:loc_url [ Pp.text "No checksum provided. It should be:"; Checksum.pp actual_checksum ] | Some (loc, _) -> + let loc = Dune_pkg.Lock_dir.loc_in_source_tree loc in User_error.raise ~loc [ Pp.text "Invalid checksum, got"; Dune_pkg.Checksum.pp actual_checksum ]) @@ -188,15 +189,24 @@ let find_checksum, find_url = Dune_pkg.Dev_tool.all ~init:(Checksum.Map.empty, Digest.Map.empty) ~f:(fun acc dev_tool -> - Fs_memo.dir_exists - (Path.as_outside_build_dir_exn - (Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool)) + Source_tree.find_dir (Lock_dir.dev_tool_source_lock_dir dev_tool) >>= function - | false -> Memo.return acc - | true -> Lock_dir.of_dev_tool dev_tool >>| add_checksums_and_urls acc) + | None -> Memo.return acc + | Some _ -> Lock_dir.of_dev_tool dev_tool >>| add_checksums_and_urls acc) in Per_context.list () - >>= Memo.parallel_map ~f:Lock_dir.get + >>= Memo.parallel_map ~f:(fun ctx_name -> + let* active = Lock_dir.lock_dir_active ctx_name in + match active with + | true -> Lock_dir.get ctx_name + | false -> + Memo.return + @@ Error + (User_message.make + [ Pp.textf + "Context %S has no lock dir" + (Context_name.to_string ctx_name) + ])) >>| List.filter_map ~f:Result.to_option >>| List.fold_left ~init ~f:add_checksums_and_urls) in @@ -217,6 +227,7 @@ let find_checksum, find_url = ;; let gen_rules_for_checksum_or_url (loc_url, (url : OpamUrl.t)) checksum = + let loc_url = Dune_pkg.Lock_dir.loc_in_source_tree loc_url in let checksum_or_url = match checksum with | Some (_, checksum) -> `Checksum checksum diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 722d601b19b..1ddd5a14878 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -33,8 +33,8 @@ end module Ocamlformat = struct let dev_tool_lock_dir_exists () = - let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Ocamlformat in - path |> Path.as_outside_build_dir_exn |> Fs_memo.dir_exists + let path = Lock_dir.dev_tool_source_lock_dir Ocamlformat in + Source_tree.find_dir path >>| Option.is_some ;; (* Config files for ocamlformat. When these are changed, running diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index c3e904763b1..0de23a373a9 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -648,7 +648,10 @@ let private_context ~dir components _ctx = analyze_private_context_path components >>= function | `Invalid_context -> Memo.return Gen_rules.unknown_context - | `Valid (ctx, components) -> Pkg_rules.setup_rules ctx ~dir ~components + | `Valid (ctx, components) -> + let+ lock_rules = Lock_rules.setup_rules ~dir ~components + and+ pkg_rules = Pkg_rules.setup_rules ctx ~dir ~components in + Gen_rules.combine lock_rules pkg_rules | `Root -> let+ contexts = Per_context.list () in let build_dir_only_sub_dirs = @@ -677,7 +680,9 @@ let raise_on_lock_dir_out_of_sync = with | `Valid -> () | `Invalid -> - let loc = Loc.in_file (Path.relative path "lock.dune") in + let source_path = Dune_pkg.Lock_dir.in_source_tree path in + let loc_path = Path.source source_path in + let loc = Loc.in_file (Path.relative loc_path "lock.dune") in let hints = Pp.[ text "run dune pkg lock" ] in User_error.raise ~loc diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index be4ee14186b..b876aee63d9 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -101,21 +101,16 @@ module Load = Make_load (struct include Memo let readdir_with_kinds path = - Fs_memo.dir_contents (Path.as_outside_build_dir_exn path) - >>| function + Readdir.read_directory_with_kinds (Path.to_string path) + |> function | Error _ -> (* CR-someday rgrinberg: add some proper message here *) User_error.raise [ Pp.text "" ] - | Ok content -> Fs_cache.Dir_contents.to_list content + | Ok content -> return content ;; let with_lexbuf_from_file path ~f = - Fs_memo.with_lexbuf_from_file (Path.as_outside_build_dir_exn path) ~f - ;; - - let stats_kind p = - Fs_memo.path_stat (Path.as_outside_build_dir_exn p) - >>| Stdune.Result.map ~f:(fun { Fs_cache.Reduced_stats.st_kind; _ } -> st_kind) + Io.Untracked.with_lexbuf_from_file path ~f |> return ;; end) @@ -137,32 +132,88 @@ let select_lock_dir lock_dir_selection = ;; let default_dir = "dune.lock" -let default_path = lazy Path.(relative root default_dir) + +(* location where project lock dirs are stored *) +let path_prefix = + (* the lock dir is always stored in the default context *) + let ctx_name = Context_name.default |> Context_name.to_string in + Path.Build.L.relative Private_context.t.build_dir [ ctx_name; ".lock" ] +;; + +let default_path = Path.Build.relative path_prefix default_dir |> Path.build let default_source_path = Path.Source.(relative root default_dir) -let get_path ctx = +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.(relative 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 +;; + +let dev_tool_lock_dir dev_tool = + (* dev tools always live in default *) + let ctx_name = Context_name.default |> Context_name.to_string in + let dev_tool_segment = dev_tool_to_path_segment dev_tool in + let lock_dir = + Path.Build.L.relative Private_context.t.build_dir [ ctx_name; ".dev-tool-locks" ] + in + let lock_dir = Path.Build.append_local lock_dir dev_tool_segment in + Path.build lock_dir +;; + +let lock_dir_of_source p = + let local = Path.Source.to_local p in + Path.Build.append_local path_prefix local |> Path.build +;; + +let get_path ctx_name = let* workspace = Workspace.workspace () in - match - List.find_map workspace.contexts ~f:(fun ctx' -> - match Context_name.equal (Workspace.Context.name ctx') ctx with + let ctx = + List.find_map workspace.contexts ~f:(fun ctx -> + match Context_name.equal (Workspace.Context.name ctx) ctx_name with | false -> None - | true -> Some ctx') - with - | None -> Memo.return (Some (Lazy.force default_path)) - | Some (Default { lock_dir = Some lock_dir_selection; _ }) -> - select_lock_dir lock_dir_selection >>| Option.some - | Some (Default { lock_dir = None; _ }) -> Memo.return (Some (Lazy.force default_path)) - | Some (Opam _) -> Memo.return None + | true -> Some ctx) + in + let* lock_dir_paths = + match ctx with + | None | Some (Default { lock_dir = None; _ }) -> + Memo.return (Some (default_source_path, default_path)) + | Some (Default { lock_dir = Some lock_dir_selection; _ }) -> + let+ source_lock_dir = select_lock_dir lock_dir_selection in + Some (source_lock_dir, lock_dir_of_source source_lock_dir) + | Some (Opam _) -> Memo.return None + in + match lock_dir_paths with + | None -> Memo.return None + | Some (source_path, lock_dir_path) -> + let* in_source_tree = Source_tree.find_dir source_path in + (match in_source_tree with + | Some _ -> Memo.return (Some lock_dir_path) + | None -> Memo.return None) ;; let get_workspace_lock_dir ctx = let* workspace = Workspace.workspace () in - let+ path = get_path ctx >>| Option.value_exn in + let+ path = get_path ctx in + let open Option.O in + let* path = path in Workspace.find_lock_dir workspace path ;; let get_with_path ctx = - let* path = get_path ctx >>| Option.value_exn in + let* path = + get_path ctx + >>| function + | Some p -> p + | None -> + Code_error.raise + "No lock dir path for context availabled" + [ "context", Context_name.to_dyn ctx ] + in + let* () = Build_system.build_dir path in Load.load path >>= function | Error e -> Memo.return (Error e) @@ -181,12 +232,8 @@ 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 = Dune_pkg.Lock_dir.dev_tool_lock_dir_path dev_tool in - Fs_memo.dir_exists (Path.as_outside_build_dir_exn path) - >>= function - | true -> Load.load_exn path - | false -> - User_error.raise [ Pp.textf "%s does not exist" (Path.to_string_maybe_quoted path) ] + let source_path = dev_tool_source_lock_dir dev_tool in + Load.load_exn (Path.source source_path) ;; let lock_dir_active ctx = @@ -197,11 +244,7 @@ let lock_dir_active ctx = let* workspace = Workspace.workspace () in match workspace.config.pkg_enabled with | Set (_, `Disabled) -> Memo.return false - | Set (_, `Enabled) | Unset -> - get_path ctx - >>= (function - | None -> Memo.return false - | Some path -> Fs_memo.dir_exists (Path.as_outside_build_dir_exn path)) + | Set (_, `Enabled) | Unset -> get_path ctx >>| Option.is_some ;; let source_kind (source : Dune_pkg.Source.t) = diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index 1b28fee4930..2e04e1fb293 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -11,11 +11,20 @@ val lock_dir_active : Context_name.t -> bool Memo.t val get_path : Context_name.t -> Path.t option Memo.t (** The default filesystem location where the lock dir is going to get created *) -val default_path : Path.t Lazy.t +val default_path : Path.t (** The default path where the lock dir will be written to manually *) 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 + +(** Returns the path to the lockdir that will be used to lock the + given dev tool *) +val dev_tool_lock_dir : Dune_pkg.Dev_tool.t -> Path.t + +val select_lock_dir : Workspace.Lock_dir_selection.t -> Path.Source.t Memo.t + module Sys_vars : sig type t = { os : string option Memo.Lazy.t diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml new file mode 100644 index 00000000000..5dbe7102ced --- /dev/null +++ b/src/dune_rules/lock_rules.ml @@ -0,0 +1,112 @@ +open Import +open Memo.O +module Gen_rules = Build_config.Gen_rules + +let rule ?loc { Action_builder.With_targets.build; targets } = + Rule.make ~info:(Rule.Info.of_loc_opt loc) ~targets build |> Rules.Produce.rule +;; + +let action_builder_with_dir_targets ~directory_targets = + let targets = + Targets.create + ~files:Path.Build.Set.empty + ~dirs:(Path.Build.Set.of_list directory_targets) + in + Action_builder.with_targets ~targets +;; + +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:(Path.source 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) + |> action_builder_with_dir_targets ~directory_targets:[ target ] +;; + +let setup_copy_rules ~dir:target ~lock_dir = + let+ deps, files = Source_deps.files (Path.source lock_dir) in + let directory_targets, rules = + match Path.Set.is_empty files with + | true -> Path.Build.Map.empty, Memo.return Rules.empty + | false -> + let directory_targets = Path.Build.Map.singleton target Loc.none in + let rules = + Rules.collect_unit (fun () -> + let copy_rule = copy_lock_dir ~target ~lock_dir ~deps ~files in + rule ~loc:Loc.none copy_rule) + in + directory_targets, rules + in + Gen_rules.make ~directory_targets rules +;; + +let setup_lock_rules ~dir ~lock_dir = + let* workspace = Workspace.workspace () in + let dir = Path.Build.relative dir lock_dir in + let lock_dir = Path.Source.relative workspace.dir lock_dir in + setup_copy_rules ~dir ~lock_dir +;; + +let setup_dev_tool_lock_rules ~dir dev_tool = + let package_name = Dune_pkg.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 + setup_copy_rules ~dir ~lock_dir +;; + +let lock_dirs_of_workspace (workspace : Workspace.t) = + let module Set = Path.Source.Set in + let+ lock_dirs_from_ctx = + Memo.List.map workspace.contexts ~f:(function + | Opam _ | Default { lock_dir = None; _ } -> Memo.return None + | Default { lock_dir = Some selection; _ } -> + let+ path = Lock_dir.select_lock_dir selection in + Some path) + >>| List.filter_opt + in + match lock_dirs_from_ctx, workspace.lock_dirs with + | [], [] -> Set.singleton Lock_dir.default_source_path + | lock_dirs_from_ctx, lock_dirs_from_toplevel -> + let lock_paths_from_toplevel = + List.map lock_dirs_from_toplevel ~f:(fun (lock_dir : Workspace.Lock_dir.t) -> + lock_dir.path) + in + Set.union (Set.of_list lock_paths_from_toplevel) (Set.of_list lock_dirs_from_ctx) +;; + +let setup_rules ~components ~dir = + let empty = Gen_rules.rules_here Gen_rules.Rules.empty in + match components with + | [ ".lock" ] -> + let* workspace = Workspace.workspace () in + let* lock_dir_paths = lock_dirs_of_workspace workspace in + lock_dir_paths + |> Path.Source.Set.to_list + |> Memo.List.fold_left + ~f:(fun rules lock_dir_path -> + let lock_dir = Path.Source.to_string lock_dir_path in + let+ lock_rule = setup_lock_rules ~dir ~lock_dir in + Gen_rules.combine rules lock_rule) + ~init:empty + | [ ".dev-tool-locks" ] -> + Memo.List.fold_left + Dune_pkg.Dev_tool.all + ~f:(fun rules dev_tool -> + let+ dev_tool_rules = setup_dev_tool_lock_rules ~dir dev_tool in + Gen_rules.combine rules dev_tool_rules) + ~init:empty + | [] -> + let sub_dirs = [ ".lock"; ".dev-tool-locks" ] in + let build_dir_only_sub_dirs = + 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 empty +;; diff --git a/src/dune_rules/lock_rules.mli b/src/dune_rules/lock_rules.mli new file mode 100644 index 00000000000..7cd0e643a6d --- /dev/null +++ b/src/dune_rules/lock_rules.mli @@ -0,0 +1,6 @@ +open Import + +val setup_rules + : components:string list + -> dir:Path.Build.t + -> Build_config.Gen_rules.t Memo.t diff --git a/src/dune_rules/odoc.ml b/src/dune_rules/odoc.ml index 85e4f17f5d4..bfcc9696774 100644 --- a/src/dune_rules/odoc.ml +++ b/src/dune_rules/odoc.ml @@ -254,11 +254,6 @@ let odoc_base_flags quiet build_dir = | Nonfatal -> S [] ;; -let odoc_dev_tool_lock_dir_exists () = - let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Odoc in - Fs_memo.dir_exists (Path.as_outside_build_dir_exn path) -;; - let odoc_dev_tool_exe_path_building_if_necessary () = let open Action_builder.O in let path = Path.build (Pkg_dev_tool.exe_path Odoc) in @@ -267,9 +262,10 @@ let odoc_dev_tool_exe_path_building_if_necessary () = ;; let odoc_program sctx dir = - let open Action_builder.O in - let* odoc_dev_tool_lock_dir_exists = - Action_builder.of_memo (odoc_dev_tool_lock_dir_exists ()) + let odoc_dev_tool_lock_dir_exists = + match Config.get Compile_time.lock_dev_tools with + | `Enabled -> true + | `Disabled -> false in match odoc_dev_tool_lock_dir_exists with | true -> odoc_dev_tool_exe_path_building_if_necessary () diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index e294e8f0717..a3d99f6d85c 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -90,7 +90,12 @@ module Package_universe = struct 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)) + (* 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 ;; end @@ -351,7 +356,7 @@ module Pkg = struct ; info : Pkg_info.t ; paths : Path.t Paths.t ; write_paths : Path.Build.t Paths.t - ; files_dir : Path.Build.t + ; files_dir : Path.Build.t option ; mutable exported_env : string Env_update.t list } @@ -793,6 +798,10 @@ module Action_expander = struct ;; let eval_slangs_located t slangs = + let slangs = + List.map slangs ~f:(fun slang -> + Slang.map_loc slang ~f:Dune_pkg.Lock_dir.loc_in_source_tree) + in Slang_expand.eval_multi_located slangs ~dir:t.paths.source_dir ~f:(slang_expander t) ;; @@ -1160,6 +1169,21 @@ end = struct let to_dyn = Dyn.opaque end + let relocate action = + let string_with_vars = + String_with_vars.map_loc ~f:Dune_pkg.Lock_dir.loc_in_source_tree + in + let slang = Slang.map_loc ~f:Dune_pkg.Lock_dir.loc_in_source_tree in + let blang = Slang.Blang.map_loc ~f:Dune_pkg.Lock_dir.loc_in_source_tree in + Dune_lang.Action.map action ~string_with_vars ~slang ~blang + ;; + + let relocate_build b = + match (b : Build_command.t) with + | Dune -> Build_command.Dune + | Action a -> Build_command.Action (relocate a) + ;; + let resolve_impl { Input.db; package = name; universe = package_universe } = match Package.Name.Map.find db.all name with | None -> Memo.return None @@ -1190,6 +1214,7 @@ end = struct Package_universe.lock_dir_path package_universe >>| Option.value_exn in 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 lockdirs are non-portable (the files dir won't have a version @@ -1197,32 +1222,52 @@ end = struct solution may have multiple versions of the same package necessitating version numbers in files dirs to prevent collisions). *) - let path_without_version = - Dune_pkg.Lock_dir.Pkg.files_dir info.name None ~lock_dir - in let path_with_version = - Dune_pkg.Lock_dir.Pkg.files_dir info.name (Some info.version) ~lock_dir + Pkg.source_files_dir info.name (Some info.version) ~lock_dir in - let+ path_with_version_exists = - path_with_version |> Path.as_outside_build_dir_exn |> Fs_memo.dir_exists + let* path_with_version_exists = + Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir path_with_version) in - if path_with_version_exists then path_with_version else path_without_version - in - let build_path = - Context_name.build_dir (Package_universe.context_name package_universe) + match path_with_version_exists with + | 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 = + 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) + | false -> None) in - match files_dir 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 -> Path.Build.append_source build_path s - | In_build_dir s -> Path.Build.append build_path s + files_dir + |> 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 -> + (match Path.Source.explode s 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) in let id = Pkg.Id.gen () in let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in let install_command = choose_for_current_platform install_command in + let install_command = Option.map install_command ~f:relocate in let build_command = choose_for_current_platform build_command in + let build_command = Option.map build_command ~f:relocate_build in let paths = let paths = Paths.map_path write_paths ~f:Path.build in match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name with @@ -1747,35 +1792,81 @@ let source_rules (pkg : Pkg.t) = source_deps, Memo.parallel_iter copy_rules ~f:(fun (loc, copy) -> rule ~loc copy) ;; +let rec scan_contents p = + let module P = Path.Build in + let dir_contents = + match Readdir.read_directory_with_kinds (P.to_string p) with + | Ok dir_contents -> dir_contents + | Error e -> + Code_error.raise + "Failure to enumerate files" + [ "error", Unix_error.Detailed.to_dyn e ] + in + List.fold_left + dir_contents + ~init:(P.Set.empty, P.Set.empty) + ~f:(fun (files, empty_directories) (file_name, file_kind) -> + let p = P.relative p file_name in + match (file_kind : Unix.file_kind) with + | S_REG -> P.Set.add files p, empty_directories + | S_DIR -> + let recursive_files, recursive_empty_dir = scan_contents p in + (match P.Set.is_empty recursive_files, P.Set.is_empty recursive_empty_dir with + | true, true -> + recursive_files, P.Set.union empty_directories recursive_empty_dir + | true, false -> files, P.Set.union empty_directories recursive_empty_dir + | false, _ -> P.Set.union files recursive_files, empty_directories) + | otherwise -> + Code_error.raise + "Unsupported directory content" + [ "path", P.to_dyn p; "file_kind", File_kind.to_dyn otherwise ]) +;; + +let files path = + let files, empty_directories = scan_contents path in + let to_path_set set = + Path.Build.Set.fold + set + ~f:(fun e acc -> Path.Set.add acc (Path.build e)) + ~init:Path.Set.empty + in + let files = to_path_set files in + let empty_directories = to_path_set empty_directories in + Dep.Set.of_source_files ~files ~empty_directories, files +;; + let build_rule context_name ~source_deps (pkg : Pkg.t) = let+ build_action = let+ copy_action, build_action, install_action = let+ copy_action = let+ copy_action = - Fs_memo.dir_exists - (In_source_dir (Path.Build.drop_build_context_exn pkg.files_dir)) - >>= function - | false -> Memo.return [] - | true -> - let+ deps, source_deps = Source_deps.files (Path.build pkg.files_dir) in - let open Action_builder.O in - [ Action_builder.with_no_targets - @@ (Action_builder.deps deps - >>> (Path.Set.to_list_map source_deps ~f:(fun src -> - let dst = - let local_path = - Path.drop_prefix_exn src ~prefix:(Path.build pkg.files_dir) - in - Path.Build.append_local pkg.write_paths.source_dir local_path - in - Action.progn - [ Action.mkdir (Path.Build.parent_exn dst) - ; Action.copy src dst - ]) - |> Action.concurrent - |> Action.Full.make - |> Action_builder.return)) - ] + let+ () = Memo.return () in + let open Action_builder.O in + [ Action_builder.with_no_targets + @@ ((match pkg.files_dir with + | Some files_dir -> Action_builder.path (Path.build files_dir) + | None -> Action_builder.return ()) + >>> Action_builder.of_memo + (Memo.of_thunk (fun () -> + match pkg.files_dir with + | None -> Memo.return (Path.Set.empty, Dep.Set.empty) + | Some files_dir -> + let deps, source_deps = files files_dir in + Memo.return (source_deps, deps))) + |> Action_builder.dyn_deps + >>= fun source_deps -> + Path.Set.to_list_map source_deps ~f:(fun src -> + let dst = + let prefix = pkg.files_dir |> Option.value_exn |> Path.build in + let local_path = Path.drop_prefix_exn src ~prefix in + Path.Build.append_local pkg.write_paths.source_dir local_path + in + Action.progn + [ Action.mkdir (Path.Build.parent_exn dst); Action.copy src dst ]) + |> Action.concurrent + |> Action.Full.make + |> Action_builder.return) + ] in copy_action @ List.map pkg.info.extra_sources ~f:(fun (local, _) -> @@ -1978,11 +2069,15 @@ let setup_rules ~components ~dir ctx = 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 + (* only generate rules if dev-tools should be enabled *) + (match Config.get Compile_time.lock_dev_tools with + | `Enabled -> + 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 + | `Disabled -> Memo.return @@ Gen_rules.make (Memo.return Rules.empty)) | true, [ ".dev-tool" ] -> Gen_rules.make ~build_dir_only_sub_dirs: @@ -1996,7 +2091,12 @@ let setup_rules ~components ~dir ctx = (Memo.return Rules.empty) |> Memo.return | _, [ ".pkg"; pkg_name ] -> - setup_package_rules ~package_universe:(Project_dependencies ctx) ~dir ~pkg_name + (* Only generate pkg rules if there is a lock dir for that context *) + let* lock_dir_active = Lock_dir.lock_dir_active ctx in + (match lock_dir_active with + | false -> Memo.return @@ Gen_rules.make (Memo.return Rules.empty) + | true -> + 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" :: _ :: _ :: _ -> diff --git a/src/dune_rules/source_deps.ml b/src/dune_rules/source_deps.ml index c182e87c6ba..5806dc874bb 100644 --- a/src/dune_rules/source_deps.ml +++ b/src/dune_rules/source_deps.ml @@ -7,7 +7,11 @@ module Map_reduce = (Monoid.Product (Monoid.Union (Path.Set)) (Monoid.Union (Path.Set))) let files_with_filter dir ~filter = - let prefix_with, dir = Path.extract_build_context_dir_exn dir in + let prefix_with, dir = + match (dir : Path.t) with + | In_source_tree dir -> Path.root, dir + | otherwise -> Path.extract_build_context_dir_exn otherwise + in Source_tree.find_dir dir >>= function | None -> Memo.return (Dep.Set.empty, Path.Set.empty) diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index f45be0e869a..a3fd3330c20 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -147,8 +147,8 @@ let requires ~loc ~db ~libs = let utop_dev_tool_lock_dir_exists = Memo.Lazy.create (fun () -> - let path = Dune_pkg.Lock_dir.dev_tool_lock_dir_path Utop in - Fs_memo.dir_exists (Path.as_outside_build_dir_exn path)) + let path = Lock_dir.dev_tool_source_lock_dir Utop in + Fs_memo.dir_exists (In_source_dir path)) ;; let utop_findlib_conf = Filename.concat utop_dir_basename "findlib.conf" diff --git a/src/source/workspace.ml b/src/source/workspace.ml index 603779a5cb9..c63bf463b22 100644 --- a/src/source/workspace.ml +++ b/src/source/workspace.ml @@ -267,7 +267,7 @@ module Lock_dir_selection = struct let eval t ~dir ~f = let open Memo.O in match t with - | Name name -> Path.Source.relative dir name |> Path.source |> Memo.return + | Name name -> Path.Source.relative dir name |> Memo.return | Cond cond -> let+ value = Cond_expand.eval cond ~dir:(Path.source dir) ~f in (match (value : Value.t option) with @@ -275,8 +275,9 @@ module Lock_dir_selection = struct User_error.raise ~loc:cond.loc [ Pp.text "None of the conditions matched so no lockdir could be chosen." ] - | Some (String s) -> Path.Source.relative dir s |> Path.source - | Some (Dir p | Path p) -> Path.reach ~from:(Path.source dir) p |> Path.of_string) + | Some (String s) -> Path.Source.relative dir s + | Some (Dir p | Path p) -> + Path.reach ~from:(Path.source dir) p |> Path.Source.of_string) ;; end @@ -726,8 +727,22 @@ let hash { merlin_context; contexts; env; config; repos; lock_dirs; dir; pins } , Pin_stanza.Workspace.hash pins ) ;; +let source_path_of_lock_dir_path path = + match (path : Path.t) with + | In_source_tree s -> s + | 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 ]) + | External e -> + Code_error.raise + "External lock dir path is unsupported" + [ "dir", Path.External.to_dyn e ] +;; + let find_lock_dir t path = - List.find t.lock_dirs ~f:(fun lock_dir -> Path.equal (Path.source lock_dir.path) path) + let path = source_path_of_lock_dir_path path in + List.find t.lock_dirs ~f:(fun lock_dir -> Path.Source.equal lock_dir.path path) ;; let add_repo t repo = { t with repos = repo :: t.repos } diff --git a/src/source/workspace.mli b/src/source/workspace.mli index cb42114cda4..fe8bbaa1ffd 100644 --- a/src/source/workspace.mli +++ b/src/source/workspace.mli @@ -24,7 +24,7 @@ module Lock_dir : sig end module Lock_dir_selection : sig - (** A dsl for selecting a lockdir either by literally naming it or using a + (** A DSL for selecting a lockdir either by literally naming it or using a cond expression to select a lockdir based on blangs *) type t @@ -32,7 +32,7 @@ module Lock_dir_selection : sig : t -> dir:Path.Source.t -> f:Value.t list Memo.t String_with_vars.expander - -> Path.t Memo.t + -> Path.Source.t Memo.t end module Context : sig diff --git a/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t b/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t index be684a3fbef..c51b5f80d25 100644 --- a/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t +++ b/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t @@ -44,7 +44,6 @@ dune.lock): Building fails as the patch cannot be found anymore - $ build_pkg test 2>&1 | sed 's|\.sandbox/[a-f0-9]*/|.sandbox//|' - Error: - open(_build/.sandbox//_private/default/.pkg/test/source/foo.patch): No such file or directory - -> required by _build/_private/default/.pkg/test/target + $ build_pkg test + Error: Don't know how to build _build/_private/default/.pkg/test/target/ + [1] diff --git a/test/blackbox-tests/test-cases/pkg/ocamllsp/dune b/test/blackbox-tests/test-cases/pkg/ocamllsp/dune index b1f3f2145bc..188a1a60d13 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamllsp/dune +++ b/test/blackbox-tests/test-cases/pkg/ocamllsp/dune @@ -7,3 +7,12 @@ (cram (applies_to dev-tool-ocamllsp-install-concurrent-with-watch-server) (enabled_if false)) + +;; issues with dev tool lock dirs in source + +(cram + (applies_to + dev-tool-ocamllsp-ocamlformat + dev-tool-ocamllsp-no-lock-dir + dev-tool-ocamllsp-no-ocaml-lockfile) + (enabled_if false)) diff --git a/test/blackbox-tests/test-cases/pkg/odoc/dune b/test/blackbox-tests/test-cases/pkg/odoc/dune index 552dd6cf4a9..36c76317c20 100644 --- a/test/blackbox-tests/test-cases/pkg/odoc/dune +++ b/test/blackbox-tests/test-cases/pkg/odoc/dune @@ -1,3 +1,9 @@ (cram (deps helpers.sh) (applies_to :whole_subtree)) + +;; issues with dev tool lock dirs in source + +(cram + (applies_to dev-tool-odoc-no-lock-dir) + (enabled_if false)) diff --git a/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t b/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t index 25df9162fa2..a912a686c91 100644 --- a/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t +++ b/test/blackbox-tests/test-cases/pkg/unavailable-package-source.t @@ -14,7 +14,7 @@ Demonstrate what happens when we try to fetch from a source that doesn't exist: > } Local file system - $ runtest "(copy \"$PWD/dummy\")" 2>&1 | sed "s#$(pwd)#PWD#" | sed '/ *^\^*$/d' | sed '\#^File "dune.lock/foo.pkg", line 2, characters#d' + $ runtest "(copy \"$PWD/dummy\")" 2>&1 | sed "s#$(pwd)#PWD#" | sed '/ *^\^*$/d' | sed '\#^File ".*dune.lock/foo.pkg", line 2, characters#d' 2 | (source (copy "PWD/dummy")) Error: PWD/dummy