fix: optional binaries handling

doc/changes/9707.md

@@ -0,0 +1,3 @@
+- Fix handling of `enabled_if` in binary install stanzas. Previously, we'd
+  ignore the result of `enabled_if` when evaluating `%{bin:..}` (#9707,
+  @rgrinberg)

src/dune_rules/artifacts.ml

@@ -8,6 +8,7 @@ type origin =
   { binding : File_binding.Unexpanded.t
   ; dir : Path.Build.t
   ; dst : Path.Local.t
+  ; enabled_if : bool Memo.t
   }
 
 type where =
@@ -16,7 +17,7 @@ type where =
 
 type path =
   | Resolved of Path.Build.t
-  | Origin of origin
+  | Origin of origin list
 
 type local_bins = path Filename.Map.t
 
@@ -42,14 +43,35 @@ let analyze_binary t name =
   | false -> Memo.return (`Resolved (Path.of_filename_relative_to_initial_cwd name))
   | true ->
     let* local_bins = Memo.Lazy.force t.local_bins in
+    let which () =
+      Context.which t.context name
+      >>| function
+      | None -> `None
+      | Some path -> `Resolved path
+    in
     (match Filename.Map.find local_bins name with
      | Some (Resolved p) -> Memo.return (`Resolved (Path.build p))
-     | Some (Origin o) -> Memo.return (`Origin o)
-     | None ->
-       Context.which t.context name
-       >>| (function
-        | None -> `None
-        | Some path -> `Resolved path))
+     | None -> which ()
+     | Some (Origin origins) ->
+       Memo.parallel_map origins ~f:(fun origin ->
+         origin.enabled_if
+         >>| function
+         | true -> Some origin
+         | false -> None)
+       >>| List.filter_opt
+       >>= (function
+        | [] -> which ()
+        | [ x ] -> Memo.return (`Origin x)
+        | x :: rest ->
+          let loc x = File_binding.Unexpanded.loc x.binding in
+          User_error.raise
+            ~loc:(loc x)
+            [ Pp.textf
+                "binary %S is available from more than one definition. It is also \
+                 available in:"
+                name
+            ; Pp.enumerate rest ~f:(fun x -> Pp.verbatim (Loc.to_file_colon_line (loc x)))
+            ]))
 ;;
 
 let binary t ?hint ?(where = Install_dir) ~loc name =
@@ -60,7 +82,7 @@ let binary t ?hint ?(where = Install_dir) ~loc name =
     let context = Context.name t.context in
     Memo.return
     @@ Error (Action.Prog.Not_found.create ~program:name ?hint ~context ~loc ())
-  | `Origin { dir; binding; dst } ->
+  | `Origin { dir; binding; dst; enabled_if = _ } ->
     (match where with
      | Install_dir ->
        let install_dir = Install.Context.bin_dir ~context:(Context.name t.context) in
@@ -100,13 +122,15 @@ let create =
     then Option.value ~default:name (String.drop_suffix name ~suffix:".exe")
     else name
   in
-  fun (context : Context.t) ~local_bins ->
+  fun (context : Context.t)
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
     let local_bins =
       Memo.lazy_ (fun () ->
         let+ local_bins = Memo.Lazy.force local_bins in
-        Filename.Map.foldi local_bins ~init:Filename.Map.empty ~f:(fun name origin acc ->
-          let key = drop_suffix name in
-          Filename.Map.set acc key (Origin origin)))
+        Filename.Map.to_list_map local_bins ~f:(fun name sources ->
+          let sources = Appendable_list.to_list sources in
+          drop_suffix name, Origin sources)
+        |> Filename.Map.of_list_exn)
     in
     { context; local_bins }
 ;;

src/dune_rules/artifacts.mli

@@ -6,6 +6,7 @@ type origin =
   { binding : File_binding.Unexpanded.t
   ; dir : Path.Build.t
   ; dst : Path.Local.t
+  ; enabled_if : bool Memo.t
   }
 
 type where =
@@ -35,7 +36,11 @@ val binary
 
 val binary_available : t -> string -> bool Memo.t
 val add_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list -> t
-val create : Context.t -> local_bins:origin Filename.Map.t Memo.Lazy.t -> t
+
+val create
+  :  Context.t
+  -> local_bins:origin Appendable_list.t Filename.Map.t Memo.Lazy.t
+  -> t
 
 val expand
   : (context:Context.t -> dir:Path.Build.t -> String_with_vars.t -> string Memo.t) Fdecl.t

src/dune_rules/artifacts_db.ml

@@ -36,16 +36,17 @@ let available_exes ~dir (exes : Dune_file.Executables.t) =
 ;;
 
 let get_installed_binaries ~(context : Context.t) stanzas =
