diff --git a/CHANGES.md b/CHANGES.md index 33d146566b2..2601087d0f2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -162,6 +162,10 @@ Unreleased - Allow depending on `ocamldoc` library when `ocamlfind` is not installed. (#4811, fixes #4809, @nojb) +- Improve lookup of optional or disabled binaries. Previously, we'd treat every + executable with missing libraries as optional. Now, we treat make sure to + look at the library's optional or enabled_if status (#4786). + 2.9.1 (unreleased) ------------------ diff --git a/src/dune_rules/artifacts.mli b/src/dune_rules/artifacts.mli index d1ffffb567e..b61ded677d2 100644 --- a/src/dune_rules/artifacts.mli +++ b/src/dune_rules/artifacts.mli @@ -15,8 +15,6 @@ module Bin : sig -> Action.Prog.t Memo.Build.t val add_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list -> t - - val create : context:Context.t -> local_bins:Path.Build.Set.t -> t end module Public_libs : sig diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index 8654ea6ef94..618784fda08 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -731,6 +731,11 @@ module With_reduced_var_set = struct let expand_str_partial ~context ~dir sw = String_with_vars.expand_as_much_as_possible ~dir:(Path.build dir) sw ~f:(expand_pform_opt ~context ~bindings:Pform.Map.empty ~dir) + + let eval_blang ~context ~dir blang = + Blang.eval + ~f:(expand_pform ~context ~bindings:Pform.Map.empty ~dir) + ~dir:(Path.build dir) blang end let expand_and_eval_set t set ~standard = @@ -744,9 +749,7 @@ let expand_and_eval_set t set ~standard = Ordered_set_lang.eval set ~standard ~eq:String.equal ~parse:(fun ~loc:_ s -> s) -let eval_blang t = function - | Blang.Const x -> Memo.Build.return x (* common case *) - | blang -> - Blang.eval blang ~dir:(Path.build t.dir) ~f:(No_deps.expand_pform t) +let eval_blang t blang = + Blang.eval ~f:(No_deps.expand_pform t) ~dir:(Path.build t.dir) blang let find_package t pkg = t.find_package pkg diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index 303c6cdad07..f65aea054b8 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -130,6 +130,9 @@ module With_reduced_var_set : sig -> dir:Path.Build.t -> String_with_vars.t -> String_with_vars.t Memo.Build.t + + val eval_blang : + context:Context.t -> dir:Path.Build.t -> Blang.t -> bool Memo.Build.t end (** Expand forms of the form (:standard \ foo bar). Expansion is only possible diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index d226bdcdb22..f768ea0eb62 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -461,29 +461,40 @@ let get_installed_binaries stanzas ~(context : Context.t) = binaries_from_install files | Dune_file.Executables ({ install_conf = Some { section = Section Bin; files; _ }; _ } as - exes) -> - let* compile_info = - let project = Scope.project d.scope in - let dune_version = Dune_project.dune_version project in - let+ pps = - Resolve.read_memo_build - (Preprocess.Per_module.with_instrumentation - exes.buildable.preprocess - ~instrumentation_backend: - (Lib.DB.instrumentation_backend (Scope.libs d.scope))) - >>| Preprocess.Per_module.pps - in - Lib.DB.resolve_user_written_deps_for_exes (Scope.libs d.scope) - exes.names exes.buildable.libraries ~pps ~dune_version - ~allow_overlaps:exes.buildable.allow_overlapping_dependencies + exes) -> ( + let* enabled_if = + Expander.With_reduced_var_set.eval_blang ~context ~dir:d.ctx_dir + exes.enabled_if in - let available = - Resolve.is_ok (Lib.Compile.direct_requires compile_info) - in - if available then - binaries_from_install files - else - Memo.Build.return Path.Build.Set.empty + match enabled_if with + | false -> Memo.Build.return Path.Build.Set.empty + | true -> ( + match exes.optional with + | false -> binaries_from_install files + | true -> + let* compile_info = + let project = Scope.project d.scope in + let dune_version = Dune_project.dune_version project in + let+ pps = + Resolve.read_memo_build + (Preprocess.Per_module.with_instrumentation + exes.buildable.preprocess + ~instrumentation_backend: + (Lib.DB.instrumentation_backend (Scope.libs d.scope))) + >>| Preprocess.Per_module.pps + in + Lib.DB.resolve_user_written_deps_for_exes (Scope.libs d.scope) + exes.names exes.buildable.libraries ~pps ~dune_version + ~allow_overlaps: + exes.buildable.allow_overlapping_dependencies + in + let available = + Resolve.is_ok (Lib.Compile.direct_requires compile_info) + in + if available then + binaries_from_install files + else + Memo.Build.return Path.Build.Set.empty)) | _ -> Memo.Build.return Path.Build.Set.empty) >>| Path.Build.Set.union_all) >>| Path.Build.Set.union_all diff --git a/test/blackbox-tests/test-cases/optional-executable.t/run.t b/test/blackbox-tests/test-cases/optional-executable.t/run.t index 15dacb084ba..5fbffc2c26e 100644 --- a/test/blackbox-tests/test-cases/optional-executable.t/run.t +++ b/test/blackbox-tests/test-cases/optional-executable.t/run.t @@ -52,3 +52,110 @@ The following command should fail because the executable is not optional: ^^^^^^^^^^^^^^ Error: Library "does-not-exist" not found. [1] + +A strange behavior discovered in #4786. Dune would ignore an executable if any +of its dependencies were optional. + + $ mkdir optional-binary + $ cd optional-binary + $ cat >dune-project < (lang dune 3.0) + > (package (name myfoo)) + > EOF + + $ mkdir exe + $ cat >exe/bar.ml < print_endline "hello world" + > EOF + $ cat >exe/dune < (executable (public_name dunetestbar) (name bar) (libraries foo)) + > EOF + + $ mkdir lib + $ cat >lib/dune < (library (name foo) (libraries xxx-does-not-exist) (optional) (modules ())) + > EOF + + $ cat >dune < (rule + > (alias run-x) + > (action (echo %{exe:bar.exe}))) + > EOF + + $ dune build @run-x + Error: No rule found for bar.exe + -> required by %{exe:bar.exe} at dune:3 + -> required by alias run-x in dune:1 + [1] + + $ cd .. + +When an optional binray is absent, the parent binary should be present. This is +consistent with how libraries work. #4786 notes that this sort of shadowing is +present even if the binary is not optional. + + $ mkdir optional-binary-absent + $ cd optional-binary-absent + $ cat >dune-project < (lang dune 3.0) + > (package (name myfoo)) + > EOF + + $ mkdir exe + $ cat >exe/bar.ml < print_endline "hello world" + > EOF + $ cat >exe/dune < (executable + > (public_name dunetestbar) + > (libraries doesnotexistatall) + > (name bar)) + > EOF + + $ cat >dune < (rule + > (alias run-x) + > (action (echo "binary path: %{bin:dunetestbar}"))) + > EOF + + $ mkdir bin + $ cat >bin/dunetestbar < #!/usr/bin/env bash + > echo shadow + > EOF + $ chmod +x ./bin/dunetestbar + + $ PATH=./bin:$PATH dune build @run-x + File "exe/dune", line 3, characters 12-29: + 3 | (libraries doesnotexistatall) + ^^^^^^^^^^^^^^^^^ + Error: Library "doesnotexistatall" not found. + [1] + +Optional on the executable should be respected: + + $ cat >exe/dune < (executable + > (public_name dunetestbar) + > (libraries does-not-exist) + > (optional) + > (name bar)) + > EOF + + $ PATH=./bin:$PATH dune build @run-x + binary path: $TESTCASE_ROOT/optional-binary-absent/./bin/dunetestbar + +In the same way as enabled_if: + + $ cat >exe/dune < (executable + > (public_name dunetestbar) + > (enabled_if false) + > (name bar)) + > EOF + + $ PATH=./bin:$PATH dune build @run-x --force + binary path: $TESTCASE_ROOT/optional-binary-absent/./bin/dunetestbar + + $ cd .. +