From add6a9c657b1bff08c01f2dea7d01f67f9f271d9 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 7 Nov 2019 10:13:25 +0000 Subject: [PATCH] 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 3f7356f4a35c..63595caa2dd3 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 043ed91796dc..d556f40cffab 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 cf34151e9b33..271a59df61a1 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 ceca428cdda3..b5a6cdf8b94f 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 ae14bca3244b..ea40c21b7201 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 3175a8f0a03b..4ce18348d6e2 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 74e8a71bc4d5..a8272b925b7c 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 1a43c2de821d..11781b6e5faa 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