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
This commit is contained in:
parent
19f1c6f6b3
commit
2a531c5d24
12
src/exe.ml
12
src/exe.ml
|
@ -115,6 +115,7 @@ let build_and_link_many
|
||||||
~loc ~dir ~programs ~modules
|
~loc ~dir ~programs ~modules
|
||||||
~scope
|
~scope
|
||||||
~linkages
|
~linkages
|
||||||
|
?modules_partitioner
|
||||||
?(libraries=[])
|
?(libraries=[])
|
||||||
?(flags=Ocaml_flags.empty)
|
?(flags=Ocaml_flags.empty)
|
||||||
?link_flags
|
?link_flags
|
||||||
|
@ -141,10 +142,17 @@ let build_and_link_many
|
||||||
~lint
|
~lint
|
||||||
~lib_name:None
|
~lib_name:None
|
||||||
in
|
in
|
||||||
|
let already_used =
|
||||||
|
match modules_partitioner with
|
||||||
|
| None -> String_set.empty
|
||||||
|
| Some mp ->
|
||||||
|
Modules_partitioner.acknowledge mp
|
||||||
|
~loc ~modules
|
||||||
|
in
|
||||||
|
|
||||||
let dep_graphs =
|
let dep_graphs =
|
||||||
Ocamldep.rules sctx ~dir ~modules ~alias_module:None
|
Ocamldep.rules sctx ~dir ~modules ~already_used
|
||||||
~lib_interface_module:None
|
~alias_module:None ~lib_interface_module:None
|
||||||
in
|
in
|
||||||
|
|
||||||
let requires, real_requires =
|
let requires, real_requires =
|
||||||
|
|
|
@ -44,6 +44,7 @@ val build_and_link
|
||||||
-> modules:Module.t String_map.t
|
-> modules:Module.t String_map.t
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> linkages:Linkage.t list
|
-> linkages:Linkage.t list
|
||||||
|
-> ?modules_partitioner:Modules_partitioner.t
|
||||||
-> ?libraries:Jbuild.Lib_deps.t
|
-> ?libraries:Jbuild.Lib_deps.t
|
||||||
-> ?flags:Ocaml_flags.t
|
-> ?flags:Ocaml_flags.t
|
||||||
-> ?link_flags:(unit, string list) Build.t
|
-> ?link_flags:(unit, string list) Build.t
|
||||||
|
@ -62,6 +63,7 @@ val build_and_link_many
|
||||||
-> modules:Module.t String_map.t
|
-> modules:Module.t String_map.t
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> linkages:Linkage.t list
|
-> linkages:Linkage.t list
|
||||||
|
-> ?modules_partitioner:Modules_partitioner.t
|
||||||
-> ?libraries:Jbuild.Lib_deps.t
|
-> ?libraries:Jbuild.Lib_deps.t
|
||||||
-> ?flags:Ocaml_flags.t
|
-> ?flags:Ocaml_flags.t
|
||||||
-> ?link_flags:(unit, string list) Build.t
|
-> ?link_flags:(unit, string list) Build.t
|
||||||
|
|
|
@ -493,12 +493,17 @@ module Gen(P : Params) = struct
|
||||||
it references are built after. *)
|
it references are built after. *)
|
||||||
let alias_module_build_sandbox = ctx.version < (4, 03, 0)
|
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 obj_dir = Utils.library_object_directory ~dir lib.name in
|
||||||
let dep_kind = if lib.optional then Build.Optional else Required 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 flags = Ocaml_flags.make lib.buildable sctx ~scope ~dir in
|
||||||
let { modules; main_module_name; alias_module } = modules_by_lib ~dir lib 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 =
|
let modules =
|
||||||
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
|
SC.PP.pp_and_lint_modules sctx ~dir ~dep_kind ~modules ~scope
|
||||||
~preprocess:lib.buildable.preprocess
|
~preprocess:lib.buildable.preprocess
|
||||||
|
@ -516,7 +521,7 @@ module Gen(P : Params) = struct
|
||||||
in
|
in
|
||||||
|
|
||||||
let dep_graphs =
|
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
|
~lib_interface_module:(if lib.wrapped then
|
||||||
String_map.find main_module_name modules
|
String_map.find main_module_name modules
|
||||||
else
|
else
|
||||||
|
@ -719,7 +724,8 @@ module Gen(P : Params) = struct
|
||||||
| Executables stuff |
|
| 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 =
|
let modules =
|
||||||
parse_modules ~all_modules ~buildable:exes.buildable
|
parse_modules ~all_modules ~buildable:exes.buildable
|
||||||
in
|
in
|
||||||
|
@ -764,6 +770,7 @@ module Gen(P : Params) = struct
|
||||||
~dir
|
~dir
|
||||||
~programs
|
~programs
|
||||||
~modules
|
~modules
|
||||||
|
?modules_partitioner
|
||||||
~scope
|
~scope
|
||||||
~linkages
|
~linkages
|
||||||
~libraries:exes.buildable.libraries
|
~libraries:exes.buildable.libraries
|
||||||
|
@ -828,13 +835,17 @@ module Gen(P : Params) = struct
|
||||||
(* This interprets "rule" and "copy_files" stanzas. *)
|
(* This interprets "rule" and "copy_files" stanzas. *)
|
||||||
let files = text_files ~dir:ctx_dir in
|
let files = text_files ~dir:ctx_dir in
|
||||||
let all_modules = modules_by_dir ~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 ->
|
List.filter_map stanzas ~f:(fun stanza ->
|
||||||
let dir = ctx_dir in
|
let dir = ctx_dir in
|
||||||
match (stanza : Stanza.t) with
|
match (stanza : Stanza.t) with
|
||||||
| Library lib ->
|
| Library lib ->
|
||||||
Some (library_rules lib ~dir ~files ~scope)
|
Some (library_rules lib ~dir ~files ~scope ~modules_partitioner)
|
||||||
| Executables exes ->
|
| Executables exes ->
|
||||||
Some (executables_rules exes ~dir ~all_modules ~scope)
|
Some (executables_rules exes ~dir ~all_modules ~scope
|
||||||
|
~modules_partitioner)
|
||||||
| Alias alias ->
|
| Alias alias ->
|
||||||
alias_rules alias ~dir ~scope;
|
alias_rules alias ~dir ~scope;
|
||||||
None
|
None
|
||||||
|
@ -861,9 +872,12 @@ module Gen(P : Params) = struct
|
||||||
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
|
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
|
||||||
Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
|
Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
|
||||||
let dir = Utop.utop_exe_dir ~dir:ctx_dir in
|
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;
|
Utop.add_module_rules sctx ~dir merlin.requires;
|
||||||
)
|
);
|
||||||
|
Modules_partitioner.emit_warnings modules_partitioner
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| META |
|
| META |
|
||||||
|
|
|
@ -595,6 +595,18 @@ module No_io = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Fmt = struct
|
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
|
type 'a t = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
let kstrf f fmt =
|
let kstrf f fmt =
|
||||||
|
@ -603,6 +615,11 @@ module Fmt = struct
|
||||||
Format.kfprintf f (Format.formatter_of_buffer buf) fmt
|
Format.kfprintf f (Format.formatter_of_buffer buf) fmt
|
||||||
|
|
||||||
let failwith fmt = kstrf failwith 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
|
end
|
||||||
|
|
||||||
(* This is ugly *)
|
(* This is ugly *)
|
||||||
|
|
|
@ -64,3 +64,6 @@ let warn t fmt =
|
||||||
|
|
||||||
let to_file_colon_line t =
|
let to_file_colon_line t =
|
||||||
sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
|
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)
|
||||||
|
|
|
@ -19,6 +19,7 @@ val of_pos : (string * int * int * int) -> t
|
||||||
val none : t
|
val none : t
|
||||||
|
|
||||||
val to_file_colon_line : t -> string
|
val to_file_colon_line : t -> string
|
||||||
|
val pp_file_colon_line : Format.formatter -> t -> unit
|
||||||
|
|
||||||
(** Prints "File ..., line ..., characters ...:\n" *)
|
(** Prints "File ..., line ..., characters ...:\n" *)
|
||||||
val print : Format.formatter -> t -> unit
|
val print : Format.formatter -> t -> unit
|
||||||
|
|
|
@ -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)
|
|
@ -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
|
|
@ -101,8 +101,10 @@ let parse_deps ~dir ~file ~(unit : Module.t)
|
||||||
die "Module %s in directory %s depends on %s.\n\
|
die "Module %s in directory %s depends on %s.\n\
|
||||||
This doesn't make sense to me.\n\
|
This doesn't make sense to me.\n\
|
||||||
\n\
|
\n\
|
||||||
%s is the main module of the library and is the only module exposed \n\
|
%s is the main module of the library and is \
|
||||||
outside of the library. Consequently, it should be the one depending \n\
|
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."
|
on all the other modules in the library."
|
||||||
unit.name (Path.to_string dir) m.name m.name);
|
unit.name (Path.to_string dir) m.name m.name);
|
||||||
let deps =
|
let deps =
|
||||||
|
@ -112,7 +114,8 @@ let parse_deps ~dir ~file ~(unit : Module.t)
|
||||||
in
|
in
|
||||||
deps
|
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 =
|
let per_module =
|
||||||
String_map.map modules ~f:(fun unit ->
|
String_map.map modules ~f:(fun unit ->
|
||||||
match Module.file ~dir unit ml_kind with
|
match Module.file ~dir unit ml_kind with
|
||||||
|
@ -120,13 +123,15 @@ let rules sctx ~(ml_kind:Ml_kind.t) ~dir ~modules ~alias_module ~lib_interface_m
|
||||||
| Some file ->
|
| Some file ->
|
||||||
let ocamldep_output = Path.extend_basename file ~suffix:".d" in
|
let ocamldep_output = Path.extend_basename file ~suffix:".d" in
|
||||||
let context = SC.context sctx in
|
let context = SC.context sctx in
|
||||||
SC.add_rule sctx
|
if not (String_set.mem unit.name already_used) then
|
||||||
(Build.run ~context (Ok context.ocamldep)
|
SC.add_rule sctx
|
||||||
[A "-modules"; Ml_kind.flag ml_kind; Dep file]
|
(Build.run ~context (Ok context.ocamldep)
|
||||||
~stdout_to:ocamldep_output);
|
[A "-modules"; Ml_kind.flag ml_kind; Dep file]
|
||||||
|
~stdout_to:ocamldep_output);
|
||||||
Build.memoize (Path.to_string ocamldep_output)
|
Build.memoize (Path.to_string ocamldep_output)
|
||||||
(Build.lines_of 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
|
in
|
||||||
let per_module =
|
let per_module =
|
||||||
match alias_module with
|
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
|
; per_module
|
||||||
}
|
}
|
||||||
|
|
||||||
let 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 ~alias_module ~lib_interface_module)
|
Ml_kind.Dict.of_func (rules sctx ~dir ~modules ~already_used ~alias_module
|
||||||
|
~lib_interface_module)
|
||||||
|
|
|
@ -22,17 +22,23 @@ module Dep_graphs : sig
|
||||||
val dummy : Module.t -> t
|
val dummy : Module.t -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Generate ocamldep rules for the given modules. [item] is either the internal name of a
|
(** Generate ocamldep rules for the given modules. [item] is either
|
||||||
library of the first name of a list of executables.
|
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
|
val rules
|
||||||
: Super_context.t
|
: Super_context.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> modules:Module.t String_map.t
|
-> modules:Module.t String_map.t
|
||||||
|
-> already_used:String_set.t
|
||||||
-> alias_module:Module.t option
|
-> alias_module:Module.t option
|
||||||
-> lib_interface_module:Module.t option
|
-> lib_interface_module:Module.t option
|
||||||
-> Dep_graphs.t
|
-> Dep_graphs.t
|
||||||
|
|
|
@ -1,5 +1,21 @@
|
||||||
$ $JBUILDER exec ./test.exe -j1 --debug-dep --display short --root .
|
$ $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:
|
Multiple rules generated for _build/default/lib.o:
|
||||||
- <internal location>
|
- <internal location>
|
||||||
- <internal location>
|
- <internal location>
|
||||||
[1]
|
[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
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
(jbuild_version 1)
|
||||||
|
|
||||||
|
(library ((name a)))
|
||||||
|
(library ((name b)))
|
|
@ -0,0 +1 @@
|
||||||
|
let x = 42
|
|
@ -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
|
odoc _doc/root.lib2/Root_lib2/.jbuilder-keep,_doc/root.lib2/Root_lib2/index.html
|
||||||
|
|
||||||
Duplicate mld's in different scope
|
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
|
$ $JBUILDER build @doc -j1 --display short --root ./diff-scope 2>&1 | grep -v Entering
|
||||||
odoc _doc/odoc.css
|
odoc _doc/odoc.css
|
||||||
odoc _doc/scope1/page-foo.odoc
|
odoc _doc/scope1/page-foo.odoc
|
||||||
|
|
Loading…
Reference in New Issue