fix(ml-sources): check that a library is available before tracking it (…

…#10355) Since #10307, dune started allowing libraries to share the same name. Thus, checking `enabled_if` isn't enough for libraries; dune now needs to check whether the library is available before tracking it in ml_sources Signed-off-by: Antonio Nuno Monteiro <[email protected]>
ocaml · Apr 15, 2024 · 2a0d4e8 · 2a0d4e8
1 parent e99053b
commit 2a0d4e8
Show file tree

Hide file tree

Showing 16 changed files with 291 additions and 172 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 =