From 2889d9bcbfda91af284e675db718b1b9d88c7e5c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 5 Jul 2019 17:40:25 +0700 Subject: [PATCH 1/5] Add name mangling for dune executables Executables generated by dune are mangled by default. Executables that are written by the user are mangled starting from 2.0. The user can turn off this option per project with the `wrapped_exes` option. Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 + doc/advanced-topics.rst | 16 ++ src/cinaps.ml | 2 +- src/dir_contents.ml | 12 +- src/dune_project.ml | 48 +++--- src/dune_project.mli | 2 + src/inline_tests.ml | 22 +-- src/link_time_code_gen.ml | 3 +- src/menhir.ml | 40 ++--- src/module.ml | 1 + src/module.mli | 2 +- src/modules.ml | 148 ++++++++++++------ src/modules.mli | 10 +- src/toplevel.ml | 2 +- src/visibility.ml | 13 ++ src/visibility.mli | 13 ++ .../exe-name-mangle/multi-exe-same-dir/bar.ml | 0 .../exe-name-mangle/multi-exe-same-dir/dune | 7 + .../multi-exe-same-dir/dune-project | 2 + .../exe-name-mangle/multi-exe-same-dir/foo.ml | 0 .../exe-name-mangle/multi-module/dune-project | 2 + .../exe-name-mangle/multi-module/foo.ml | 2 +- .../test-cases/exe-name-mangle/run.t | 37 +++-- .../single-module/dune-project | 2 + test/blackbox-tests/test-cases/utop/run.t | 2 +- 25 files changed, 258 insertions(+), 134 deletions(-) create mode 100644 test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/bar.ml create mode 100644 test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune create mode 100644 test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune-project create mode 100644 test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/foo.ml diff --git a/CHANGES.md b/CHANGES.md index d87271664a2..fb243b2a883 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,10 @@ - Change `implicit_transive_deps` to be false. Implicit transitive deps now must be manually enabled (#2306, @rgrinberg) +- Compilation units of user defined executables are now mangled by default. This + is done to prevent the accidental collision with library dependencies of the + executable. (#2364, fixes #2292, @rgrinberg) + 1.11.0 (unreleased) ------------------- diff --git a/doc/advanced-topics.rst b/doc/advanced-topics.rst index 59261221845..33d6ad69768 100644 --- a/doc/advanced-topics.rst +++ b/doc/advanced-topics.rst @@ -251,3 +251,19 @@ this the default mode eventually. Note that you must use ``threads.posix`` instead of ``threads`` when using this mode. This is not an important limitation as ``threads.vm`` are deprecated anyways. + +Name Mangling of Executables +============================ + +Executables are made of compilation units whose names may collide with the +compilation units of libraries. To avoid this possibility, dune prefixes these +compilation unit names with ``Dune__exe__``. This is entirely transparent to +users except for when such executables are debugged. In which case the mangled +names will be visible in the debugger. + +Starting from dune 1.11, the ``(wrapped_executables )`` option is +available to turn on/off name mangling for executables on a per project basis. + +Starting from dune 2.0, dune mangles compilation units of executables by +default. However, this can still be turned off using ``(wrapped_executables +false)`` diff --git a/src/cinaps.ml b/src/cinaps.ml index 026bac2d7bf..0ce41334d45 100644 --- a/src/cinaps.ml +++ b/src/cinaps.ml @@ -101,7 +101,7 @@ let gen_rules sctx t ~dir ~scope ~dir_kind = ~dir_kind in let modules = - Modules.exe modules + Modules.exe_unwrapped modules |> Modules.map_user_written ~f:(Preprocessing.pp_module preprocess) in diff --git a/src/dir_contents.ml b/src/dir_contents.ml index 96bc0a3812f..f4bf9bcbedb 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -272,8 +272,7 @@ end = struct lib.private_modules) in Left ( lib - , let src_dir = Path.build src_dir in - Modules.lib ~lib ~src_dir ~modules ~main_module_name ~wrapped + , Modules.lib ~lib ~src_dir ~modules ~main_module_name ~wrapped ) | Executables exes | Tests { exes; _} -> @@ -283,7 +282,14 @@ end = struct ~kind:Modules_field_evaluator.Exe_or_normal_lib ~private_modules:Ordered_set_lang.standard in - Right (exes, Modules.exe modules) + let modules = + let project = Scope.project scope in + if Dune_project.wrapped_executables project then + Modules.exe_wrapped ~src_dir:d.ctx_dir ~modules + else + Modules.exe_unwrapped modules + in + Right (exes, modules) | _ -> Skip) in let libraries = diff --git a/src/dune_project.ml b/src/dune_project.ml index 6ad2be6713a..d6a9b6c705b 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -190,6 +190,7 @@ type t = ; extension_args : Univ_map.t ; parsing_context : Univ_map.t ; implicit_transitive_deps : bool + ; wrapped_executables : bool ; dune_version : Syntax.Version.t ; allow_approx_merlin : bool ; generate_opam_files : bool @@ -220,7 +221,7 @@ let to_dyn ; homepage ; documentation ; project_file ; parsing_context = _ ; bug_reports ; maintainers ; extension_args = _; stanza_parser = _ ; packages - ; implicit_transitive_deps ; dune_version + ; implicit_transitive_deps ; wrapped_executables ; dune_version ; allow_approx_merlin ; generate_opam_files } = let open Dyn.Encoder in record @@ -240,6 +241,7 @@ let to_dyn (Package.Name.Map.to_list packages) ; "implicit_transitive_deps", bool implicit_transitive_deps + ; "wrapped_executables", bool wrapped_executables ; "dune_version", Syntax.Version.to_dyn dune_version ; "allow_approx_merlin", bool allow_approx_merlin ; "generate_opam_files", bool generate_opam_files @@ -490,31 +492,7 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) (parsing_context, stanza_parser, extension_args) let key = - Univ_map.Key.create ~name:"dune-project" - (fun { name; root; version; project_file; source - ; license; authors; homepage; documentation ; bug_reports ; maintainers - ; stanza_parser = _; packages = _ ; extension_args = _ - ; parsing_context ; implicit_transitive_deps ; dune_version - ; allow_approx_merlin ; generate_opam_files } -> - let open Dyn.Encoder in - record - [ "name", Name.to_dyn name - ; "root", Path.Source.to_dyn root - ; "license", (option string) license - ; "authors", (list string) authors - ; "source", Dyn.Encoder.(option Source_kind.to_dyn) source - ; "version", (option string) version - ; "homepage", (option string) homepage - ; "documentation", (option string) documentation - ; "bug_reports", (option string) bug_reports - ; "maintainers", (list string) maintainers - ; "project_file", Project_file.to_dyn project_file - ; "parsing_context", Univ_map.to_dyn parsing_context - ; "implicit_transitive_deps", bool implicit_transitive_deps - ; "dune_version", Syntax.Version.to_dyn dune_version - ; "allow_approx_merlin", bool allow_approx_merlin - ; "generate_opam_files", bool generate_opam_files - ]) + Univ_map.Key.create ~name:"dune-project" to_dyn let set t = Dune_lang.Decoder.set key t let get_exn () = @@ -529,6 +507,9 @@ let filename = "dune-project" let implicit_transitive_deps_default ~(lang : Lang.Instance.t) = lang.version < (2, 0) +let wrapped_executables_default ~(lang : Lang.Instance.t) = + lang.version >= (2, 0) + let anonymous = lazy ( let lang = get_dune_lang () in let name = Name.anonymous_root in @@ -543,6 +524,7 @@ let anonymous = lazy ( interpret_lang_and_extensions ~lang ~explicit_extensions:[] ~project_file in let implicit_transitive_deps = implicit_transitive_deps_default ~lang in + let wrapped_executables = wrapped_executables_default ~lang in { name = name ; packages = Package.Name.Map.empty ; root = Path.Source.root @@ -555,6 +537,7 @@ let anonymous = lazy ( ; authors = [] ; version = None ; implicit_transitive_deps + ; wrapped_executables ; stanza_parser ; project_file ; extension_args @@ -618,6 +601,9 @@ let parse ~dir ~lang ~opam_packages ~file = and+ implicit_transitive_deps = field_o_b "implicit_transitive_deps" ~check:(Syntax.since Stanza.syntax (1, 7)) + and+ wrapped_executables = + field_o_b "wrapped_executables" + ~check:(Syntax.since Stanza.syntax (1, 11)) and+ allow_approx_merlin = field_o_b "allow_approximate_merlin" ~check:(Syntax.since Stanza.syntax (1, 9)) @@ -701,9 +687,13 @@ let parse ~dir ~lang ~opam_packages ~file = Option.value implicit_transitive_deps ~default:(implicit_transitive_deps_default ~lang) in + let wrapped_executables = + Option.value wrapped_executables + ~default:(wrapped_executables_default ~lang) in let allow_approx_merlin = Option.value ~default:false allow_approx_merlin in - let generate_opam_files = Option.value ~default:false generate_opam_files in + let generate_opam_files = + Option.value ~default:false generate_opam_files in { name ; root = dir ; version @@ -720,6 +710,7 @@ let parse ~dir ~lang ~opam_packages ~file = ; extension_args ; parsing_context ; implicit_transitive_deps + ; wrapped_executables ; dune_version = lang.version ; allow_approx_merlin ; generate_opam_files @@ -765,6 +756,7 @@ let make_jbuilder_project ~dir opam_packages = ; dune_version = lang.version ; allow_approx_merlin = true ; generate_opam_files = false + ; wrapped_executables = false } let load ~dir ~files = @@ -824,3 +816,5 @@ let dune_version t = t.dune_version let set_parsing_context t parser = Dune_lang.Decoder.set_many t.parsing_context parser + +let wrapped_executables t = t.wrapped_executables diff --git a/src/dune_project.mli b/src/dune_project.mli index a8d44dce865..e628d0726e4 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -155,3 +155,5 @@ val set_parsing_context : t -> 'a Dune_lang.Decoder.t -> 'a Dune_lang.Decoder.t val implicit_transitive_deps : t -> bool val dune_version : t -> Syntax.Version.t + +val wrapped_executables : t -> bool diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 51922cc87be..cc5fd48c286 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -90,13 +90,13 @@ module Backend = struct let f x = Lib_name.encode (Lib.name x.lib) in ((1, 0), record_fields @@ - [ field_l "runner_libraries" lib (Result.ok_exn t.runner_libraries) - ; field_i "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade - t.info.flags - ; field_o "generate_runner" Action_dune_lang.encode_and_upgrade - (Option.map t.info.generate_runner ~f:snd) - ; field_l "extends" f (Result.ok_exn t.extends) - ]) + [ field_l "runner_libraries" lib (Result.ok_exn t.runner_libraries) + ; field_i "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade + t.info.flags + ; field_o "generate_runner" Action_dune_lang.encode_and_upgrade + (Option.map t.info.generate_runner ~f:snd) + ; field_l "extends" f (Result.ok_exn t.extends) + ]) end include M include Sub_system.Register_backend(M) @@ -207,8 +207,10 @@ include Sub_system.Register_end_point( let loc = lib.buildable.loc in + let lib_name = snd lib.name in + let inline_test_name = - sprintf "%s.inline-tests" (Lib_name.Local.to_string (snd lib.name)) + sprintf "%s.inline-tests" (Lib_name.Local.to_string lib_name) in let inline_test_dir = Path.Build.relative dir ("." ^ inline_test_name) in @@ -224,7 +226,7 @@ include Sub_system.Register_end_point( Module.generated ~src_dir name in - let modules = Modules.singleton main_module in + let modules = Modules.singleton_exe main_module in let bindings = Pform.Map.singleton "library-name" @@ -367,6 +369,6 @@ include Sub_system.Register_end_point( |> List.map ~f:(fun fn -> A.diff ~optional:true fn (Path.extend_basename fn ~suffix:".corrected")))))))) -end) + end) let linkme = () diff --git a/src/link_time_code_gen.ml b/src/link_time_code_gen.ml index 08fbecfe4f4..898ec26a2e0 100644 --- a/src/link_time_code_gen.ml +++ b/src/link_time_code_gen.ml @@ -42,6 +42,7 @@ let generate_and_compile_module cctx ~precompiled_cmi ~name:basename Ocaml_version.supports_opaque_for_mli (Super_context.context sctx).version in + let modules = Modules.singleton_exe module_ in let cctx = Compilation_context.create ~super_context:sctx @@ -49,7 +50,7 @@ let generate_and_compile_module cctx ~precompiled_cmi ~name:basename ~scope:(Compilation_context.scope cctx) ~dir_kind:(Compilation_context.dir_kind cctx) ~obj_dir - ~modules:(Modules.singleton module_) + ~modules ~requires_compile:requires ~requires_link:(lazy requires) ~flags:Ocaml_flags.empty diff --git a/src/menhir.ml b/src/menhir.ml index b7d88d5bd3a..83a59b4ed66 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -215,27 +215,27 @@ module Run (P : PARAMS) : sig end = struct Module.of_source ~visibility:Public ~kind:Impl source in - (* The following incantation allows the mock [.ml] file to be preprocessed - by the user-specified [ppx] rewriters. *) - - let mock_module = - Preprocessing.pp_module_as - (Compilation_context.preprocessing cctx) - name - mock_module - ~lint:false - in - - let dep_graphs = - let modules = Modules.singleton mock_module in - Ocamldep.rules cctx ~modules + let modules = + (* The following incantation allows the mock [.ml] file to be preprocessed + by the user-specified [ppx] rewriters. *) + + let mock_module = + Preprocessing.pp_module_as + (Compilation_context.preprocessing cctx) + name + mock_module + ~lint:false + in + Modules.singleton_exe mock_module in - - Module_compilation.ocamlc_i - ~dep_graphs - cctx - mock_module - ~output:(inferred_mli base); + let dep_graphs = Ocamldep.rules cctx ~modules in + + Modules.iter_no_vlib modules ~f:(fun m -> + Module_compilation.ocamlc_i + ~dep_graphs + cctx + m + ~output:(inferred_mli base)); (* 3. A second invocation of Menhir reads the inferred [.mli] file. *) diff --git a/src/module.ml b/src/module.ml index 7d0034c9ff9..62e5057289c 100644 --- a/src/module.ml +++ b/src/module.ml @@ -429,6 +429,7 @@ let generated ~src_dir name = source let generated_alias ~src_dir name = + let src_dir = Path.build src_dir in let t = generated ~src_dir name in { t with kind = Alias } diff --git a/src/module.mli b/src/module.mli index c95edc1609c..b02fceb472e 100644 --- a/src/module.mli +++ b/src/module.mli @@ -170,4 +170,4 @@ val set_src_dir : t -> src_dir:Path.t -> t val generated : src_dir:Path.t -> Name.t -> t (** Represent the generated alias module. *) -val generated_alias : src_dir:Path.t -> Name.t -> t +val generated_alias : src_dir:Path.Build.t -> Name.t -> t diff --git a/src/modules.ml b/src/modules.ml index f82402cd7d2..818e35b957c 100644 --- a/src/modules.ml +++ b/src/modules.ml @@ -134,6 +134,67 @@ module Stdlib = struct lib_interface t end +module Mangle = struct + module Lib = struct + type kind = + | Has_lib_interface + | Implementation of Lib_name.Local.t + | Neither + + type t = + { main_module_name : Module.Name.t + ; kind : kind + } + end + + type t = + | Lib of Lib.t + | Exe + + let of_lib ~main_module_name ~modules ~(lib : Dune_file.Library.t) = + let kind : Lib.kind = + if Option.is_some lib.implements then + Implementation (snd lib.name) + else if Module.Name.Map.mem modules main_module_name then + Has_lib_interface + else + Neither + in + Lib { main_module_name ; kind } + + let prefix t : Module.Name.t Visibility.Map.t = + match t with + | Lib { main_module_name ; kind } -> + begin match kind with + | Has_lib_interface + | Neither -> Visibility.Map.make_both main_module_name + | Implementation lib -> + { private_ = + sprintf "%s__%s__" + (Module.Name.to_string main_module_name) + (Lib_name.Local.to_string lib) + |> Module.Name.of_string + ; public = main_module_name + } + end + | Exe -> + sprintf "dune__exe" + |> Module.Name.of_string + |> Visibility.Map.make_both + + let make_alias_module t ~src_dir = + let prefix = prefix t in + let name = + match t with + | Lib { kind = Has_lib_interface; _ } -> + Module.Name.add_suffix prefix.public "__" + | Lib { kind = Implementation _ ; _ } -> + prefix.private_ + | _ -> prefix.public + in + Module.generated_alias ~src_dir name +end + module Wrapped = struct type t = { modules : Module.Name_map.t @@ -181,61 +242,27 @@ module Wrapped = struct ; alias_module = f alias_module } - let make_alias_module ~src_dir ~implements ~lib_name - ~main_module_name ~modules = - if implements then - let name = - Module.Name.add_suffix main_module_name - (sprintf "__%s__" (Lib_name.Local.to_string lib_name)) - in - Module.generated_alias ~src_dir name - else if Module.Name.Map.mem modules main_module_name then - (* This module needs an implementation for non-dune - users of the library: - - https://github.com/ocaml/dune/issues/567 *) - let name = Module.Name.add_suffix main_module_name "__" in - Module.generated_alias ~src_dir name - else - Module.generated_alias ~src_dir main_module_name - - let wrap_modules ~modules ~lib ~main_module_name = - let prefix = - if not (Dune_file.Library.is_impl lib) then - fun _ -> main_module_name - else - (* for implementations we need to pick a different prefix for private - modules. This is to guarantee that the private modules will never - collide with the names of modules in the virtual library. *) - let private_module_prefix = - if Dune_file.Library.is_impl lib then - Module.Name.of_string - (sprintf "%s__%s" - (Module.Name.to_string main_module_name) - (Lib_name.Local.to_string (snd lib.name))) - else - main_module_name - in - fun m -> - match Module.visibility m with - | Private -> private_module_prefix - | Public -> main_module_name - in - let open Module.Name.Infix in + let wrap_modules prefix ~main_module_name ~modules = Module.Name.Map.map modules ~f:(fun (m : Module.t) -> if Module.name m = main_module_name then m else - Module.with_wrapper m ~main_module_name:(prefix m)) + let visibility = Module.visibility m in + let prefix = Visibility.Map.find prefix visibility in + Module.with_wrapper m ~main_module_name:prefix) let make ~src_dir ~lib ~modules ~main_module_name ~wrapped = + let mangle = Mangle.of_lib ~main_module_name ~lib ~modules in let (modules, wrapped_compat) = + let prefix = Mangle.prefix mangle in + let wrapped_modules = + wrap_modules prefix ~main_module_name ~modules in match (wrapped : Mode.t) with | Simple false -> assert false | Simple true -> - (wrap_modules ~modules ~main_module_name ~lib, Module.Name.Map.empty) + (wrapped_modules, Module.Name.Map.empty) | Yes_with_transition _ -> - ( wrap_modules ~modules ~main_module_name ~lib + ( wrapped_modules , Module.Name.Map.remove modules main_module_name |> Module.Name.Map.filter_map ~f:(fun m -> match Module.visibility m with @@ -243,12 +270,7 @@ module Wrapped = struct | Private -> None) ) in - let alias_module = - let (_, lib_name) = lib.name in - let implements = Dune_file.Library.is_impl lib in - make_alias_module ~main_module_name ~src_dir ~lib_name - ~modules ~implements - in + let alias_module = Mangle.make_alias_module ~src_dir mangle in { modules ; alias_module ; wrapped_compat @@ -256,6 +278,22 @@ module Wrapped = struct ; wrapped } + let exe ~src_dir ~modules = + let mangle = Mangle.Exe in + let prefix = Mangle.prefix mangle in + let alias_module = Mangle.make_alias_module mangle ~src_dir in + let modules = + Module.Name.Map.map modules ~f:(fun m -> + Module.with_wrapper m ~main_module_name:prefix.public) + in + { modules + ; wrapped_compat = Module.Name.Map.empty + ; alias_module + (* XXX exe's don't have a main module, but this is harmless *) + ; main_module_name = Module.name alias_module + ; wrapped = Simple true + } + let obj_map { modules; wrapped_compat; alias_module; main_module_name = _ ; wrapped = _ } ~f = let init = Module.Obj_map.singleton alias_module (f alias_module) in @@ -443,7 +481,8 @@ let rec lib_interface = function | Stdlib w -> Stdlib.lib_interface w | Impl { impl = _; vlib } -> lib_interface vlib -let exe m = Unwrapped m +let exe_unwrapped m = Unwrapped m +let exe_wrapped ~src_dir ~modules = Wrapped (Wrapped.exe ~src_dir ~modules) let rec main_module_name = function | Singleton m -> Some (Module.name m) @@ -527,7 +566,12 @@ let rec find_dep t ~of_ name = | Impl_or_lib -> Some m | Vlib -> Option.some_if (Module.visibility m = Public) m -let singleton m = Singleton m +let singleton_exe m = + Singleton ( + let mangle = Mangle.Exe in + let main_module_name = (Mangle.prefix mangle).public in + Module.with_wrapper m ~main_module_name + ) let rec impl_only = function | Stdlib w -> Stdlib.impl_only w diff --git a/src/modules.mli b/src/modules.mli index a127a4f6542..bb475ebe573 100644 --- a/src/modules.mli +++ b/src/modules.mli @@ -6,7 +6,7 @@ type t val to_dyn : t -> Dyn.t val lib - : src_dir:Path.t + : src_dir:Path.Build.t -> main_module_name:Module.Name.t option -> wrapped:Wrapped.t -> lib:Dune_file.Library.t @@ -31,13 +31,17 @@ val compat_for_exn : t -> Module.t -> Module.t val impl_only : t -> Module.t list -val singleton : Module.t -> t +val singleton_exe : Module.t -> t val fold_no_vlib : t -> init:'acc -> f:(Module.t -> 'acc -> 'acc) -> 'acc val iter_no_vlib : t -> f:(Module.t -> unit) -> unit -val exe : Module.Name_map.t -> t +val exe_unwrapped : Module.Name_map.t -> t +val exe_wrapped + : src_dir:Path.Build.t + -> modules:Module.Name_map.t + -> t (** For wrapped libraries, this is the user written entry module for the library. For single module libraries, it's the sole module in the library *) diff --git a/src/toplevel.ml b/src/toplevel.ml index a96086da16b..ad8acdf9659 100644 --- a/src/toplevel.ml +++ b/src/toplevel.ml @@ -23,7 +23,7 @@ module Source = struct let obj_dir { dir; name ; _ } = Obj_dir.make_exe ~dir ~name - let modules t = Modules.singleton (main_module t) + let modules t = Modules.singleton_exe (main_module t) let make ~dir ~loc ~main ~name = { dir diff --git a/src/visibility.ml b/src/visibility.ml index 414812a5cba..0152c3e31c4 100644 --- a/src/visibility.ml +++ b/src/visibility.ml @@ -30,3 +30,16 @@ let is_public = function | Private -> false let is_private t = not (is_public t) + +module Map = struct + type 'a t = + { public : 'a + ; private_ : 'a + } + + let make_both a = { public = a; private_ = a } + + let find { private_ ; public } = function + | Private -> private_ + | Public -> public +end diff --git a/src/visibility.mli b/src/visibility.mli index a1b3e8b887e..e57ada8c5aa 100644 --- a/src/visibility.mli +++ b/src/visibility.mli @@ -10,3 +10,16 @@ val is_private : t -> bool val to_dyn : t -> Dyn.t val pp : t Fmt.t + +module Map : sig + type 'a t = + { public : 'a + ; private_ : 'a + } + + type visibility + + val make_both : 'a -> 'a t + + val find : 'a t -> visibility -> 'a +end with type visibility := t diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/bar.ml b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/bar.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune new file mode 100644 index 00000000000..5c2f5517aa1 --- /dev/null +++ b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune @@ -0,0 +1,7 @@ +(executable + (name foo) + (modules foo)) + +(executable + (name bar) + (modules bar)) diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune-project b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune-project new file mode 100644 index 00000000000..d9f57f49419 --- /dev/null +++ b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(wrapped_executables true) diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/foo.ml b/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir/foo.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/dune-project b/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/dune-project index 0636ab6acf4..fae69e9f680 100644 --- a/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/dune-project +++ b/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/dune-project @@ -1 +1,3 @@ (lang dune 1.11) + +(wrapped_executables true) diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/foo.ml b/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/foo.ml index eca2c4800c2..4b40703a40d 100644 --- a/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/foo.ml +++ b/test/blackbox-tests/test-cases/exe-name-mangle/multi-module/foo.ml @@ -1,2 +1,2 @@ (* finally calling into library *) -let run = Bar.run () +let run () = Bar.run () diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/run.t b/test/blackbox-tests/test-cases/exe-name-mangle/run.t index 472b9b6a912..4670d89133c 100644 --- a/test/blackbox-tests/test-cases/exe-name-mangle/run.t +++ b/test/blackbox-tests/test-cases/exe-name-mangle/run.t @@ -1,15 +1,26 @@ -Binary composed of a single module with the same name as the dependency - $ dune build --root single-module 2>&1 | grep -v ocamlopt +These tests show that (wrapped_executables true) addresses the problem of compilation +units of exes colliding with libraries. + +Single module case. Here we technically don't need an alias module + + $ dune build --root single-module Entering directory 'single-module' - File "exe.ml", line 1: - Error: The files foo/.foo.objs/byte/foo.cmi and .exe.eobjs/byte/exe.cmi - make inconsistent assumptions over interface Exe -Binary composed of multiple modules where one collides with a dependency - $ dune build --root multi-module 2>&1 | grep -v ocamlopt | grep -v ocamlc + exe alias default + this module is unlinkable + this module is unlinkable + +The multi module case always requires an alias. + + $ dune build --root multi-module Entering directory 'multi-module' - File "foo.ml", line 1: - Error: The files foo/.foo.objs/byte/bar.cmi and .baz.eobjs/byte/foo.cmi - make inconsistent assumptions over interface Foo - File "baz.ml", line 1: - Error: The files .baz.eobjs/byte/foo.cmi and .baz.eobjs/byte/foo.cmi - make inconsistent assumptions over interface Foo + baz alias default + not directly usable + +Multiple executables defined in the same directory + + $ dune build --root multi-exe-same-dir + Entering directory 'multi-exe-same-dir' + Error: Multiple rules generated for _build/default/dune__exe.ml-gen: + - :1 + - :1 + [1] diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/single-module/dune-project b/test/blackbox-tests/test-cases/exe-name-mangle/single-module/dune-project index 059ef9a04e5..a81edc1d55d 100644 --- a/test/blackbox-tests/test-cases/exe-name-mangle/single-module/dune-project +++ b/test/blackbox-tests/test-cases/exe-name-mangle/single-module/dune-project @@ -1,3 +1,5 @@ (lang dune 1.11) +(wrapped_executables true) + (implicit_transitive_deps false) diff --git a/test/blackbox-tests/test-cases/utop/run.t b/test/blackbox-tests/test-cases/utop/run.t index f8c8731b4fb..adf4f4f4d7f 100644 --- a/test/blackbox-tests/test-cases/utop/run.t +++ b/test/blackbox-tests/test-cases/utop/run.t @@ -3,6 +3,6 @@ ocamlc forutop/.forutop.objs/byte/forutop.{cmi,cmo,cmt} ocamlc forutop/forutop.cma ocamldep forutop/.utop/.utop.eobjs/utop.ml-gen.d - ocamlc forutop/.utop/.utop.eobjs/byte/utop.{cmi,cmo,cmt} + ocamlc forutop/.utop/.utop.eobjs/byte/dune__exe__Utop.{cmi,cmo,cmt} ocamlc forutop/.utop/utop.exe hello in utop From f958f5338c2950c27db5a06579058e91ac5e14bb Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 9 Jul 2019 08:38:19 +0700 Subject: [PATCH 2/5] Fix alias module of multi exes in same dir Previously, we'd attempt to generate the rules for the alias module twice. Now we just generate the alias module in the object directory. Signed-off-by: Rudi Grinberg --- src/dir_contents.ml | 5 ++++- src/dir_contents.mli | 6 +++++- src/exe_rules.ml | 2 +- src/modules.ml | 9 +++++++++ src/modules.mli | 4 ++++ test/blackbox-tests/test-cases/exe-name-mangle/run.t | 4 ---- 6 files changed, 23 insertions(+), 7 deletions(-) diff --git a/src/dir_contents.ml b/src/dir_contents.ml index f4bf9bcbedb..6a80896552b 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -54,9 +54,12 @@ let modules_of_library t ~name = let map = (Memo.Lazy.force t.modules).libraries in Lib_name.Map.find_exn map name -let modules_of_executables t ~first_exe = +let modules_of_executables t ~obj_dir ~first_exe = let map = (Memo.Lazy.force t.modules).executables in + (* we need to relocate the alias module to its own directory. *) + let src_dir = Path.build (Obj_dir.obj_dir obj_dir) in String.Map.find_exn map first_exe + |> Modules.relocate_alias_module ~src_dir let c_sources_of_library t ~name = C_sources.for_lib (Memo.Lazy.force t.c_sources) ~name diff --git a/src/dir_contents.mli b/src/dir_contents.mli index 7ad307f198f..2cd9ce03f0e 100644 --- a/src/dir_contents.mli +++ b/src/dir_contents.mli @@ -22,7 +22,11 @@ val modules_of_library : t -> name:Lib_name.t -> Modules.t val c_sources_of_library : t -> name:Lib_name.t -> C.Sources.t (** Modules attached to a set of executables. *) -val modules_of_executables : t -> first_exe:string -> Modules.t +val modules_of_executables + : t + -> obj_dir:Path.Build.t Obj_dir.t + -> first_exe:string + -> Modules.t (** Find out what buildable a module is part of *) val lookup_module : t -> Module.Name.t -> Dune_file.Buildable.t option diff --git a/src/exe_rules.ml b/src/exe_rules.ml index 723bdf0177a..a74f5762ace 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -12,7 +12,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander Check_rules.add_obj_dir sctx ~obj_dir; let modules = Dir_contents.modules_of_executables dir_contents - ~first_exe:(snd (List.hd exes.names)) + ~first_exe:(snd (List.hd exes.names)) ~obj_dir in let preprocessor_deps = diff --git a/src/modules.ml b/src/modules.ml index 818e35b957c..c2bd6add9b2 100644 --- a/src/modules.ml +++ b/src/modules.ml @@ -362,6 +362,10 @@ module Wrapped = struct | Alias | Wrapped_compat -> None | _ -> Some t.alias_module + + let relocate_alias_module t ~src_dir = + let alias_module = Module.set_src_dir t.alias_module ~src_dir in + { t with alias_module } end type t = @@ -728,3 +732,8 @@ let is_stdlib_alias t m = let exit_module = function | Stdlib w -> Stdlib.exit_module w | _ -> None + +let relocate_alias_module t ~src_dir = + match t with + | Wrapped t -> Wrapped (Wrapped.relocate_alias_module t ~src_dir) + | s -> s diff --git a/src/modules.mli b/src/modules.mli index bb475ebe573..8bce5c9ae36 100644 --- a/src/modules.mli +++ b/src/modules.mli @@ -88,3 +88,7 @@ val alias_for : t -> Module.t -> Module.t option val is_stdlib_alias : t -> Module.t -> bool val exit_module : t -> Module.t option + +(** [relcoate_alias_module t ~src_dir] sets the source directory of the alias + module to [src_dir]. Only works if [t] is wrapped. *) +val relocate_alias_module : t -> src_dir:Path.t -> t diff --git a/test/blackbox-tests/test-cases/exe-name-mangle/run.t b/test/blackbox-tests/test-cases/exe-name-mangle/run.t index 4670d89133c..56685fd8b96 100644 --- a/test/blackbox-tests/test-cases/exe-name-mangle/run.t +++ b/test/blackbox-tests/test-cases/exe-name-mangle/run.t @@ -20,7 +20,3 @@ Multiple executables defined in the same directory $ dune build --root multi-exe-same-dir Entering directory 'multi-exe-same-dir' - Error: Multiple rules generated for _build/default/dune__exe.ml-gen: - - :1 - - :1 - [1] From f2188f3f88e577e5d30da9826459ed43ecb03672 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 9 Jul 2019 08:42:21 +0700 Subject: [PATCH 3/5] Enabled wrapped executables in dune Signed-off-by: Rudi Grinberg --- dune-project | 1 + 1 file changed, 1 insertion(+) diff --git a/dune-project b/dune-project index f1a783ba7f3..fb0b076e232 100644 --- a/dune-project +++ b/dune-project @@ -3,6 +3,7 @@ (implicit_transitive_deps false) (generate_opam_files true) +(wrapped_executables true) (license MIT) (maintainers "Jane Street Group, LLC ") From f3fdaae862d7adf12079c2aa4d1d79884e2cedf6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 9 Jul 2019 09:06:13 +0700 Subject: [PATCH 4/5] Simplify wrapping of 1 module exes If an executable has only a single module then it doesn't need wrapping. This saves us from generating and compiling a single source file. Signed-off-by: Rudi Grinberg --- src/modules.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/modules.ml b/src/modules.ml index c2bd6add9b2..8ba3923ccc7 100644 --- a/src/modules.ml +++ b/src/modules.ml @@ -485,9 +485,6 @@ let rec lib_interface = function | Stdlib w -> Stdlib.lib_interface w | Impl { impl = _; vlib } -> lib_interface vlib -let exe_unwrapped m = Unwrapped m -let exe_wrapped ~src_dir ~modules = Wrapped (Wrapped.exe ~src_dir ~modules) - let rec main_module_name = function | Singleton m -> Some (Module.name m) | Unwrapped _ -> None @@ -577,6 +574,12 @@ let singleton_exe m = Module.with_wrapper m ~main_module_name ) +let exe_unwrapped m = Unwrapped m +let exe_wrapped ~src_dir ~modules = + match as_singleton modules with + | None -> Wrapped (Wrapped.exe ~src_dir ~modules) + | Some m -> singleton_exe m + let rec impl_only = function | Stdlib w -> Stdlib.impl_only w | Singleton m -> From 06150aff41e3eb766325f7634c92aa28196f4cdc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 9 Jul 2019 09:16:09 +0700 Subject: [PATCH 5/5] Include -open flags for mangled executables Signed-off-by: Rudi Grinberg --- src/exe_rules.ml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/exe_rules.ml b/src/exe_rules.ml index a74f5762ace..51e4e23c5b2 100644 --- a/src/exe_rules.ml +++ b/src/exe_rules.ml @@ -117,6 +117,15 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander ~link_flags ~promote:exes.promote; + let flags = + match Modules.alias_module modules with + | None -> Ocaml_flags.common flags + | Some m -> + Ocaml_flags.prepend_common + ["-open"; Module.Name.to_string (Module.name m)] flags + |> Ocaml_flags.common + in + (cctx, let objs_dirs = Obj_dir.public_cmi_dir obj_dir @@ -125,7 +134,7 @@ let executables_rules ~sctx ~dir ~dir_kind ~expander in Merlin.make () ~requires:requires_compile - ~flags:(Ocaml_flags.common flags) + ~flags ~preprocess:(Dune_file.Buildable.single_preprocess exes.buildable) (* only public_dir? *) ~objs_dirs)