-  let merge _ _ x = Some x in
+  let merge _ x y = Some (Appendable_list.( @ ) x y) in
   let open Memo.O in
   let expand ~dir sw = Expander.With_reduced_var_set.expand ~context ~dir sw in
   let expand_str ~dir sw = Expander.With_reduced_var_set.expand_str ~context ~dir sw in
   let expand_str_partial ~dir sw =
     Expander.With_reduced_var_set.expand_str_partial ~context ~dir sw
   in
+  let eval_blang ~dir = Expander.With_reduced_var_set.eval_blang ~dir ~context in
   Memo.List.map stanzas ~f:(fun (d : Dune_file.t) ->
     let dir = Path.Build.append_source (Context.build_dir context) d.dir in
-    let binaries_from_install files =
+    let binaries_from_install ~enabled_if files =
       let* unexpanded_file_bindings =
         Install_entry.File.to_file_bindings_unexpanded files ~expand:(expand ~dir) ~dir
       in
@@ -60,29 +61,34 @@ let get_installed_binaries ~(context : Context.t) stanzas =
         let dst = Path.Local.of_string (Install.Entry.Dst.to_string p) in
         if Path.Local.is_root (Path.Local.parent_exn dst)
         then (
-          let origin = { Artifacts.binding = fb; dir; dst } in
+          let origin = { Artifacts.binding = fb; dir; dst; enabled_if } in
           Some (Path.Local.basename dst, origin))
         else None)
       >>| List.filter_opt
-      >>| Filename.Map.of_list_reduce ~f:(fun _ y -> y)
+      >>| Filename.Map.of_list_reduce ~f:(fun _ y ->
+        (* CR-rgrinberg: we shouldn't allow duplicate bindings, but where's the
+           correct place for this validation? *)
+        y)
+      >>| Filename.Map.map ~f:Appendable_list.singleton
     in
     Memo.List.map d.stanzas ~f:(fun stanza ->
       match Stanza.repr stanza with
-      | Install_conf.T { section = Section Bin; files; _ } -> binaries_from_install files
+      | Install_conf.T { section = Section Bin; files; enabled_if; _ } ->
+        let enabled_if = eval_blang ~dir enabled_if in
+        binaries_from_install ~enabled_if files
       | Dune_file.Executables.T
           ({ install_conf = Some { section = Section Bin; files; _ }; _ } as exes) ->
-        let* available =
-          let* enabled_if =
-            Expander.With_reduced_var_set.eval_blang ~context ~dir exes.enabled_if
-          in
-          match enabled_if with
-          | false -> Memo.return false
+        let enabled_if =
+          let enabled_if = eval_blang ~dir exes.enabled_if in
+          match exes.optional with
+          | false -> enabled_if
           | true ->
-            (match exes.optional with
-             | false -> Memo.return true
+            enabled_if
+            >>= (function
+             | false -> Memo.return false
              | true -> available_exes ~dir exes)
         in
-        if available then binaries_from_install files else Memo.return Filename.Map.empty
+        binaries_from_install ~enabled_if files
       | _ -> Memo.return Filename.Map.empty)
     >>| Filename.Map.union_all ~f:merge)
   >>| Filename.Map.union_all ~f:merge

src/dune_rules/file_binding.ml

@@ -115,6 +115,7 @@ end
 module Unexpanded = struct
   type nonrec t = (String_with_vars.t, String_with_vars.t) t
 
+  let loc t = String_with_vars.loc t.src
   let to_dyn = to_dyn String_with_vars.to_dyn String_with_vars.to_dyn
   let equal = equal String_with_vars.equal_no_loc String_with_vars.equal_no_loc
 

src/dune_rules/file_binding.mli

@@ -21,6 +21,7 @@ module Unexpanded : sig
 
   val to_dyn : t -> Dyn.t
   val equal : t -> t -> bool
+  val loc : t -> Loc.t
 
   val make
     :  src:Loc.t * string

test/blackbox-tests/test-cases/bin-available.t

@@ -37,5 +37,5 @@ Test for %{bin-available:...}
   non existent program: false
   local path foo: false
   local path bar: false
-  disabled binary is available: true
+  disabled binary is available: false
   disabled by enabled_if: false

test/blackbox-tests/test-cases/more-than-one-optional.t

@@ -0,0 +1,31 @@
+Demonstrate an optional executable available from more than one definition
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.13)
+  > (package (name foo))
+  > EOF
+
+  $ mkdir a b
+  $ touch a/foo.ml b/foo.ml
+  $ cat >a/dune <<EOF
+  > (executable
+  >  (public_name foo)
+  >  (enabled_if true))
+  $ cat >b/dune <<EOF
+  > (executable
+  >  (public_name foo)
+  >  (enabled_if true))
+  $ cat >dune <<EOF
+  > (rule
+  >  (alias foo)
+  >  (action (run %{bin:foo})))
+  > EOF
+
+  $ dune build @foo
+  File "a/dune", line 2, characters 14-17:
+  2 |  (public_name foo)
+                    ^^^
+  Error: binary "foo" is available from more than one definition. It is also
+  available in:
+  - b/dune:2
+  [1]