Detect when a module is used by several stanzas (#532)

- print a warning
- don't generate several rules for the .d files
- Added tests for multiple rules for .ml.d

src/exe.ml

@@ -115,6 +115,7 @@ let build_and_link_many
       ~loc ~dir ~programs ~modules
       ~scope
       ~linkages
+      ?modules_partitioner
       ?(libraries=[])
       ?(flags=Ocaml_flags.empty)
       ?link_flags
@@ -141,10 +142,17 @@ let build_and_link_many
       ~lint
       ~lib_name:None
   in
+  let already_used =
+    match modules_partitioner with
+    | None -> String_set.empty
+    | Some mp ->
+      Modules_partitioner.acknowledge mp
+        ~loc ~modules
+  in
 
   let dep_graphs =
-    Ocamldep.rules sctx ~dir ~modules ~alias_module:None
-      ~lib_interface_module:None
+    Ocamldep.rules sctx ~dir ~modules ~already_used
+      ~alias_module:None ~lib_interface_module:None
   in
 
   let requires, real_requires =

src/exe.mli

@@ -44,6 +44,7 @@ val build_and_link
   -> modules:Module.t String_map.t
   -> scope:Scope.t
   -> linkages:Linkage.t list
+  -> ?modules_partitioner:Modules_partitioner.t
   -> ?libraries:Jbuild.Lib_deps.t
   -> ?flags:Ocaml_flags.t
   -> ?link_flags:(unit, string list) Build.t
@@ -62,6 +63,7 @@ val build_and_link_many
   -> modules:Module.t String_map.t
   -> scope:Scope.t
   -> linkages:Linkage.t list
+  -> ?modules_partitioner:Modules_partitioner.t
   -> ?libraries:Jbuild.Lib_deps.t
   -> ?flags:Ocaml_flags.t
   -> ?link_flags:(unit, string list) Build.t

src/gen_rules.ml

@@ -493,12 +493,17 @@ module Gen(P : Params) = struct
      it references are built after. *)
   let alias_module_build_sandbox = ctx.version < (4, 03, 0)
 
-  let library_rules (lib : Library.t) ~dir ~files ~scope =
+  let library_rules (lib : Library.t) ~modules_partitioner ~dir ~files ~scope =
     let obj_dir = Utils.library_object_directory ~dir lib.name in
     let dep_kind = if lib.optional then Build.Optional else Required in
     let flags = Ocaml_flags.make lib.buildable sctx ~scope ~dir in
     let { modules; main_module_name; alias_module } = modules_by_lib ~dir lib in
