diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index f415b4d86ba..28230fa093e 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -385,10 +385,15 @@ module Crawl = struct : (Descr.Item.t * Lib.Set.t) option Memo.t = let first_exe = snd (Nonempty_list.hd exes.names) in + let* scope = + Scope.DB.find_by_project (Super_context.context sctx |> Context.name) project + in let* modules_, obj_dir = Dir_contents.get sctx ~dir >>= Dir_contents.ocaml - >>| Ml_sources.modules_and_obj_dir ~for_:(Exe { first_exe }) + >>= Ml_sources.modules_and_obj_dir + ~libs:(Scope.libs scope) + ~for_:(Exe { first_exe }) in let* pp_map = let+ version = @@ -405,9 +410,6 @@ module Crawl = struct immediate_deps_of_module ~options ~obj_dir ~modules:modules_ module_ in let obj_dir = Obj_dir.of_local obj_dir in - let* scope = - Scope.DB.find_by_project (Super_context.context sctx |> Context.name) project - in let* modules_ = modules ~obj_dir ~deps_of modules_ in let+ requires = let* compile_info = Exe_rules.compile_info ~scope exes in @@ -449,9 +451,13 @@ module Crawl = struct | true -> (* XXX why do we have a second object directory? *) let* modules_, obj_dir_ = + let* libs = + Scope.DB.find_by_dir (Path.as_in_build_dir_exn src_dir) >>| Scope.libs + in Dir_contents.get sctx ~dir:(Path.as_in_build_dir_exn src_dir) >>= Dir_contents.ocaml - >>| Ml_sources.modules_and_obj_dir + >>= Ml_sources.modules_and_obj_dir + ~libs ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) in let* pp_map = diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index 2006b482d33..dfadeed3b7b 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -452,12 +452,13 @@ include Load let modules_of_local_lib sctx lib = let info = Lib.Local.info lib in - let* t = - let dir = Lib_info.src_dir info in - get sctx ~dir - in + let dir = Lib_info.src_dir info in + let* t = get sctx ~dir + and* libs = Scope.DB.find_by_dir dir >>| Scope.libs in ocaml t - >>| Ml_sources.modules ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) + >>= Ml_sources.modules + ~libs + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) ;; let modules_of_lib sctx lib = diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 6f55f0be483..875b00e131a 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -127,7 +127,7 @@ let executables_rules let* modules, obj_dir = let first_exe = first_exe exes in Dir_contents.ocaml dir_contents - >>| Ml_sources.modules_and_obj_dir ~for_:(Exe { first_exe }) + >>= Ml_sources.modules_and_obj_dir ~libs:(Scope.libs scope) ~for_:(Exe { first_exe }) in let* () = Check_rules.add_obj_dir sctx ~obj_dir (Ocaml Byte) in let ctx = Super_context.context sctx in diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 4375ca35d00..4ddf3d06f29 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -211,9 +211,9 @@ let define_all_alias ~dir ~project ~js_targets = let gen_rules_for_stanzas sctx dir_contents cctxs expander dune_file ~dir:ctx_dir = let src_dir = Dune_file.dir dune_file in - let* stanzas = Dune_file.stanzas dune_file in + let* stanzas = Dune_file.stanzas dune_file + and* scope = Scope.DB.find_by_dir ctx_dir in let* { For_stanza.merlin = merlins; cctx = cctxs; js = js_targets; source_dirs } = - let* scope = Scope.DB.find_by_dir ctx_dir in For_stanza.of_stanzas stanzas ~cctxs @@ -240,26 +240,27 @@ let gen_rules_for_stanzas sctx dir_contents cctxs expander dune_file ~dir:ctx_di | false -> Memo.return () | true -> let* ml_sources = Dir_contents.ocaml dir_contents in - (match - let base_path = - match Ml_sources.include_subdirs ml_sources with - | Include Unqualified | No -> [] - | Include Qualified -> - Path.Local.descendant - (Path.Build.local ctx_dir) - ~of_:(Path.Build.local (Dir_contents.dir dir_contents)) - |> Option.value_exn - |> Path.Local.explode - |> List.map ~f:Module_name.of_string - in - Menhir_rules.module_names m - |> List.find_map ~f:(fun name -> - let open Option.O in - let path = base_path @ [ name ] in - let* origin = Ml_sources.find_origin ml_sources path in - List.find_map cctxs ~f:(fun (loc, cctx) -> - Option.some_if (Loc.equal loc (Ml_sources.Origin.loc origin)) cctx)) - with + let base_path = + match Ml_sources.include_subdirs ml_sources with + | Include Unqualified | No -> [] + | Include Qualified -> + Path.Local.descendant + (Path.Build.local ctx_dir) + ~of_:(Path.Build.local (Dir_contents.dir dir_contents)) + |> Option.value_exn + |> Path.Local.explode + |> List.map ~f:Module_name.of_string + in + Menhir_rules.module_names m + |> Memo.List.find_map ~f:(fun name -> + let path = base_path @ [ name ] in + Ml_sources.find_origin ml_sources ~libs:(Scope.libs scope) path + >>| function + | None -> None + | Some origin -> + List.find_map cctxs ~f:(fun (loc, cctx) -> + Option.some_if (Loc.equal loc (Ml_sources.Origin.loc origin)) cctx)) + >>= (function | Some cctx -> Menhir_rules.gen_rules cctx m ~dir:ctx_dir | None -> (* This happens often when passing a [-p ...] option that hides a diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index e2770ab7497..43163066872 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -87,13 +87,14 @@ end = struct >>| List.singleton ;; - let lib_files ~dir_contents ~dir ~lib_config lib = + let lib_files ~scope ~dir_contents ~dir ~lib_config lib = let+ modules = - let+ ml_sources = Dir_contents.ocaml dir_contents in - Some - (Ml_sources.modules - ml_sources - ~for_:(Library (Lib_info.lib_id lib |> Lib_id.to_local_exn))) + let* ml_sources = Dir_contents.ocaml dir_contents in + Ml_sources.modules + ml_sources + ~libs:(Scope.libs scope) + ~for_:(Library (Lib_info.lib_id lib |> Lib_id.to_local_exn)) + >>| Option.some and+ foreign_archives = match Lib_info.virtual_ lib with | None -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -187,7 +188,8 @@ end = struct let* installable_modules = let+ modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules + >>= Ml_sources.modules + ~libs:(Scope.libs scope) ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and+ impl = Virtual_rules.impl sctx ~lib ~scope in Vimpl.impl_modules impl modules |> Modules.split_by_lib @@ -312,7 +314,7 @@ end = struct if Module.kind m = Virtual then [] else common m |> set_dir m) in modules_vlib @ modules_impl - and+ lib_files = lib_files ~dir ~dir_contents ~lib_config info + and+ lib_files = lib_files ~scope ~dir ~dir_contents ~lib_config info and+ execs = lib_ppxs ctx ~scope ~lib and+ dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info @@ -667,8 +669,10 @@ end = struct |> Foreign.Sources.object_files ~dir ~ext_obj |> List.map ~f:Path.build and* modules = + let* libs = Scope.DB.find_by_dir dir >>| Scope.libs in Dir_contents.ocaml dir_contents - >>| Ml_sources.modules + >>= Ml_sources.modules + ~libs ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and* melange_runtime_deps = file_deps (Lib_info.melange_runtime_deps info) and* public_headers = file_deps (Lib_info.public_headers info) in diff --git a/src/dune_rules/lib_id.ml b/src/dune_rules/lib_id.ml index dff03cb6a71..8c37b849ca8 100644 --- a/src/dune_rules/lib_id.ml +++ b/src/dune_rules/lib_id.ml @@ -33,6 +33,7 @@ module Local = struct include Comparable.Make (T) let make ~loc ~src_dir name = { name; loc; src_dir } + let name t = t.name let loc t = t.loc end @@ -69,11 +70,9 @@ let to_local_exn = function ;; let name = function - | Local { name; _ } -> name - | External (_, name) -> name + | Local { name; _ } | External (_, name) -> name ;; let loc = function - | Local { loc; _ } -> loc - | External (loc, _) -> loc + | Local { loc; _ } | External (loc, _) -> loc ;; diff --git a/src/dune_rules/lib_id.mli b/src/dune_rules/lib_id.mli index c8c0886e04d..c3897a21d62 100644 --- a/src/dune_rules/lib_id.mli +++ b/src/dune_rules/lib_id.mli @@ -8,6 +8,7 @@ module Local : sig val equal : t -> t -> bool val make : loc:Loc.t -> src_dir:Path.Source.t -> Lib_name.t -> t + val name : t -> Lib_name.t val loc : t -> Loc.t val to_dyn : t -> Dyn.t end diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index ce6774c3d5f..395455fc2b7 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -657,7 +657,8 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = let f () = let* source_modules = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules + >>= Ml_sources.modules + ~libs:(Scope.libs scope) ~for_: (Library (Lib_info.lib_id (Lib.Local.info local_lib) |> Lib_id.to_local_exn)) in diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 114b67da92f..d3c883621a6 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -266,7 +266,9 @@ let setup_emit_cmj_rules let f () = let* modules, obj_dir = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target }) + >>= Ml_sources.modules_and_obj_dir + ~libs:(Scope.libs scope) + ~for_:(Melange { target = mel.target }) in let* () = Check_rules.add_obj_dir sctx ~obj_dir Melange in let* modules, pp = @@ -426,7 +428,9 @@ let setup_runtime_assets_rules sctx ~dir ~target_dir ~mode ~output ~for_ mel = let modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope (mel : Melange_stanzas.Emit.t) = let* modules, obj_dir = Dir_contents.ocaml dir_contents - >>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target }) + >>= Ml_sources.modules_and_obj_dir + ~libs:(Scope.libs scope) + ~for_:(Melange { target = mel.target }) in let+ modules = modules_in_obj_dir ~sctx ~scope ~preprocess:mel.preprocess modules in let modules_for_js = diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index eedb18e6218..520f2f5c03f 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -28,14 +28,15 @@ module Origin = struct end module Modules = struct - type component = Modules.t * Path.Build.t Obj_dir.t + type component = Origin.t * Modules.t * Path.Build.t Obj_dir.t type t = { libraries : component Lib_id.Local.Map.t ; executables : component String.Map.t ; melange_emits : component String.Map.t ; (* Map from modules to the origin they are part of *) - rev_map : Origin.t Module_name.Path.Map.t + rev_map : (Origin.t * Path.Build.t) list Module_name.Path.Map.t + ; libraries_by_obj_dir : Lib_id.Local.t list Path.Build.Map.t } let empty = @@ -43,6 +44,7 @@ module Modules = struct ; executables = String.Map.empty ; melange_emits = String.Map.empty ; rev_map = Module_name.Path.Map.empty + ; libraries_by_obj_dir = Path.Build.Map.empty } ;; @@ -61,48 +63,33 @@ module Modules = struct } let make { libraries = libs; executables = exes; melange_emits = emits } = - let libraries = - let _, libraries = - List.fold_left - libs - ~init:(Lib_name.Set.empty, Lib_id.Local.Map.empty) - ~f:(fun (libname_set, acc) part -> - let stanza = part.stanza in - let name = - let src_dir = - Obj_dir.dir part.obj_dir - |> Path.build - |> Path.drop_optional_build_context_src_exn - in - Lib_id.name (Local (Library.to_lib_id ~src_dir stanza)) + let libraries, libraries_by_obj_dir = + List.fold_left + libs + ~init:(Lib_id.Local.Map.empty, Path.Build.Map.empty) + ~f:(fun (by_id, by_obj_dir) part -> + let origin : Origin.t = Library part.stanza in + let lib_id = + let src_dir = + Path.drop_optional_build_context_src_exn (Path.build part.dir) in - match Lib_name.Set.mem libname_set name with - | true -> - User_error.raise - ~loc:stanza.buildable.loc - [ Pp.textf - "Library %S appears for the second time in this directory" - (Lib_name.to_string name) - ] - | false -> - let acc = - let lib_id = - let src_dir = - Path.drop_optional_build_context_src_exn (Path.build part.dir) - in - Library.to_lib_id ~src_dir part.stanza - in - Lib_id.Local.Map.add_exn acc lib_id (part.modules, part.obj_dir) - in - Lib_name.Set.add libname_set name, acc) - in - libraries + Library.to_lib_id ~src_dir part.stanza + in + let by_id = + Lib_id.Local.Map.add_exn by_id lib_id (origin, part.modules, part.obj_dir) + and by_obj_dir = + Path.Build.Map.update by_obj_dir (Obj_dir.obj_dir part.obj_dir) ~f:(function + | None -> Some [ lib_id ] + | Some lib_ids -> Some (lib_id :: lib_ids)) + in + by_id, by_obj_dir) in let executables = match String.Map.of_list_map exes ~f:(fun (part : Executables.t group_part) -> let first_exe = snd (Nonempty_list.hd part.stanza.names) in - first_exe, (part.modules, part.obj_dir)) + let origin : Origin.t = Executables part.stanza in + first_exe, (origin, part.modules, part.obj_dir)) with | Ok x -> x | Error (name, _, part) -> @@ -113,7 +100,8 @@ module Modules = struct let melange_emits = match String.Map.of_list_map emits ~f:(fun part -> - part.stanza.target, (part.modules, part.obj_dir)) + let origin : Origin.t = Melange part.stanza in + part.stanza.target, (origin, part.modules, part.obj_dir)) with | Ok x -> x | Error (name, _, part) -> @@ -123,64 +111,28 @@ module Modules = struct in let rev_map = let modules = - let by_path (origin : Origin.t) trie = + let by_path (origin : Origin.t * Path.Build.t) trie = Module_trie.fold trie ~init:[] ~f:(fun (_loc, m) acc -> (Module.Source.path m, origin) :: acc) in List.concat [ List.concat_map libs ~f:(fun part -> - by_path (Library part.stanza) part.sources) + by_path (Library part.stanza, part.dir) part.sources) ; List.concat_map exes ~f:(fun part -> - by_path (Executables part.stanza) part.sources) + by_path (Executables part.stanza, part.dir) part.sources) ; List.concat_map emits ~f:(fun part -> - by_path (Melange part.stanza) part.sources) + by_path (Melange part.stanza, part.dir) part.sources) ] in - match Module_name.Path.Map.of_list modules with - | Ok x -> x - | Error (path, _, _) -> - let locs = - List.filter_map modules ~f:(fun (n, origin) -> - Option.some_if - (Ordering.is_eq (Module_name.Path.compare n path)) - (Origin.loc origin)) - |> List.sort ~compare:Loc.compare - in - let main_message = - Pp.textf - "Module %S is used in several stanzas:" - (Module_name.Path.to_string path) - in - let loc, related_locs = - match locs with - | [] -> - (* duplicates imply at least at one module with this location *) - assert false - | loc :: related_locs -> loc, related_locs - in - let annots = - let main = User_message.make ~loc [ main_message ] in - let related = - List.map related_locs ~f:(fun loc -> - User_message.make ~loc [ Pp.text "Used in this stanza" ]) - in - User_message.Annots.singleton - Compound_user_error.annot - [ Compound_user_error.make ~main ~related ] - in - User_error.raise - ~annots - ~loc:(Loc.drop_position loc) - [ main_message - ; Pp.enumerate locs ~f:(fun loc -> Pp.verbatim (Loc.to_file_colon_line loc)) - ; Pp.text - "To fix this error, you must specify an explicit \"modules\" field in \ - every library, executable, and executables stanzas in this dune file. \ - Note that each module cannot appear in more than one \"modules\" field - \ - it must belong to a single library or executable." - ] + List.fold_left + modules + ~init:Module_name.Path.Map.empty + ~f:(fun module_name_map (module_name, origin) -> + Module_name.Path.Map.update module_name_map module_name ~f:(function + | None -> Some [ origin ] + | Some origins -> Some (origin :: origins))) in - { libraries; executables; melange_emits; rev_map } + { libraries; executables; melange_emits; rev_map; libraries_by_obj_dir } ;; end @@ -257,14 +209,107 @@ let dyn_of_for_ = | Melange { target } -> variant "Melange" [ record [ "target", string target ] ] ;; -let modules_and_obj_dir t ~for_ = +let raise_module_conflict_error ~module_path origins = + let locs = List.map origins ~f:Origin.loc |> List.sort ~compare:Loc.compare in + let main_message = + Pp.textf + "Module %S is used in several stanzas:" + (Module_name.Path.to_string module_path) + in + let loc, related_locs = + match locs with + | [] -> + (* duplicates imply at least at one module with this location *) + assert false + | loc :: related_locs -> loc, related_locs + in + let annots = + let main = User_message.make ~loc [ main_message ] in + let related = + List.map related_locs ~f:(fun loc -> + User_message.make ~loc [ Pp.text "Used in this stanza" ]) + in + User_message.Annots.singleton + Compound_user_error.annot + [ Compound_user_error.make ~main ~related ] + in + User_error.raise + ~annots + ~loc:(Loc.drop_position loc) + [ main_message + ; Pp.enumerate locs ~f:(fun loc -> Pp.verbatim (Loc.to_file_colon_line loc)) + ; Pp.text + "To fix this error, you must specify an explicit \"modules\" field in every \ + library, executable, and executables stanzas in this dune file. Note that each \ + module cannot appear in more than one \"modules\" field - it must belong to a \ + single library or executable." + ] +;; + +let find_origin (t : t) ~libs path = + match Module_name.Path.Map.find t.modules.rev_map path with + | None | Some [] -> Memo.return None + | Some [ (origin, _) ] -> Memo.return (Some origin) + | Some origins -> + let* origins = + Memo.List.filter_map origins ~f:(fun (origin, dir) -> + match origin with + | Executables _ | Melange _ -> Memo.return (Some origin) + | Library lib -> + let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in + Lib.DB.available_by_lib_id libs (Local (Library.to_lib_id ~src_dir lib)) + >>| (function + | false -> None + | true -> Some origin)) + in + (match origins with + | [] -> Memo.return None + | [ origin ] -> Memo.return (Some origin) + | origins -> raise_module_conflict_error origins ~module_path:path) +;; + +let modules_and_obj_dir t ~libs ~for_ = match match for_ with | Library lib_id -> Lib_id.Local.Map.find t.modules.libraries lib_id | Exe { first_exe } -> String.Map.find t.modules.executables first_exe | Melange { target } -> String.Map.find t.modules.melange_emits target with - | Some s -> s + | Some (Library _, modules, obj_dir) -> + let* () = + Modules_group.fold_user_written modules ~init:[] ~f:(fun m acc -> + Module.path m :: acc) + |> Memo.List.iter ~f:(fun module_path -> + let+ (_origin : Origin.t option) = find_origin t ~libs module_path in + ()) + in + (match + Path.Build.Map.find_exn t.modules.libraries_by_obj_dir (Obj_dir.obj_dir obj_dir) + with + | [] | [ _ ] -> Memo.return (modules, obj_dir) + | lib_ids -> + let+ lib_ids = + Memo.List.filter lib_ids ~f:(fun lib_id -> + Lib.DB.available_by_lib_id libs (Local lib_id)) + in + (match lib_ids with + | [] | [ _ ] -> modules, obj_dir + | lib_ids -> + let lib_id = + let lib_ids = + List.sort lib_ids ~compare:(fun a b -> + Loc.compare (Lib_id.Local.loc a) (Lib_id.Local.loc b)) + in + (* Get the 2nd loc *) + lib_ids |> List.tl |> List.hd + in + User_error.raise + ~loc:(Lib_id.Local.loc lib_id) + [ Pp.textf + "Library %S appears for the second time in this directory" + (Lib_name.to_string (Lib_id.Local.name lib_id)) + ])) + | Some (_, modules, obj_dir) -> Memo.return (modules, obj_dir) | None -> let map = match for_ with @@ -278,18 +323,17 @@ let modules_and_obj_dir t ~for_ = [ "keys", map; "for_", dyn_of_for_ for_ ] ;; -let modules t ~for_ = modules_and_obj_dir t ~for_ |> fst -let find_origin (t : t) path = Module_name.Path.Map.find t.modules.rev_map path +let modules t ~libs ~for_ = modules_and_obj_dir t ~libs ~for_ >>| fst -let virtual_modules ~lookup_vlib vlib = +let virtual_modules ~lookup_vlib ~libs vlib = let info = Lib.info vlib in let+ modules = match Option.value_exn (Lib_info.virtual_ info) with | External modules -> Memo.return modules | Local -> let src_dir = Lib_info.src_dir info |> Path.as_in_build_dir_exn in - let+ t = lookup_vlib ~dir:src_dir in - modules t ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) + let* t = lookup_vlib ~dir:src_dir in + modules t ~libs ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) in let existing_virtual_modules = Modules_group.virtual_module_names modules in let allow_new_public_modules = @@ -337,8 +381,8 @@ let make_lib_modules | Some _ -> assert (Option.is_none lib.virtual_modules); let open Memo.O in + let* libs = libs in let* resolved = - let* libs = libs in let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in Lib.DB.find_lib_id_even_when_hidden libs (Local (Library.to_lib_id ~src_dir lib)) (* can't happen because this library is defined using the current @@ -352,7 +396,7 @@ let make_lib_modules let* main_module_name = Lib.main_module_name resolved in let+ impl = let* vlib = Lib.implements resolved |> Option.value_exn in - virtual_modules ~lookup_vlib vlib |> Resolve.Memo.lift_memo + virtual_modules ~lookup_vlib ~libs vlib |> Resolve.Memo.lift_memo in let kind : Modules_field_evaluator.kind = Implementation impl in kind, main_module_name, wrapped diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index 9bdf9bcc963..5a5e4b8448e 100644 --- a/src/dune_rules/ml_sources.mli +++ b/src/dune_rules/ml_sources.mli @@ -27,13 +27,17 @@ type for_ = } | Melange of { target : string } -val modules_and_obj_dir : t -> for_:for_ -> Modules.t * Path.Build.t Obj_dir.t +val modules_and_obj_dir + : t + -> libs:Lib.DB.t + -> for_:for_ + -> (Modules.t * Path.Build.t Obj_dir.t) Memo.t (** Modules attached to a library, executable, or melange.emit stanza.*) -val modules : t -> for_:for_ -> Modules.t +val modules : t -> libs:Lib.DB.t -> for_:for_ -> Modules.t Memo.t (** Find out the origin of the stanza for a given module *) -val find_origin : t -> Module_name.Path.t -> Origin.t option +val find_origin : t -> libs:Lib.DB.t -> Module_name.Path.t -> Origin.t option Memo.t val empty : t diff --git a/src/dune_rules/top_module.ml b/src/dune_rules/top_module.ml index 2eab0d5f4e6..cbb05a5e293 100644 --- a/src/dune_rules/top_module.ml +++ b/src/dune_rules/top_module.ml @@ -31,12 +31,13 @@ let find_module sctx src = | None -> Memo.return None | Some module_name -> let* dir_contents = drop_rules @@ fun () -> Dir_contents.get sctx ~dir in - let* ocaml = Dir_contents.ocaml dir_contents in - (match Ml_sources.find_origin ocaml [ module_name ] with + let* ocaml = Dir_contents.ocaml dir_contents + and* scope = Scope.DB.find_by_dir dir in + Ml_sources.find_origin ocaml ~libs:(Scope.libs scope) [ module_name ] + >>= (function | None -> Memo.return None | Some origin -> - let* scope = Scope.DB.find_by_dir dir - and* expander = Super_context.expander sctx ~dir in + let* expander = Super_context.expander sctx ~dir in let+ cctx, merlin = drop_rules @@ fun () -> diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 6f5bb0164ee..986ba0342be 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -103,19 +103,20 @@ let impl sctx ~(lib : Library.t) ~scope = in let* ocaml = Context.ocaml (Super_context.context sctx) in let* modules = + let db = Scope.libs scope in let* preprocess = (* TODO wrong, this should be delayed *) Resolve.Memo.read_memo (Preprocess.Per_module.with_instrumentation lib.buildable.preprocess - ~instrumentation_backend: - (Lib.DB.instrumentation_backend (Scope.libs scope))) + ~instrumentation_backend:(Lib.DB.instrumentation_backend db)) in let pp_spec = Staged.unstage (Pp_spec.pped_modules_map preprocess ocaml.version) in Dir_contents.ocaml dir_contents - >>| Ml_sources.modules + >>= Ml_sources.modules + ~libs:db ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) >>= Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) in diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-optional.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-optional.t new file mode 100644 index 00000000000..b767969d8b3 --- /dev/null +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-optional.t @@ -0,0 +1,46 @@ +Private libraries using the same library name, in the same context, defined in +the same folder. One of them is unavailable because it's `(optional)` and a +dependency is missing. + + $ cat > dune-project << EOF + > (lang dune 3.13) + > EOF + + $ cat > dune << EOF + > (library + > (name foo) + > (libraries xxx) + > (optional)) + > (library + > (name foo)) + > EOF + $ cat > foo.ml << EOF + > let x = "hello" + > EOF + +Without any consumers of the libraries + + $ dune build + +With some consumer of the library + + $ cat > dune << EOF + > (library + > (name foo) + > (modules foo) + > (libraries xxx) + > (optional)) + > (library + > (modules foo) + > (name foo)) + > (executable + > (name main) + > (modules main) + > (libraries foo)) + > EOF + + $ cat > main.ml < let () = print_endline Foo.x + > EOF + + $ dune build diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t index a87fe1be546..9c96a8601c7 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t @@ -7,17 +7,19 @@ the same folder. $ cat > dune << EOF > (library - > (name foo)) + > (name foo) + > (modules)) > (library - > (name foo)) + > (name foo) + > (modules)) > EOF Without any consumers of the libraries $ dune build - File "dune", lines 3-4, characters 0-21: - 3 | (library - 4 | (name foo)) + File "dune", line 5, characters 7-10: + 5 | (name foo) + ^^^ Error: Library "foo" appears for the second time in this directory [1] @@ -25,11 +27,14 @@ With some consumer of the library $ cat > dune << EOF > (library - > (name foo)) + > (name foo) + > (modules)) > (library - > (name foo)) + > (name foo) + > (modules)) > (executable > (name main) + > (modules main) > (libraries foo)) > EOF @@ -38,8 +43,8 @@ With some consumer of the library > EOF $ dune build - File "dune", lines 3-4, characters 0-21: - 3 | (library - 4 | (name foo)) + File "dune", line 5, characters 7-10: + 5 | (name foo) + ^^^ Error: Library "foo" appears for the second time in this directory [1] diff --git a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t index c458f346029..c95cc7b7bd4 100644 --- a/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t +++ b/test/blackbox-tests/test-cases/lib-collision/lib-collision-public-same-folder.t @@ -19,10 +19,9 @@ the same folder. Without any consumers of the libraries $ dune build - File "dune", lines 4-6, characters 0-44: - 4 | (library + File "dune", line 5, characters 7-10: 5 | (name foo) - 6 | (public_name baz.foo)) + ^^^ Error: Library "foo" appears for the second time in this directory [1] @@ -31,12 +30,15 @@ With some consumer $ cat > dune << EOF > (library > (name foo) + > (modules) > (public_name bar.foo)) > (library > (name foo) + > (modules) > (public_name baz.foo)) > (executable > (name main) + > (modules main) > (libraries foo)) > EOF @@ -45,9 +47,8 @@ With some consumer > EOF $ dune build - File "dune", lines 4-6, characters 0-44: - 4 | (library - 5 | (name foo) - 6 | (public_name baz.foo)) + File "dune", line 6, characters 7-10: + 6 | (name foo) + ^^^ Error: Library "foo" appears for the second time in this directory [1]