Defer computation of local_bins

This fixes a memo dependency cycle between evaluating globs in install
stanzas and populating the artifacts database. Populating the artifacts
database involves enumerating all files installed in the "bin" section
which involves expanding globs as these files can be specified as globs
rather than literal files. Expanding globs in the install stanza
requires loading the rules for the directory containing the glob, and
doing so depends on the artifacts database.

Signed-off-by: Stephen Sherratt <stephen@sherra.tt>

CHANGES.md

@@ -109,6 +109,9 @@ Unreleased
 
 - Add 4.14.0 MSVC to CI (#6917, @jonahbeckford)
 
+- Fix dependency cycle when installing files to the bin section with
+  `glob_files` (#6764, fixes #6708, @gridbugs)
+
 3.6.2 (2022-12-21)
 ------------------
 

src/dune_rules/artifacts.ml

@@ -9,15 +9,23 @@ module Bin = struct
   type t =
     { context : Context.t
     ; (* Mapping from executable names to their actual path in the workspace.
-         The keys are the executable names without the .exe, even on Windows. *)
-      local_bins : Path.Build.t String.Map.t
+         The keys are the executable names without the .exe, even on Windows.
+         Enumerating binaries from install stanzas may involve expanding globs,
+         but the artifacts database is depended on by the logic which expands
+         globs. The computation of this field is deferred to break the cycle. *)
+      local_bins : Path.Build.t String.Map.t Memo.Lazy.t
     }
 
+  let force { local_bins; _ } =
+    let+ (_ : Path.Build.t String.Map.t) = Memo.Lazy.force local_bins in
+    ()
+
   let binary t ?hint ~loc name =
     if not (Filename.is_relative name) then
       Memo.return (Ok (Path.of_filename_relative_to_initial_cwd name))
     else
-      match String.Map.find t.local_bins name with
+      let* local_bins = Memo.Lazy.force t.local_bins in
+      match String.Map.find local_bins name with
       | Some path -> Memo.return (Ok (Path.build path))
       | None -> (
         Context.which t.context name >>| function
@@ -32,7 +40,8 @@ module Bin = struct
       Path.of_filename_relative_to_initial_cwd name
       |> Path.as_outside_build_dir_exn |> Fs_memo.file_exists
     else
-      match String.Map.find t.local_bins name with
+      let* local_bins = Memo.Lazy.force t.local_bins in
+      match String.Map.find local_bins name with
       | Some _ -> Memo.return true
       | None -> (
         Context.which t.context name >>| function
@@ -41,9 +50,13 @@ module Bin = struct
 
   let add_binaries t ~dir l =
     let local_bins =
-      List.fold_left l ~init:t.local_bins ~f:(fun acc fb ->
-          let path = File_binding.Expanded.dst_path fb ~dir:(local_bin dir) in
-          String.Map.set acc (Path.Build.basename path) path)
+      Memo.lazy_ ~name:"Artifacts.Bin.add_binaries" (fun () ->
+          let+ local_bins = Memo.Lazy.force t.local_bins in
+          List.fold_left l ~init:local_bins ~f:(fun acc fb ->
+              let path =
+                File_binding.Expanded.dst_path fb ~dir:(local_bin dir)
+              in
+              String.Map.set acc (Path.Build.basename path) path))
     in
     { t with local_bins }
 

src/dune_rules/artifacts.mli

@@ -3,6 +3,11 @@ open Import
 module Bin : sig
   type t
 
+  (** Force the computation of the internal list of binaries. This is exposed as
+      some error checking is only performed during this computation and some
+      errors will go unreported unless this computation takes place. *)
+  val force : t -> unit Memo.t
+
   val bin_dir_basename : Filename.t
 
   (** [local_bin dir] The directory which contains the local binaries viewed by
@@ -24,7 +29,7 @@ module Bin : sig
     val create : Path.Build.Set.t -> t
   end
 
-  val create : context:Context.t -> local_bins:Local.t -> t
+  val create : context:Context.t -> local_bins:Local.t Memo.Lazy.t -> t
 
   val add_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list -> t
 end
@@ -46,4 +51,5 @@ type t = private
   ; bin : Bin.t
   }
 
-val create : Context.t -> public_libs:Lib.DB.t -> local_bins:Bin.Local.t -> t
+val create :
+  Context.t -> public_libs:Lib.DB.t -> local_bins:Bin.Local.t Memo.Lazy.t -> t

src/dune_rules/artifacts_db.ml

@@ -89,8 +89,11 @@ let all =
       let artifacts =
         Memo.lazy_ @@ fun () ->
         let* public_libs = Scope.DB.public_libs context in
-        let* stanzas = Only_packages.filtered_stanzas context in
-        let+ local_bins = get_installed_binaries ~context stanzas in
+        let+ stanzas = Only_packages.filtered_stanzas context in
+        let local_bins =
+          Memo.lazy_ ~name:"get_installed_binaries" (fun () ->
+              get_installed_binaries ~context stanzas)
+        in
         Artifacts.create context ~public_libs ~local_bins
       in
       (context.name, artifacts))

src/dune_rules/main.ml

@@ -56,6 +56,7 @@ let get () =
   let* conf = Dune_load.load () in
   let* contexts = Context.DB.all () in
   let* scontexts = Memo.Lazy.force Super_context.all in
+  let* () = Super_context.all_init_deferred () in
   Memo.return { conf; contexts; scontexts }
 
 let find_context_exn t ~name =

src/dune_rules/super_context.ml

@@ -30,6 +30,8 @@ let default_context_flags (ctx : Context.t) ~project =
 module Env_tree : sig
   type t
 
+  val force_bin_artifacts : t -> unit Memo.t
+
   val context : t -> Context.t
 
   val get_node : t -> dir:Path.Build.t -> Env_node.t Memo.t
@@ -61,6 +63,9 @@ end = struct
     ; get_node : Path.Build.t -> Env_node.t Memo.t
     }
 
+  let force_bin_artifacts { bin_artifacts; _ } =
+    Artifacts.Bin.force bin_artifacts
+
   let context t = t.context
 
   let get_node t ~dir = t.get_node dir
@@ -502,7 +507,7 @@ let create ~(context : Context.t) ~host ~packages ~stanzas =
     ~bin_artifacts:artifacts.bin ~context_env
 
 let all =
-  Memo.lazy_ (fun () ->
+  Memo.lazy_ ~name:"Super_context.all" (fun () ->
       let open Memo.O in
       let* packages = Only_packages.get ()
       and* contexts = Context.DB.all () in
@@ -538,6 +543,11 @@ let find name =
   let+ all = Memo.Lazy.force all in
   Context_name.Map.find all name
 
+let all_init_deferred () =
+  let* all = Memo.Lazy.force all in
+  Context_name.Map.values all
+  |> Memo.parallel_iter ~f:Env_tree.force_bin_artifacts
+
 module As_memo_key = struct
   type nonrec t = t
 

src/dune_rules/super_context.mli

@@ -9,6 +9,10 @@ type t
 
 val all : t Context_name.Map.t Memo.Lazy.t
 
+(** In order to break circular dependencies within [all], some initialization is
+    deferred *)
+val all_init_deferred : unit -> unit Memo.t
+
 (** Find a super context by name. *)
 val find : Context_name.t -> t option Memo.t
 

test/blackbox-tests/test-cases/install-bin-glob.t

@@ -0,0 +1,36 @@
+Referring to files with a glob in the bin section of the install stanza
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.6)
+  > (package (name foo))
+  > EOF
+
+Make some scripts to install in bin.
+  $ cat >hello.sh <<EOF
+  > #!/bin/sh
+  > echo "Hello, World!"
+  > EOF
+
+  $ cat >foo.sh <<EOF
+  > #!/bin/sh
+  > echo foo
+  > EOF
+
+Refer to the scripts with a glob.
+  $ cat >dune <<EOF
+  > (install
+  >  (section bin)
+  >  (files (glob_files *.sh)))
+  > EOF
+
+  $ dune build @install
+
+  $ find _build/install/default | sort
+  _build/install/default
+  _build/install/default/bin
+  _build/install/default/bin/foo.sh
+  _build/install/default/bin/hello.sh
+  _build/install/default/lib
+  _build/install/default/lib/foo
+  _build/install/default/lib/foo/META
+  _build/install/default/lib/foo/dune-package

test/blackbox-tests/test-cases/install-bin-include.t

@@ -0,0 +1,47 @@
+Referring to files with an include in the bin section of the install stanza
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.6)
+  > (package (name foo))
+  > EOF
+
+Make some scripts to install in bin.
+  $ cat >hello.sh <<EOF
+  > #!/bin/sh
+  > echo "Hello, World!"
+  > EOF
+
+  $ cat >foo.sh <<EOF
+  > #!/bin/sh
+  > echo foo
+  > EOF
+
+Refer to the scripts with an include statement.
+  $ echo '(hello.sh foo.sh)' > files.sexp
+  $ cat >dune <<EOF
+  > (install
+  >  (section bin)
+  >  (files (include files.sexp)))
+  > EOF
+
+  $ dune build @install
+
+Refer to the scripts literally.
+
+  $ cat >dune <<EOF
+  > (install
+  >  (section bin)
+  >  (files hello.sh foo.sh))
+  > EOF
+
+  $ dune build @install
+
+  $ find _build/install/default | sort
+  _build/install/default
+  _build/install/default/bin
+  _build/install/default/bin/foo.sh
+  _build/install/default/bin/hello.sh
+  _build/install/default/lib
+  _build/install/default/lib/foo
+  _build/install/default/lib/foo/META
+  _build/install/default/lib/foo/dune-package