ocaml · aalekseyev · Feb 15, 2021 · Feb 16, 2021 · Feb 16, 2021 · Feb 18, 2021
diff --git a/CHANGES.md b/CHANGES.md
@@ -60,6 +60,10 @@ Unreleased
   merlin configuration of a directory (defaulting to the current directory) in
   the Merlin configuration syntax. (#4250, @voodoos)
 
+- It is now possible to define action dependencies through a chain
+   of aliases. Such dependencies are still not available
+   when sandboxing is used, though. (#4238, @aalekseyev)
+
 2.8.2 (21/01/2021)
 ------------------
 

diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml
@@ -98,13 +98,13 @@ module Alias0 = struct
       let path = Path.Build.append_source ctx_dir (File_tree.Dir.path dir) in
       let fn = stamp_file (make ~dir:path name) in
       let fn = Path.build fn in
-      Action_builder.map2 ~f:( && ) acc
+      Action_builder.map2 ~f:( @ ) acc
         (Action_builder.if_file_exists fn
-           ~then_:(Action_builder.path fn >>> Action_builder.return false)
-           ~else_:(Action_builder.return true))
+           ~then_:(Action_builder.path fn >>> Action_builder.return [ fn ])
+           ~else_:(Action_builder.return []))
     in
     File_tree.Dir.fold dir ~traverse:Sub_dirs.Status.Set.normal_only
-      ~init:(Action_builder.return true)
+      ~init:(Action_builder.return [])
       ~f
 
   let dep_rec t ~loc =
@@ -123,26 +123,27 @@ module Alias0 = struct
         }
     | Some dir ->
       let name = Alias.name t in
-      let+ is_empty = dep_rec_internal ~name ~dir ~ctx_dir in
-      if is_empty && not (is_standard name) then
+      let+ stamp_files = dep_rec_internal ~name ~dir ~ctx_dir in
+      if List.is_empty stamp_files && not (is_standard name) then
         User_error.raise ~loc
           [ Pp.text "This alias is empty."
           ; Pp.textf "Alias %S is not defined in %s or any of its descendants."
               (Alias.Name.to_string name)
               (Path.Source.to_string_maybe_quoted src_dir)
-          ]
+          ];
+      stamp_files
 
   let dep_rec_multi_contexts ~dir:src_dir ~name ~contexts =
     let open Action_builder.O in
     let dir = File_tree.find_dir_specified_on_command_line ~dir:src_dir in
-    let+ is_empty_list =
+    let+ stamp_files =
       Action_builder.all
         (List.map contexts ~f:(fun ctx ->
              let ctx_dir = Context_name.build_dir ctx in
              dep_rec_internal ~name ~dir ~ctx_dir))
     in
-    let is_empty = List.for_all is_empty_list ~f:Fun.id in
-    if is_empty && not (is_standard name) then
+    let stamp_files = List.concat stamp_files in
+    if List.is_empty stamp_files && not (is_standard name) then
       User_error.raise
         [ Pp.textf "Alias %S specified on the command line is empty."
             (Alias.Name.to_string name)

diff --git a/src/dune_engine/build_system.mli b/src/dune_engine/build_system.mli
@@ -124,8 +124,10 @@ module Alias : sig
     -> contexts:Context_name.t list
     -> unit Action_builder.t
 
-  (** Implements [(alias_rec ...)] in dependency specification *)
-  val dep_rec : t -> loc:Loc.t -> unit Action_builder.t
+  (** Implements [(alias_rec ...)] in dependency specification.
+      Returns the list of all contributing alias stamp files , as a proxy
+      for alias expansion. *)
+  val dep_rec : t -> loc:Loc.t -> Path.t list Action_builder.t
 
   (** Implements [@alias] on the command line *)
   val dep_rec_multi_contexts :

diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml
@@ -528,7 +528,7 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir
     ~targets:targets_written_by_user ~expander =
   let open Action_builder.O in
   let deps_builder, expander =
-    Dep_conf_eval.named ~expander deps_written_by_user
+    Dep_conf_eval.named ~expander ~alias_expansion:Empty deps_written_by_user
   in
   let expander =
     match (targets_written_by_user : Targets.Or_forbidden.t) with

diff --git a/src/dune_rules/cram_rules.ml b/src/dune_rules/cram_rules.ml
@@ -156,7 +156,7 @@ let rules ~sctx ~expander ~dir tests =
                 | Some deps ->
                   let deps : unit Action_builder.t =
                     let expander = Super_context.expander sctx ~dir in
-                    fst (Dep_conf_eval.named ~expander deps)
+                    fst (Dep_conf_eval.named ~alias_expansion:Empty ~expander deps)
                   in
                   deps :: acc.deps
               in

diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml
@@ -17,7 +17,13 @@ let fold_source_dirs dir ~init ~f =
       ~f:(fun dir acc ->
         f (Path.append_source prefix_with (File_tree.Dir.path dir)) acc)
 
-let dep expander = function
+module Alias_expansion = struct
+  type t =
+    | Empty
+    | Stamp_file
+end
+
+let dep ~(alias_expansion : Alias_expansion.t) expander = function
   | File s ->
     Expander.Static.Or_exn.expand_path expander s
     |> Result.map ~f:(fun path ->
@@ -26,15 +32,22 @@ let dep expander = function
   | Alias s ->
     make_alias expander s
     |> Result.map ~f:(fun a ->
-           let+ () = Action_builder.alias a in
-           [])
+      let+ () = Action_builder.alias a in
+      match alias_expansion with
+      | Empty ->
+        []
+      | Stamp_file ->
+        [ Path.build (Alias.stamp_file a) ]
+    )
   | Alias_rec s ->
     make_alias expander s
     |> Result.map ~f:(fun a ->
-           let+ () =
+           let+ stamp_files =
              Build_system.Alias.dep_rec ~loc:(String_with_vars.loc s) a
            in
-           [])
+           match alias_expansion with
+           | Empty -> []
+           | Stamp_file -> stamp_files)
   | Glob_files { glob = s; recursive } ->
     let loc = String_with_vars.loc s in
     let path = Expander.Static.Or_exn.expand_path expander s in
