From c255eae58487b53190d43036359fd8f7b3cbd1ea Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Wed, 6 Nov 2019 16:00:16 +0000 Subject: [PATCH 1/5] Add flag [build_foreign_dll_files] to the workspace file Signed-off-by: Andrey Mokhov --- src/dune/context.ml | 19 ++- src/dune/context.mli | 5 + src/dune/dune_file.mli | 2 +- src/dune/exe.ml | 8 +- src/dune/lib_archives.ml | 4 +- src/dune/workspace.ml | 6 + src/dune/workspace.mli | 5 + .../test-cases/foreign-stubs/run.t | 115 ++++++++++++++++++ 8 files changed, 156 insertions(+), 8 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index 9fd341888eb..3f7356f4a35 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -41,6 +41,7 @@ type t = ; profile : Profile.t ; merlin : bool ; fdo_target_exe : Path.t option + ; build_foreign_dll_files : bool ; for_host : t option ; implicit : bool ; build_dir : Path.Build.t @@ -222,7 +223,8 @@ let check_fdo_support has_native ocfg ~name = ] let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets - ~host_context ~host_toolchain ~profile ~fdo_target_exe = + ~host_context ~host_toolchain ~profile ~fdo_target_exe + ~build_foreign_dll_files = let opam_var_cache = Table.create (module String) 128 in ( match kind with | Opam { root = Some root; _ } -> Table.set opam_var_cache "root" root @@ -455,6 +457,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; profile ; merlin ; fdo_target_exe + ; build_foreign_dll_files ; env_nodes ; for_host = host ; build_dir @@ -541,9 +544,11 @@ let extend_paths t ~env = let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var -let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe = +let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe + ~build_foreign_dll_files = let path = Env.path env in create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets ~fdo_target_exe + ~build_foreign_dll_files let opam_version = let res = ref None in @@ -569,7 +574,8 @@ let opam_version = Fiber.Future.wait future let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name - ~merlin ~host_context ~host_toolchain ~fdo_target_exe = + ~merlin ~host_context ~host_toolchain ~fdo_target_exe + ~build_foreign_dll_files = let opam = match Lazy.force opam with | None -> Utils.program_not_found "opam" ~loc:None @@ -619,7 +625,7 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes ~name ~merlin ~host_context - ~host_toolchain ~fdo_target_exe + ~host_toolchain ~fdo_target_exe ~build_foreign_dll_files let instantiate_context env (workspace : Workspace.t) ~(context : Workspace.Context.t) ~host_context = @@ -638,6 +644,7 @@ let instantiate_context env (workspace : Workspace.t) ; paths ; loc = _ ; fdo_target_exe + ; build_foreign_dll_files } -> let merlin = workspace.merlin_context = Some (Workspace.Context.name context) @@ -652,7 +659,7 @@ let instantiate_context env (workspace : Workspace.t) in let env = extend_paths ~env paths in default ~env ~env_nodes ~profile ~targets ~name ~merlin ~host_context - ~host_toolchain ~fdo_target_exe + ~host_toolchain ~fdo_target_exe ~build_foreign_dll_files | Opam { base = { targets @@ -664,6 +671,7 @@ let instantiate_context env (workspace : Workspace.t) ; paths ; loc = _ ; fdo_target_exe + ; build_foreign_dll_files } ; switch ; root @@ -672,6 +680,7 @@ let instantiate_context env (workspace : Workspace.t) let env = extend_paths ~env paths in create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin ~targets ~host_context ~host_toolchain:toolchain ~fdo_target_exe + ~build_foreign_dll_files let create ~env (workspace : Workspace.t) = let rec contexts : t list Fiber.Once.t Context_name.Map.t Lazy.t = diff --git a/src/dune/context.mli b/src/dune/context.mli index afd7ede6dd2..043ed91796d 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -51,6 +51,11 @@ type t = (** [Some path/to/foo.exe] if this contexts is for feedback-directed optimization of target path/to/foo.exe *) ; fdo_target_exe : Path.t option + (* By default Dune builds and installs [dll*.so] archives of foreign + stubs. This is disabled by adding (build_foreign_dll_files false) to + the workspace, in which case Dune will link in all stub archives + statically into the runtime system. *) + ; build_foreign_dll_files : bool (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the host. *) diff --git a/src/dune/dune_file.mli b/src/dune/dune_file.mli index 0966ad4262a..06f1d00b5f9 100644 --- a/src/dune/dune_file.mli +++ b/src/dune/dune_file.mli @@ -220,7 +220,7 @@ module Library : sig val foreign_archives : t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t list - (** The [dll*.a] files of all foreign archives, including foreign stubs. + (** The [dll*.so] files of all foreign archives, including foreign stubs. [dir] is the directory the library is declared in. *) val foreign_dll_files : t -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t list diff --git a/src/dune/exe.ml b/src/dune/exe.ml index 3109c804dd3..cf34151e9b3 100644 --- a/src/dune/exe.ml +++ b/src/dune/exe.ml @@ -49,7 +49,13 @@ module Linkage = struct = let link_mode : Link_mode.t = match m.mode with - | Byte -> Byte + | Byte -> + if ctx.build_foreign_dll_files then + Byte + else + (* When [build_foreign_dll_files] is set to [false] in the workspace, + we link in all stub archives statically into the runtime system. *) + Byte_with_stubs_statically_linked_in | Native -> Native | Best -> if Option.is_some ctx.ocamlopt then diff --git a/src/dune/lib_archives.ml b/src/dune/lib_archives.ml index 693bf888c83..ceca428cdda 100644 --- a/src/dune/lib_archives.ml +++ b/src/dune/lib_archives.ml @@ -72,7 +72,9 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = in let dll_files = if_ - (byte && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries) + ( byte + && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries + && ctx.build_foreign_dll_files ) (Library.foreign_dll_files lib ~dir ~ext_dll) in { lib_files; dll_files } diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index 30e80d2aad9..3175a8f0a03 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -41,6 +41,7 @@ module Context = struct ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list ; fdo_target_exe : Path.t option + ; build_foreign_dll_files : bool } let fdo_suffix t = @@ -61,6 +62,9 @@ module Context = struct and+ toolchain = field_o "toolchain" (Dune_lang.Syntax.since syntax (1, 5) >>> Context_name.decode) + and+ build_foreign_dll_files = + field ~default:true "build_foreign_dll_files" + (Dune_lang.Syntax.since syntax (2, 0) >>> bool) and+ fdo_target_exe = let f file = let ext = Filename.extension file in @@ -112,6 +116,7 @@ module Context = struct ; toolchain ; paths ; fdo_target_exe + ; build_foreign_dll_files } end @@ -209,6 +214,7 @@ module Context = struct ; toolchain = None ; paths = [] ; fdo_target_exe = None + ; build_foreign_dll_files = true } end diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index 8cc3ab5791c..74e8a71bc4d 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -21,6 +21,11 @@ module Context : sig ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list ; fdo_target_exe : Path.t option + (* By default Dune builds and installs [dll*.so] archives of + foreign stubs. This is disabled when [build_foreign_dll_files] + is set to [false], in which case Dune will link in all stub + archives statically into the runtime system. *) + ; build_foreign_dll_files : bool } end diff --git a/test/blackbox-tests/test-cases/foreign-stubs/run.t b/test/blackbox-tests/test-cases/foreign-stubs/run.t index 08968641089..1a43c2de821 100644 --- a/test/blackbox-tests/test-cases/foreign-stubs/run.t +++ b/test/blackbox-tests/test-cases/foreign-stubs/run.t @@ -419,3 +419,118 @@ Testsuite for the (foreign_stubs ...) field. $ ./sdune clean $ ./sdune build + +---------------------------------------------------------------------------------- +* Fails to build a pure bytecode executable with a foreign archive + + $ cat >dune < (executable + > (modes byte) + > (name main) + > (modules main) + > (foreign_archives time)) + > (foreign_library + > (archive_name time) + > (language c) + > (names time)) + > EOF + + $ cat >time.c < #include + > value current_time(value unit) { return Val_int(1345); } + > EOF + + $ cat >main.ml < external current_time : unit -> int = "current_time" + > let () = Printf.printf "clock = %d" (current_time ()) + > EOF + + $ ./sdune clean + $ ./sdune exec ./main.exe + File "dune", line 1, characters 0-80: + 1 | (executable + 2 | (modes byte) + 3 | (name main) + 4 | (modules main) + 5 | (foreign_archives time)) + Error: Pure bytecode executables cannot contain foreign archives. + Hint: If you only need to build a native executable use "(modes exe)". + [1] + +---------------------------------------------------------------------------------- +* Build a bytecode executable by statically linking in a foreign archive when the +setting [build_foreign_dll_files] is [false] in the workspace + + $ cat >dune-workspace < (lang dune 2.0) + > (context + > (default (build_foreign_dll_files false))) + > EOF + + $ ./sdune clean + $ ./sdune exec ./main.exe + clock = 1345 + +---------------------------------------------------------------------------------- +* Fails to install a library with foreign stubs when a [dll*.so] rule is missing + + $ cat >dune-project < (lang dune 1.11) + > (package + > (name foo)) + > EOF + + $ cat >dune-workspace < (lang dune 2.0) + > (context + > (default (build_foreign_dll_files true))) + > EOF + + $ cat >dune < (library + > (public_name foo.clock) + > (name clock) + > (modules clock) + > (self_build_stubs_archive (time))) + > (rule + > (targets time%{ext_obj}) + > (deps time.c) + > (action (run %{ocaml-config:c_compiler} -c -I %{ocaml-config:standard_library} -o %{targets} %{deps}))) + > (rule + > (targets libtime_stubs.a) + > (deps time%{ext_obj}) + > (action (run ar rcs %{targets} %{deps}))) + > EOF + + $ cat >clock.ml < external current_time : unit -> int = "current_time" + > let clock = current_time () + > EOF + + $ cat >clock.mli < val clock : int + > EOF + + $ ./sdune clean + $ ./sdune build @install + File "dune", line 1, characters 0-100: + 1 | (library + 2 | (public_name foo.clock) + 3 | (name clock) + 4 | (modules clock) + 5 | (self_build_stubs_archive (time))) + Error: No rule found for dlltime_stubs$ext_dll + [1] + +---------------------------------------------------------------------------------- +* Succeeds to install a library with foreign stubs when a [dll*.so] rule is missing +but the setting [build_foreign_dll_files] is [false] in the workspace + + $ cat >dune-workspace < (lang dune 2.0) + > (context + > (default (build_foreign_dll_files false))) + > EOF + + $ ./sdune clean + $ ./sdune build @install From 68d2eb26463354073de2f4c539d89af4d2f1d6c5 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 7 Nov 2019 10:13:25 +0000 Subject: [PATCH 2/5] Rename flag, disable unused build rules Signed-off-by: Andrey Mokhov --- src/dune/context.ml | 24 ++++++++++--------- src/dune/context.mli | 6 ++--- src/dune/exe.ml | 11 +++++---- src/dune/lib_archives.ml | 2 +- src/dune/lib_rules.ml | 13 ++++++---- src/dune/workspace.ml | 10 ++++---- src/dune/workspace.mli | 8 +++---- .../test-cases/foreign-stubs/run.t | 15 ++++++++---- 8 files changed, 51 insertions(+), 38 deletions(-) diff --git a/src/dune/context.ml b/src/dune/context.ml index 3f7356f4a35..63595caa2dd 100644 --- a/src/dune/context.ml +++ b/src/dune/context.ml @@ -41,7 +41,7 @@ type t = ; profile : Profile.t ; merlin : bool ; fdo_target_exe : Path.t option - ; build_foreign_dll_files : bool + ; disable_dynamically_linked_foreign_archives : bool ; for_host : t option ; implicit : bool ; build_dir : Path.Build.t @@ -224,7 +224,7 @@ let check_fdo_support has_native ocfg ~name = let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~host_context ~host_toolchain ~profile ~fdo_target_exe - ~build_foreign_dll_files = + ~disable_dynamically_linked_foreign_archives = let opam_var_cache = Table.create (module String) 128 in ( match kind with | Opam { root = Some root; _ } -> Table.set opam_var_cache "root" root @@ -457,7 +457,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; profile ; merlin ; fdo_target_exe - ; build_foreign_dll_files + ; disable_dynamically_linked_foreign_archives ; env_nodes ; for_host = host ; build_dir @@ -545,10 +545,10 @@ let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var let default ~merlin ~env_nodes ~env ~targets ~fdo_target_exe - ~build_foreign_dll_files = + ~disable_dynamically_linked_foreign_archives = let path = Env.path env in create ~kind:Default ~path ~env ~env_nodes ~merlin ~targets ~fdo_target_exe - ~build_foreign_dll_files + ~disable_dynamically_linked_foreign_archives let opam_version = let res = ref None in @@ -575,7 +575,7 @@ let opam_version = let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name ~merlin ~host_context ~host_toolchain ~fdo_target_exe - ~build_foreign_dll_files = + ~disable_dynamically_linked_foreign_archives = let opam = match Lazy.force opam with | None -> Utils.program_not_found "opam" ~loc:None @@ -625,7 +625,8 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes ~name ~merlin ~host_context - ~host_toolchain ~fdo_target_exe ~build_foreign_dll_files + ~host_toolchain ~fdo_target_exe + ~disable_dynamically_linked_foreign_archives let instantiate_context env (workspace : Workspace.t) ~(context : Workspace.Context.t) ~host_context = @@ -644,7 +645,7 @@ let instantiate_context env (workspace : Workspace.t) ; paths ; loc = _ ; fdo_target_exe - ; build_foreign_dll_files + ; disable_dynamically_linked_foreign_archives } -> let merlin = workspace.merlin_context = Some (Workspace.Context.name context) @@ -659,7 +660,8 @@ let instantiate_context env (workspace : Workspace.t) in let env = extend_paths ~env paths in default ~env ~env_nodes ~profile ~targets ~name ~merlin ~host_context - ~host_toolchain ~fdo_target_exe ~build_foreign_dll_files + ~host_toolchain ~fdo_target_exe + ~disable_dynamically_linked_foreign_archives | Opam { base = { targets @@ -671,7 +673,7 @@ let instantiate_context env (workspace : Workspace.t) ; paths ; loc = _ ; fdo_target_exe - ; build_foreign_dll_files + ; disable_dynamically_linked_foreign_archives } ; switch ; root @@ -680,7 +682,7 @@ let instantiate_context env (workspace : Workspace.t) let env = extend_paths ~env paths in create_for_opam ~root ~env_nodes ~env ~profile ~switch ~name ~merlin ~targets ~host_context ~host_toolchain:toolchain ~fdo_target_exe - ~build_foreign_dll_files + ~disable_dynamically_linked_foreign_archives let create ~env (workspace : Workspace.t) = let rec contexts : t list Fiber.Once.t Context_name.Map.t Lazy.t = diff --git a/src/dune/context.mli b/src/dune/context.mli index 043ed91796d..d556f40cffa 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -52,10 +52,10 @@ type t = optimization of target path/to/foo.exe *) ; fdo_target_exe : Path.t option (* By default Dune builds and installs [dll*.so] archives of foreign - stubs. This is disabled by adding (build_foreign_dll_files false) to - the workspace, in which case Dune will link in all stub archives + stubs. By adding (disable_dynamically_linked_foreign_archives true) + to the workspace, we tell Dune to link in all stub archives statically into the runtime system. *) - ; build_foreign_dll_files : bool + ; disable_dynamically_linked_foreign_archives : bool (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the host. *) diff --git a/src/dune/exe.ml b/src/dune/exe.ml index cf34151e9b3..271a59df61a 100644 --- a/src/dune/exe.ml +++ b/src/dune/exe.ml @@ -50,12 +50,13 @@ module Linkage = struct let link_mode : Link_mode.t = match m.mode with | Byte -> - if ctx.build_foreign_dll_files then - Byte - else - (* When [build_foreign_dll_files] is set to [false] in the workspace, - we link in all stub archives statically into the runtime system. *) + if ctx.disable_dynamically_linked_foreign_archives then + (* When [disable_dynamically_linked_foreign_archives] is set to + [true] in the workspace, we link in all stub archives statically + into the runtime system. *) Byte_with_stubs_statically_linked_in + else + Byte | Native -> Native | Best -> if Option.is_some ctx.ocamlopt then diff --git a/src/dune/lib_archives.ml b/src/dune/lib_archives.ml index ceca428cdda..b5a6cdf8b94 100644 --- a/src/dune/lib_archives.ml +++ b/src/dune/lib_archives.ml @@ -74,7 +74,7 @@ let make ~(ctx : Context.t) ~dir ~dir_contents (lib : Library.t) = if_ ( byte && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries - && ctx.build_foreign_dll_files ) + && not ctx.disable_dynamically_linked_foreign_archives ) (Library.foreign_dll_files lib ~dir ~ext_dll) in { lib_files; dll_files } diff --git a/src/dune/lib_rules.ml b/src/dune/lib_rules.ml index ae14bca3244..ea40c21b720 100644 --- a/src/dune/lib_rules.ml +++ b/src/dune/lib_rules.ml @@ -151,9 +151,13 @@ let ocamlmklib ~loc ~c_library_flags ~sctx ~dir ~expander ~o_files ]) in if build_targets_together then - (* Build both the static and dynamic targets in one ocamlmklib invocation. *) + (* Build both the static and dynamic targets in one [ocamlmklib] + invocation, unless dynamically linked foreign archives are disabled. *) build ~sandbox:Sandbox_config.no_special_requirements ~custom:false - [ static_target; dynamic_target ] + ( if ctx.disable_dynamically_linked_foreign_archives then + [ static_target ] + else + [ static_target; dynamic_target ] ) else ( (* Build the static target only by passing the [-custom] flag. *) build ~sandbox:Sandbox_config.no_special_requirements ~custom:true @@ -169,8 +173,9 @@ let ocamlmklib ~loc ~c_library_flags ~sctx ~dir ~expander ~o_files "optional targets", allowing us to run [ocamlmklib] with the [-failsafe] flag, which always produces the static target and sometimes produces the dynamic target too. *) - build ~sandbox:Sandbox_config.needs_sandboxing ~custom:false - [ dynamic_target ] + if not ctx.disable_dynamically_linked_foreign_archives then + build ~sandbox:Sandbox_config.needs_sandboxing ~custom:false + [ dynamic_target ] ) (* Build a static and a dynamic archive for a foreign library. Note that the diff --git a/src/dune/workspace.ml b/src/dune/workspace.ml index 3175a8f0a03..4ce18348d6e 100644 --- a/src/dune/workspace.ml +++ b/src/dune/workspace.ml @@ -41,7 +41,7 @@ module Context = struct ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list ; fdo_target_exe : Path.t option - ; build_foreign_dll_files : bool + ; disable_dynamically_linked_foreign_archives : bool } let fdo_suffix t = @@ -62,8 +62,8 @@ module Context = struct and+ toolchain = field_o "toolchain" (Dune_lang.Syntax.since syntax (1, 5) >>> Context_name.decode) - and+ build_foreign_dll_files = - field ~default:true "build_foreign_dll_files" + and+ disable_dynamically_linked_foreign_archives = + field ~default:false "disable_dynamically_linked_foreign_archives" (Dune_lang.Syntax.since syntax (2, 0) >>> bool) and+ fdo_target_exe = let f file = @@ -116,7 +116,7 @@ module Context = struct ; toolchain ; paths ; fdo_target_exe - ; build_foreign_dll_files + ; disable_dynamically_linked_foreign_archives } end @@ -214,7 +214,7 @@ module Context = struct ; toolchain = None ; paths = [] ; fdo_target_exe = None - ; build_foreign_dll_files = true + ; disable_dynamically_linked_foreign_archives = false } end diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index 74e8a71bc4d..a8272b925b7 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -22,10 +22,10 @@ module Context : sig ; paths : (string * Ordered_set_lang.t) list ; fdo_target_exe : Path.t option (* By default Dune builds and installs [dll*.so] archives of - foreign stubs. This is disabled when [build_foreign_dll_files] - is set to [false], in which case Dune will link in all stub - archives statically into the runtime system. *) - ; build_foreign_dll_files : bool + foreign stubs. If [disable_dynamically_linked_foreign_archives] + is set to [true], Dune will link in all stub archives statically + into the runtime system. *) + ; disable_dynamically_linked_foreign_archives : bool } end diff --git a/test/blackbox-tests/test-cases/foreign-stubs/run.t b/test/blackbox-tests/test-cases/foreign-stubs/run.t index 1a43c2de821..11781b6e5fa 100644 --- a/test/blackbox-tests/test-cases/foreign-stubs/run.t +++ b/test/blackbox-tests/test-cases/foreign-stubs/run.t @@ -459,18 +459,23 @@ Testsuite for the (foreign_stubs ...) field. ---------------------------------------------------------------------------------- * Build a bytecode executable by statically linking in a foreign archive when the -setting [build_foreign_dll_files] is [false] in the workspace +setting [disable_dynamically_linked_foreign_archives] is [true] in the workspace $ cat >dune-workspace < (lang dune 2.0) > (context - > (default (build_foreign_dll_files false))) + > (default (disable_dynamically_linked_foreign_archives true))) > EOF $ ./sdune clean $ ./sdune exec ./main.exe clock = 1345 +---------------------------------------------------------------------------------- +* Make sure no rules are generated for foreign dynamically linked archives + + $ ./sdune build _build/default/dlltime.so + ---------------------------------------------------------------------------------- * Fails to install a library with foreign stubs when a [dll*.so] rule is missing @@ -483,7 +488,7 @@ setting [build_foreign_dll_files] is [false] in the workspace $ cat >dune-workspace < (lang dune 2.0) > (context - > (default (build_foreign_dll_files true))) + > (default (disable_dynamically_linked_foreign_archives false))) > EOF $ cat >dune <dune-workspace < (lang dune 2.0) > (context - > (default (build_foreign_dll_files false))) + > (default (disable_dynamically_linked_foreign_archives true))) > EOF $ ./sdune clean From b3895ce7eb15c5bc54fd73c5c9bff2b1906d590e Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 7 Nov 2019 10:34:09 +0000 Subject: [PATCH 3/5] Update docs and tests Signed-off-by: Andrey Mokhov --- doc/dune-files.rst | 13 ++++++++++--- src/dune/context.mli | 9 +++++---- src/dune/workspace.mli | 8 +++++--- test/blackbox-tests/test-cases/foreign-stubs/run.t | 2 ++ 4 files changed, 22 insertions(+), 10 deletions(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 6a20a560948..d922cdcacc0 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -48,12 +48,12 @@ project: (implicit_transitive_deps ) -When set to ``false``, all dependencies that are directly used by a library +When set to ``false``, all dependencies that are directly used by a library or an executable must be directly added in the ``libraries`` field. We recommend users to experiment with this mode and report any problems. -Starting from dune 2.0, dune disables implicit discovery of transitive -dependencies by default. However, users can still opt in to the old +Starting from dune 2.0, dune disables implicit discovery of transitive +dependencies by default. However, users can still opt in to the old behavior using ``(implicit_transitive_deps true)``. Note that you must use ``threads.posix`` instead of ``threads`` when using this @@ -1686,6 +1686,13 @@ context or can be the description of an opam switch, as follows: feature is **experimental** and no backwards compatibility is implied. +- By default Dune builds and installs dynamically linked foreign + archives (usually named ``dll*.so``). It is possible to disable + this by setting + ``(disable_dynamically_linked_foreign_archives true)`` in the + workspace file, in which case Dune will produce executables where + all foreign archives are statically linked into the runtime system. + Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to setup cross compilation. See :ref:`cross-compilation` for more diff --git a/src/dune/context.mli b/src/dune/context.mli index d556f40cffa..e9d1ec2b43d 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -51,10 +51,11 @@ type t = (** [Some path/to/foo.exe] if this contexts is for feedback-directed optimization of target path/to/foo.exe *) ; fdo_target_exe : Path.t option - (* By default Dune builds and installs [dll*.so] archives of foreign - stubs. By adding (disable_dynamically_linked_foreign_archives true) - to the workspace, we tell Dune to link in all stub archives - statically into the runtime system. *) + (* By default Dune builds and installs dynamically linked foreign + archives (usually named [dll*.so]). It is possible to disable this + by adding (disable_dynamically_linked_foreign_archives true) to the + workspace file, in which case Dune will produce executables where + all foreign archives are statically linked into the runtime system. *) ; disable_dynamically_linked_foreign_archives : bool (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index a8272b925b7..04d1b8be875 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -21,9 +21,11 @@ module Context : sig ; host_context : Context_name.t option ; paths : (string * Ordered_set_lang.t) list ; fdo_target_exe : Path.t option - (* By default Dune builds and installs [dll*.so] archives of - foreign stubs. If [disable_dynamically_linked_foreign_archives] - is set to [true], Dune will link in all stub archives statically + (* By default Dune builds and installs dynamically linked foreign + archives (usually named [dll*.so]). It is possible to disable + this by setting [disable_dynamically_linked_foreign_archives] to + [true] in the workspace file, in which case Dune will produce + executables where all foreign archives are statically linked into the runtime system. *) ; disable_dynamically_linked_foreign_archives : bool } diff --git a/test/blackbox-tests/test-cases/foreign-stubs/run.t b/test/blackbox-tests/test-cases/foreign-stubs/run.t index 11781b6e5fa..178407142e8 100644 --- a/test/blackbox-tests/test-cases/foreign-stubs/run.t +++ b/test/blackbox-tests/test-cases/foreign-stubs/run.t @@ -475,6 +475,8 @@ setting [disable_dynamically_linked_foreign_archives] is [true] in the workspace * Make sure no rules are generated for foreign dynamically linked archives $ ./sdune build _build/default/dlltime.so + Error: Don't know how to build _build/default/dlltime$ext_dll + [1] ---------------------------------------------------------------------------------- * Fails to install a library with foreign stubs when a [dll*.so] rule is missing From 5bf607fda9e782c0c481d3eddfe37c2e45859c24 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 7 Nov 2019 11:13:45 +0000 Subject: [PATCH 4/5] Address feedback Signed-off-by: Andrey Mokhov --- doc/dune-files.rst | 4 ++-- test/blackbox-tests/test-cases/foreign-stubs/run.t | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index d922cdcacc0..ab62798ab91 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -1690,8 +1690,8 @@ context or can be the description of an opam switch, as follows: archives (usually named ``dll*.so``). It is possible to disable this by setting ``(disable_dynamically_linked_foreign_archives true)`` in the - workspace file, in which case Dune will produce executables where - all foreign archives are statically linked into the runtime system. + workspace file, in which case bytecode executables will be built + with all foreign archives statically linked into the runtime system. Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to diff --git a/test/blackbox-tests/test-cases/foreign-stubs/run.t b/test/blackbox-tests/test-cases/foreign-stubs/run.t index 178407142e8..6cadfecb69e 100644 --- a/test/blackbox-tests/test-cases/foreign-stubs/run.t +++ b/test/blackbox-tests/test-cases/foreign-stubs/run.t @@ -446,7 +446,7 @@ Testsuite for the (foreign_stubs ...) field. > EOF $ ./sdune clean - $ ./sdune exec ./main.exe + $ ./sdune exec ./main.bc File "dune", line 1, characters 0-80: 1 | (executable 2 | (modes byte) @@ -468,7 +468,7 @@ setting [disable_dynamically_linked_foreign_archives] is [true] in the workspace > EOF $ ./sdune clean - $ ./sdune exec ./main.exe + $ ./sdune exec ./main.bc clock = 1345 ---------------------------------------------------------------------------------- From 770d0dce68454997034e52d784ce9de3aef96e7a Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 7 Nov 2019 11:16:40 +0000 Subject: [PATCH 5/5] Tweak comments Signed-off-by: Andrey Mokhov --- src/dune/context.mli | 4 ++-- src/dune/workspace.mli | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/dune/context.mli b/src/dune/context.mli index e9d1ec2b43d..f4830b8de32 100644 --- a/src/dune/context.mli +++ b/src/dune/context.mli @@ -54,8 +54,8 @@ type t = (* By default Dune builds and installs dynamically linked foreign archives (usually named [dll*.so]). It is possible to disable this by adding (disable_dynamically_linked_foreign_archives true) to the - workspace file, in which case Dune will produce executables where - all foreign archives are statically linked into the runtime system. *) + workspace file, in which case bytecode executables will be built + with all foreign archives statically linked into the runtime system. *) ; disable_dynamically_linked_foreign_archives : bool (** If this context is a cross-compilation context, you need another context for building tools used for the compilation that run on the diff --git a/src/dune/workspace.mli b/src/dune/workspace.mli index 04d1b8be875..ab8a16a9b07 100644 --- a/src/dune/workspace.mli +++ b/src/dune/workspace.mli @@ -24,9 +24,9 @@ module Context : sig (* By default Dune builds and installs dynamically linked foreign archives (usually named [dll*.so]). It is possible to disable this by setting [disable_dynamically_linked_foreign_archives] to - [true] in the workspace file, in which case Dune will produce - executables where all foreign archives are statically linked - into the runtime system. *) + [true] in the workspace file, in which case bytecode executables + will be built with all foreign archives statically linked into + the runtime system. *) ; disable_dynamically_linked_foreign_archives : bool } end