diff --git a/CHANGES.md b/CHANGES.md index 953e58b7a0f..f1ea89907d7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -230,6 +230,8 @@ Unreleased - Run each action in its own process group so that we don't leave stray processes behind when killing actions (#4998, @jeremiedimino) +- Add an option `expand_aliases_in_sandbox` (#...., @jeremiedimino) + 2.9.1 (07/09/2021) ------------------ diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 2760de9fe22..60796c2eb39 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -165,6 +165,27 @@ compilation. Explicit JS targets declared like this will be attached to the Starting with Dune 2.0, this behaviour is the default, and there is no way to disable it. +expand_aliases_in_sandbox +------------------------- + +When a sandboxed action depends on a alias, copy the expansion of the +alias inside the sandbox. For instance, in the following example: + +.. code:: scheme + + (alias + (name foo) + (deps ../x)) + + (cram + (deps (alias foo))) + +File `x` will be visible inside the cram test if and only if this +option is enabled. This option is a better default in general, however +it currently causes cram tests to run noticeably slower. So it is +disabled by default until the performance issue with cram test is +fixed. + .. _dialect: dialect diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 0a350daa040..424ca0e14aa 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -1487,9 +1487,7 @@ end = struct Path.mkdir_p (Path.build (sandboxed path))); Path.mkdir_p (Path.build (sandboxed dir)); let deps = - if - Execution_parameters.should_expand_aliases_when_sandboxing - execution_parameters + if Execution_parameters.expand_aliases_in_sandbox execution_parameters then Dep.Facts.paths deps else diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 67da6dbda77..052db80a214 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -159,6 +159,7 @@ type t = ; subst_config : Subst_config.t option ; strict_package_deps : bool ; cram : bool + ; expand_aliases_in_sandbox : bool } let equal = ( == ) @@ -222,6 +223,7 @@ let to_dyn ; subst_config ; strict_package_deps ; cram + ; expand_aliases_in_sandbox } = let open Dyn.Encoder in record @@ -248,6 +250,7 @@ let to_dyn ; ("subst_config", option Subst_config.to_dyn subst_config) ; ("strict_package_deps", bool strict_package_deps) ; ("cram", bool cram) + ; ("expand_aliases_in_sandbox", bool expand_aliases_in_sandbox) ] let find_extension_args t key = Univ_map.find t.extension_args key @@ -467,6 +470,8 @@ let accept_alternative_dune_file_name_default ~(lang : Lang.Instance.t) = let cram_default ~(lang : Lang.Instance.t) = lang.version >= (3, 0) +let expand_aliases_in_sandbox_default ~lang:_ = false + let use_standard_c_and_cxx_flags_default ~(lang : Lang.Instance.t) = if lang.version >= (3, 0) then Some true @@ -514,6 +519,7 @@ let infer ~dir ?(info = Package.Info.empty) packages = let explicit_js_mode = explicit_js_mode_default ~lang in let strict_package_deps = strict_package_deps_default ~lang in let cram = cram_default ~lang in + let expand_aliases_in_sandbox = expand_aliases_in_sandbox_default ~lang in let root = dir in let file_key = File_key.make ~root ~name in { name @@ -539,6 +545,7 @@ let infer ~dir ?(info = Package.Info.empty) packages = ; subst_config = None ; strict_package_deps ; cram + ; expand_aliases_in_sandbox } module Toggle = struct @@ -614,6 +621,7 @@ let encode : t -> Dune_lang.t list = ; file_key = _ ; project_file = _ ; root = _ + ; expand_aliases_in_sandbox } -> let open Dune_lang.Encoder in let lang = Lang.get_exn "dune" in @@ -662,6 +670,8 @@ let encode : t -> Dune_lang.t list = None else Some (constr "cram" Toggle.encode (Toggle.of_bool cram))) + ; flag "expand_aliases_in_sandbox" expand_aliases_in_sandbox + expand_aliases_in_sandbox_default ] in let lang_stanza = @@ -767,6 +777,9 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status = and+ cram = Toggle.field "cram" ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 7)) + and+ expand_aliases_in_sandbox = + field_o_b "expand_aliases_in_sandbox" + ~check:(Dune_lang.Syntax.since Stanza.syntax (3, 0)) in let packages = if List.is_empty packages then @@ -898,6 +911,10 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status = | None -> cram_default ~lang | Some t -> Toggle.enabled t in + let expand_aliases_in_sandbox = + Option.value expand_aliases_in_sandbox + ~default:(expand_aliases_in_sandbox_default ~lang) + in let root = dir in let file_key = File_key.make ~name ~root in let dialects = @@ -946,6 +963,7 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status = ; subst_config ; strict_package_deps ; cram + ; expand_aliases_in_sandbox })) let load_dune_project ~dir opam_packages ~dir_status = @@ -1001,4 +1019,7 @@ let cram t = t.cram let info t = t.info let update_execution_parameters t ep = - Execution_parameters.set_dune_version t.dune_version ep + ep + |> Execution_parameters.set_dune_version t.dune_version + |> Execution_parameters.set_expand_aliases_in_sandbox + t.expand_aliases_in_sandbox diff --git a/src/dune_engine/execution_parameters.ml b/src/dune_engine/execution_parameters.ml index cf7cc65c40c..1ba28130c2c 100644 --- a/src/dune_engine/execution_parameters.ml +++ b/src/dune_engine/execution_parameters.ml @@ -23,36 +23,54 @@ type t = { dune_version : Dune_lang.Syntax.Version.t ; action_stdout_on_success : Action_output_on_success.t ; action_stderr_on_success : Action_output_on_success.t + ; expand_aliases_in_sandbox : bool } -let equal { dune_version; action_stdout_on_success; action_stderr_on_success } t - = +let equal + { dune_version + ; action_stdout_on_success + ; action_stderr_on_success + ; expand_aliases_in_sandbox + } t = Dune_lang.Syntax.Version.equal dune_version t.dune_version && Action_output_on_success.equal action_stdout_on_success t.action_stdout_on_success && Action_output_on_success.equal action_stderr_on_success t.action_stderr_on_success - -let hash { dune_version; action_stdout_on_success; action_stderr_on_success } = + && Bool.equal expand_aliases_in_sandbox t.expand_aliases_in_sandbox + +let hash + { dune_version + ; action_stdout_on_success + ; action_stderr_on_success + ; expand_aliases_in_sandbox + } = Hashtbl.hash ( Dune_lang.Syntax.Version.hash dune_version , Action_output_on_success.hash action_stdout_on_success - , Action_output_on_success.hash action_stderr_on_success ) - -let to_dyn { dune_version; action_stdout_on_success; action_stderr_on_success } - = + , Action_output_on_success.hash action_stderr_on_success + , expand_aliases_in_sandbox ) + +let to_dyn + { dune_version + ; action_stdout_on_success + ; action_stderr_on_success + ; expand_aliases_in_sandbox + } = Dyn.Record [ ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version) ; ( "action_stdout_on_success" , Action_output_on_success.to_dyn action_stdout_on_success ) ; ( "action_stderr_on_success" , Action_output_on_success.to_dyn action_stderr_on_success ) + ; ("expand_aliases_in_sandbox", Bool expand_aliases_in_sandbox) ] let builtin_default = { dune_version = Stanza.latest_version ; action_stdout_on_success = Print ; action_stderr_on_success = Print + ; expand_aliases_in_sandbox = true } let set_dune_version x t = { t with dune_version = x } @@ -61,12 +79,14 @@ let set_action_stdout_on_success x t = { t with action_stdout_on_success = x } let set_action_stderr_on_success x t = { t with action_stderr_on_success = x } +let set_expand_aliases_in_sandbox x t = { t with expand_aliases_in_sandbox = x } + let dune_version t = t.dune_version let should_remove_write_permissions_on_generated_files t = t.dune_version >= (2, 4) -let should_expand_aliases_when_sandboxing t = t.dune_version >= (3, 0) +let expand_aliases_in_sandbox t = t.expand_aliases_in_sandbox let action_stdout_on_success t = t.action_stdout_on_success diff --git a/src/dune_engine/execution_parameters.mli b/src/dune_engine/execution_parameters.mli index c7cc84ba37a..5425715a7ab 100644 --- a/src/dune_engine/execution_parameters.mli +++ b/src/dune_engine/execution_parameters.mli @@ -50,6 +50,8 @@ val set_action_stdout_on_success : Action_output_on_success.t -> t -> t val set_action_stderr_on_success : Action_output_on_success.t -> t -> t +val set_expand_aliases_in_sandbox : bool -> t -> t + (** As configured by [init] *) val default : t Memo.Build.t @@ -59,7 +61,7 @@ val dune_version : t -> Dune_lang.Syntax.Version.t val should_remove_write_permissions_on_generated_files : t -> bool -val should_expand_aliases_when_sandboxing : t -> bool +val expand_aliases_in_sandbox : t -> bool val action_stdout_on_success : t -> Action_output_on_success.t diff --git a/test/blackbox-tests/test-cases/depend-on/dep-on-alias.t/run.t b/test/blackbox-tests/test-cases/depend-on/dep-on-alias.t/run.t index a3b5a1473b2..6bef3410399 100644 --- a/test/blackbox-tests/test-cases/depend-on/dep-on-alias.t/run.t +++ b/test/blackbox-tests/test-cases/depend-on/dep-on-alias.t/run.t @@ -4,6 +4,7 @@ $ cat >dune-project < (lang dune 3.0) + > (expand_aliases_in_sandbox) > EOF $ echo old-contents > x $ cat >dune < dune-project + $ cat >dune-project < (lang dune 3.0) + > (expand_aliases_in_sandbox) + > EOF Now test that including an alias into another alias includes its expansion: $ cat >dune <