@@ -126,7 +139,8 @@ let dep expander = function
       (let+ () = Action_builder.dep (Dep.sandbox_config sandbox_config) in
        [])
 
-let dep expander x = Action_builder.of_result (dep expander x)
+let dep ~alias_expansion expander x =
+  Action_builder.of_result (dep ~alias_expansion expander x)
 
 let prepare_expander expander =
   let expander = Expander.set_dep_kind expander Optional in
@@ -136,20 +150,20 @@ let unnamed ~expander l =
   let expander = prepare_expander expander in
   List.fold_left l ~init:(Action_builder.return ()) ~f:(fun acc x ->
       let+ () = acc
-      and+ _x = dep expander x in
+      and+ _x = dep ~alias_expansion:Empty expander x in
       ())
 
-let named ~expander l =
+let named0 ~alias_expansion ~expander l =
   let builders, bindings =
     let expander = prepare_expander expander in
     List.fold_left l ~init:([], Pform.Map.empty)
       ~f:(fun (builders, bindings) x ->
         match x with
-        | Bindings.Unnamed x -> (dep expander x :: builders, bindings)
+        | Bindings.Unnamed x -> (dep ~alias_expansion expander x :: builders, bindings)
         | Named (name, x) ->
           let x =
             Action_builder.memoize ("dep " ^ name)
-              (let+ l = Action_builder.all (List.map x ~f:(dep expander)) in
+              (let+ l = Action_builder.all (List.map x ~f:(dep ~alias_expansion expander)) in
                List.concat l)
           in
           let bindings =
@@ -161,10 +175,17 @@ let named ~expander l =
   in
   let builder =
     let+ l = Action_builder.all (List.rev builders) in
-    Dune_util.Value.L.paths (List.concat l)
+    (List.concat l)
   in
   let builder = Action_builder.memoize "deps" builder in
-  let bindings = Pform.Map.set bindings (Var Deps) builder in
+  builder, bindings
+
+let named ~alias_expansion ~expander l =
+  let builder, bindings = named0 ~alias_expansion ~expander l in
+  let bindings =
+    Pform.Map.set bindings (Var Deps)
+      (Action_builder.map ~f:Dune_util.Value.L.paths builder)
+  in
   let expander = Expander.add_bindings_full expander ~bindings in
   let builder = Action_builder.ignore builder in
   (builder, expander)
diff --git a/src/dune_rules/dep_conf_eval.mli b/src/dune_rules/dep_conf_eval.mli
@@ -6,10 +6,38 @@ open! Dune_engine
 (** Evaluates unnamed dependency specifications. *)
 val unnamed : expander:Expander.t -> Dep_conf.t list -> unit Action_builder.t
 
+(** A variant specifying what set of paths should aliases be expand into. *)
+module Alias_expansion : sig
+  type t =
+    | Empty (** Expand into an empty set of paths. *)
+    | Stamp_file (** Expand into the alias stamp file. *)
+      (* CR-someday aalekseyev:
+         We should add a Full mode where the aliases are expanded to the list of
+         files contained within. *)
+end
+
+(** TODO: get rid of this somehow, making alias expansions work in a more
+    straightforward manner. *)
+val named0 :
+  alias_expansion:Alias_expansion.t
+  -> expander:Expander.t
+  -> Dep_conf.t Bindings.t
+  ->
+  Path.t list Action_builder.t *
+  Dune_util.Value.t list Action_builder.t
+    Pform.Map.t
+
 (** Evaluates named dependency specifications. Return the action build that
     register dependencies as well as an expander that can be used to expand to
-    expand variables from the bindings. *)
+    expand variables from the bindings.
+
+    Aliases may or may not contribute to the final list of files, as specified by
+    [alias_expansion]. Regardless of [alias_expansion], the dependency on alias
+    stamp file is registered.
+
+    It returns bindings that are later used for action expansion. *)
 val named :
-     expander:Expander.t
+  alias_expansion:Alias_expansion.t
+  -> expander:Expander.t
   -> Dep_conf.t Bindings.t
   -> unit Action_builder.t * Expander.t
diff --git a/src/dune_rules/simple_rules.ml b/src/dune_rules/simple_rules.ml
@@ -211,29 +211,34 @@ let alias sctx ?extra_bindings ~dir ~expander (alias_conf : Alias_conf.t) =
   match Expander.eval_blang expander alias_conf.enabled_if with
   | false -> Alias_rules.add_empty sctx ~loc ~alias ~stamp
   | true ->
-    let locks = interpret_locks ~expander alias_conf.locks in
-    let action =
-      let builder, expander = Dep_conf_eval.named ~expander alias_conf.deps in
-      let open Action_builder.With_targets.O in
-      let+ () = Action_builder.with_no_targets builder
-      and+ action =
-        match alias_conf.action with
-        | None ->
-          let builder, _expander =
-            Dep_conf_eval.named ~expander alias_conf.deps
-          in
-          let open Action_builder.With_targets.O in
-          let+ () = Action_builder.with_no_targets builder in
-          Action.empty
-        | Some (loc, action) ->
+    match alias_conf.action with
+    | None ->
+      Dep_conf_eval.named0 ~alias_expansion:Stamp_file ~expander alias_conf.deps
+      |> fun (deps, _bindings) ->
+      let deps =
+        Action_builder.map deps ~f:(fun l -> Path.Set.of_list ( l))
+      in
+      Rules.Produce.Alias.add_deps alias ~dyn_deps:(deps) Path.Set.empty
+    | Some (action_loc, action) ->
+      (* One might think this branch is deprecated in favor of rule with empty deps
+         (in #2681 and #2846), but it's actually used by [Test_rules] module.
+         We could probably make this less confusing by using [rule] instead. *)
+      let locks = interpret_locks ~expander alias_conf.locks in
+      let action =
+        let builder, expander =
+          Dep_conf_eval.named ~alias_expansion:Empty ~expander alias_conf.deps
+        in
+        let open Action_builder.With_targets.O in
+        let+ () = Action_builder.with_no_targets builder
+        and+ action =
           let expander =
             match extra_bindings with
             | None -> expander
             | Some bindings -> Expander.add_bindings expander ~bindings
           in
-          Action_unexpanded.expand action ~loc ~expander ~deps:alias_conf.deps
+          Action_unexpanded.expand action ~loc:action_loc ~expander ~deps:alias_conf.deps
             ~targets:(Forbidden "aliases") ~targets_dir:dir
+        in
+        action
       in
-      action
-    in
-    Alias_rules.add sctx ~loc ~stamp ~locks action ~alias
+      Alias_rules.add sctx ~loc ~stamp ~locks action ~alias
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
@@ -0,0 +1,86 @@
+
+  $ mkdir a
+  $ cd a
+
+  $ cat >dune-project <<EOF
+  > (lang dune 2.9)
+  > EOF
+
+  $ echo old-contents > x
+
+  $ cat >dune <<EOF
+  > (alias
+  >   (name a)
+  >   (deps x)
+  > )
+  > (rule
+  >   (alias b)
+  >   (deps (alias a))
+  >   (action (bash "echo -n \"running b: \"; cat x"))
+  > )
+  > (rule
+  >   (deps (alias a))
+  >   (action (progn (bash "echo -n \"running b: \"; cat x") (with-stdout-to b (bash "cat x"))))
+  > )
+  > EOF
+
+  $ dune build @b
+          bash alias b
+  running b: old-contents
+  $ dune build @b
+
+  $ echo new-contents > x
+  $ dune build @b
+          bash alias b
+  running b: new-contents
+
+^ dune does re-run the action when a dependency declared 
+via an alias changes.
+
+But BUG: the path does not appear in the sandbox:
+
+  $ dune build @b --sandbox copy |& grep -v 'cd _build/.sandbox'
+          bash alias b (exit 1)
+  running b: cat: x: No such file or directory
+
+
+Now test that including an alias into another alias includes its expansion:
+
+  $ cat >dune <<EOF
+  > (alias
+  >   (name a0)
+  >   (deps x)
+  > )
+  > (alias
+  >   (name a)
+  >   (deps (alias a0))
+  > )
+  > (rule
+  >   (alias b)
+  >   (deps (alias a))
+  >   (action (bash "echo -n \"running b: \"; cat x"))
+  > )
+  > (rule
+  >   (deps (alias a))
+  >   (action (progn (bash "echo -n \"running b: \"; cat x") (with-stdout-to b (bash "cat x"))))
+  > )
+  > EOF
+
+  $ rm -r _build
+
+  $ echo old-contents > x
+  $ dune build @b
+          bash alias b
+  running b: old-contents
+  $ dune build @b
+
+  $ echo new-contents > x
+  $ dune build @b
+          bash alias b
+  running b: new-contents
+
+Still BUG: the path does not appear in the sandbox:
+
+  $ dune build @b --sandbox copy |& grep -v 'cd _build/.sandbox'
+          bash alias b (exit 1)
+  running b: cat: x: No such file or directory