-    (* Preprocess before adding the alias module as it doesn't need preprocessing *)
+    let already_used =
+      Modules_partitioner.acknowledge modules_partitioner
+        ~loc:lib.buildable.loc ~modules
+    in
+  (* Preprocess before adding the alias module as it doesn't need
+     preprocessing *)
     let modules =
       SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
         ~preprocess:lib.buildable.preprocess
@@ -516,7 +521,7 @@ module Gen(P : Params) = struct
     in
 
     let dep_graphs =
-      Ocamldep.rules sctx ~dir ~modules ~alias_module
+      Ocamldep.rules sctx ~dir ~modules ~already_used ~alias_module
         ~lib_interface_module:(if lib.wrapped then
                                  String_map.find main_module_name modules
                                else
@@ -719,7 +724,8 @@ module Gen(P : Params) = struct
      | Executables stuff                                               |
      +-----------------------------------------------------------------+ *)
 
-  let executables_rules (exes : Executables.t) ~dir ~all_modules ~scope =
+  let executables_rules ~dir ~all_modules
+        ?modules_partitioner ~scope (exes : Executables.t) =
     let modules =
       parse_modules ~all_modules ~buildable:exes.buildable
     in
@@ -764,6 +770,7 @@ module Gen(P : Params) = struct
         ~dir
         ~programs
         ~modules
+        ?modules_partitioner
         ~scope
         ~linkages
         ~libraries:exes.buildable.libraries
@@ -828,13 +835,17 @@ module Gen(P : Params) = struct
     (* This interprets "rule" and "copy_files" stanzas. *)
     let files = text_files ~dir:ctx_dir in
     let all_modules = modules_by_dir ~dir:ctx_dir in
+    let modules_partitioner =
+      Modules_partitioner.create ~dir:src_dir ~all_modules
+    in
     List.filter_map stanzas ~f:(fun stanza ->
       let dir = ctx_dir in
       match (stanza : Stanza.t) with
       | Library lib ->
-        Some (library_rules lib ~dir ~files ~scope)
+        Some (library_rules lib ~dir ~files ~scope ~modules_partitioner)
       | Executables exes ->
-        Some (executables_rules exes ~dir ~all_modules ~scope)
+        Some (executables_rules exes ~dir ~all_modules ~scope
+                ~modules_partitioner)
       | Alias alias ->
         alias_rules alias ~dir ~scope;
         None
@@ -861,9 +872,12 @@ module Gen(P : Params) = struct
     |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
     Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
       let dir = Utop.utop_exe_dir ~dir:ctx_dir in
-      let merlin = executables_rules exe ~dir ~all_modules ~scope in
+      let merlin =
+        executables_rules exe ~dir ~all_modules ~scope
+      in
       Utop.add_module_rules sctx ~dir merlin.requires;
-    )
+    );
+    Modules_partitioner.emit_warnings modules_partitioner
 
   (* +-----------------------------------------------------------------+
      | META                                                            |

src/import.ml

@@ -595,6 +595,18 @@ module No_io = struct
 end
 
 module Fmt = struct
+  (* CR-someday diml: we should define a GADT for this:
+
+     {[
+       type 'a t =
+         | Int : int t
+         | Box : ...
+         | Colored : ...
+     ]}
+
+     This way we could separate the creation of messages from the
+     actual rendering.
+  *)
   type 'a t = Format.formatter -> 'a -> unit
 
   let kstrf f fmt =
@@ -603,6 +615,11 @@ module Fmt = struct
     Format.kfprintf f (Format.formatter_of_buffer buf) fmt
 
   let failwith fmt = kstrf failwith fmt
+
+  let list = Format.pp_print_list
+  let string s ppf = Format.pp_print_string ppf s
+
+  let prefix f g ppf x = f ppf; g ppf x
 end
 
 (* This is ugly *)

src/loc.ml

@@ -64,3 +64,6 @@ let warn t fmt =
 
 let to_file_colon_line t =
   sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
+
+let pp_file_colon_line ppf t =
+  Format.pp_print_string ppf (to_file_colon_line t)

src/loc.mli

@@ -19,6 +19,7 @@ val of_pos : (string * int * int * int) -> t
 val none : t
 
 val to_file_colon_line : t -> string
+val pp_file_colon_line : Format.formatter -> t -> unit
 
 (** Prints "File ..., line ..., characters ...:\n" *)
 val print : Format.formatter -> t -> unit

src/modules_partitioner.ml

@@ -0,0 +1,43 @@
+open Import
+
+type t =
+  { dir          : Path.t
+  ; all_modules  : Module.t String_map.t
+  ; mutable used : Loc.t list String_map.t
+  }
+
+let create ~dir ~all_modules =
+  { dir
+  ; all_modules
+  ; used = String_map.empty
+  }
+
+let acknowledge t ~loc ~modules =
+  let already_used =
+    String_map.merge modules t.used ~f:(fun _name x l ->
+      Option.some_if (Option.is_some x && Option.is_some l) ())
+    |> String_map.keys
+    |> String_set.of_list
+  in
+  t.used <-
+    String_map.merge modules t.used ~f:(fun _name x l ->
+      match x with
+      | None -> l
+      | Some _ -> Some (loc :: Option.value l ~default:[]));
+  already_used
+
+let emit_warnings t =
+  let loc =
+    Utils.jbuild_file_in ~dir:t.dir
+    |> Path.to_string
+    |> Loc.in_file
+  in
+  String_map.iter t.used ~f:(fun ~key:name ~data:locs ->
+    if List.length locs > 1 then
+      Loc.warn loc
+        "Module %S is used in several stanzas:@\n\
+         @[<v>%a@]@\n\
+         This will become an error in the future."
+        name
+        (Fmt.list (Fmt.prefix (Fmt.string "- ") Loc.pp_file_colon_line))
+        locs)

src/modules_partitioner.mli

@@ -0,0 +1,26 @@
+(** Checks modules partitioning inside a directory *)
+
+open Import
+
+type t
+
+val create
+  :  dir:Path.t
+  -> all_modules:Module.t String_map.t
+  -> t
+
+(** [acknowledge t ~loc ~modules] registers the fact that [modules]
+    are associated with [loc].
+
+    Returns the set of modules that are already used at another
+    location.
+*)
+val acknowledge
+  :  t
+  -> loc:Loc.t
+  -> modules:Module.t String_map.t
+  -> String_set.t
+
+(** To be called after processing a directory. Emit warnings about
+    detected problems *)
+val emit_warnings : t -> unit

src/ocamldep.ml

@@ -101,8 +101,10 @@ let parse_deps ~dir ~file ~(unit : Module.t)
            die "Module %s in directory %s depends on %s.\n\
                 This doesn't make sense to me.\n\
                 \n\
-                %s is the main module of the library and is the only module exposed \n\
-                outside of the library. Consequently, it should be the one depending \n\
+                %s is the main module of the library and is \
+                the only module exposed \n\
+                outside of the library. Consequently, it should \
+                be the one depending \n\
                 on all the other modules in the library."
              unit.name (Path.to_string dir) m.name m.name);
       let deps =
@@ -112,21 +114,24 @@ let parse_deps ~dir ~file ~(unit : Module.t)
       in
       deps
 
-let rules sctx ~(ml_kind:Ml_kind.t) ~dir ~modules ~alias_module ~lib_interface_module =
+let rules sctx ~(ml_kind:Ml_kind.t) ~dir ~modules ~already_used
+      ~alias_module ~lib_interface_module =
   let per_module =
     String_map.map modules ~f:(fun unit ->
       match Module.file ~dir unit ml_kind with
       | None -> Build.return []
       | Some file ->
         let ocamldep_output = Path.extend_basename file ~suffix:".d" in
         let context = SC.context sctx in
-        SC.add_rule sctx
-          (Build.run ~context (Ok context.ocamldep)
-             [A "-modules"; Ml_kind.flag ml_kind; Dep file]
-             ~stdout_to:ocamldep_output);
+        if not (String_set.mem unit.name already_used) then
+          SC.add_rule sctx
+            (Build.run ~context (Ok context.ocamldep)
+               [A "-modules"; Ml_kind.flag ml_kind; Dep file]
+               ~stdout_to:ocamldep_output);
         Build.memoize (Path.to_string ocamldep_output)
           (Build.lines_of ocamldep_output
-           >>^ parse_deps ~dir ~file ~unit ~modules ~alias_module ~lib_interface_module))
+           >>^ parse_deps ~dir ~file ~unit ~modules ~alias_module
+                 ~lib_interface_module))
   in
   let per_module =
     match alias_module with
@@ -138,5 +143,6 @@ let rules sctx ~(ml_kind:Ml_kind.t) ~dir ~modules ~alias_module ~lib_interface_m
   ; per_module
   }
 
-let rules sctx ~dir ~modules ~alias_module ~lib_interface_module =
-  Ml_kind.Dict.of_func (rules sctx ~dir ~modules ~alias_module ~lib_interface_module)
+let rules sctx ~dir ~modules ~already_used ~alias_module ~lib_interface_module =
+  Ml_kind.Dict.of_func (rules sctx ~dir ~modules ~already_used ~alias_module
+                          ~lib_interface_module)

src/ocamldep.mli

@@ -22,17 +22,23 @@ module Dep_graphs : sig
   val dummy : Module.t -> t
 end
 
-(** Generate ocamldep rules for the given modules. [item] is either the internal name of a
-    library of the first name of a list of executables.
+(** Generate ocamldep rules for the given modules. [item] is either
+    the internal name of a library of the first name of a list of
+    executables.
 
-    For wrapped libraries, [lib_interface_module] is the main module of the library.
+    For wrapped libraries, [lib_interface_module] is the main module
+    of the library.
 
-    Return arrows that evaluate to the dependency graphs.
-*)
+    [already_used] represents the modules that are used by another
+    stanzas in the same directory. No [.d] rule will be generated for
+    such modules.
+
+    Return arrows that evaluate to the dependency graphs.  *)
 val rules
   :  Super_context.t
   -> dir:Path.t
   -> modules:Module.t String_map.t
+  -> already_used:String_set.t
   -> alias_module:Module.t option
   -> lib_interface_module:Module.t option
   -> Dep_graphs.t

test/blackbox-tests/test-cases/ocamldep-multi-stanzas/run.t

@@ -1,5 +1,21 @@
   $ $JBUILDER exec ./test.exe -j1 --debug-dep --display short --root .
+  File "jbuild", line 1, characters 0-0:
+  Warning: Module "Lib" is used in several stanzas:
+  - jbuild:8
+  - jbuild:4
+  This will become an error in the future.
   Multiple rules generated for _build/default/lib.o:
   - <internal location>
   - <internal location>
   [1]
+
+  $ $JBUILDER build src/a.cma -j1 --debug-dep --display short --root .
+  File "src/jbuild", line 1, characters 0-0:
+  Warning: Module "X" is used in several stanzas:
+  - src/jbuild:4
+  - src/jbuild:3
+  This will become an error in the future.
+      ocamldep src/x.ml.d
+        ocamlc src/.a.objs/a.{cmi,cmo,cmt}
+        ocamlc src/.a.objs/a__X.{cmi,cmo,cmt}
+        ocamlc src/a.cma

test/blackbox-tests/test-cases/ocamldep-multi-stanzas/src/jbuild

@@ -0,0 +1,4 @@
+(jbuild_version 1)
+
+(library ((name a)))
+(library ((name b)))

test/blackbox-tests/test-cases/ocamldep-multi-stanzas/src/x.ml

@@ -0,0 +1 @@
+let x = 42

test/blackbox-tests/test-cases/odoc-unique-mlds/run.t

@@ -17,6 +17,7 @@ Duplicate mld's in the same scope
           odoc _doc/root.lib2/Root_lib2/.jbuilder-keep,_doc/root.lib2/Root_lib2/index.html
 
 Duplicate mld's in different scope
+  $ rm -rf diff-scope/_build
   $ $JBUILDER build @doc -j1 --display short --root ./diff-scope 2>&1 | grep -v Entering
           odoc _doc/odoc.css
           odoc _doc/scope1/page-foo.odoc