Add (env var) dependencies
Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
parent
fb53dcca01
commit
74db582b04
|
@ -44,6 +44,9 @@ next
|
||||||
|
|
||||||
- Fix the flags passed to the ppx rewriter when using `staged_pps` (#1218, @diml)
|
- Fix the flags passed to the ppx rewriter when using `staged_pps` (#1218, @diml)
|
||||||
|
|
||||||
|
- Add `(env var)` to add a dependency to an environment variable.
|
||||||
|
(#1186, @emillon)
|
||||||
|
|
||||||
1.1.1 (08/08/2018)
|
1.1.1 (08/08/2018)
|
||||||
------------------
|
------------------
|
||||||
|
|
||||||
|
|
|
@ -1003,7 +1003,7 @@ let rules =
|
||||||
Format.pp_print_string ppf (Path.to_string p)))
|
Format.pp_print_string ppf (Path.to_string p)))
|
||||||
(Path.Set.to_list rule.targets)
|
(Path.Set.to_list rule.targets)
|
||||||
(fun ppf ->
|
(fun ppf ->
|
||||||
Path.Set.iter rule.deps ~f:(fun dep ->
|
Path.Set.iter (Deps.paths rule.deps) ~f:(fun dep ->
|
||||||
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
||||||
Dsexp.pp_split_strings (sexp_of_action rule.action))
|
Dsexp.pp_split_strings (sexp_of_action rule.action))
|
||||||
end else begin
|
end else begin
|
||||||
|
@ -1014,7 +1014,7 @@ let rules =
|
||||||
in
|
in
|
||||||
Dsexp.To_sexp.record (
|
Dsexp.To_sexp.record (
|
||||||
List.concat
|
List.concat
|
||||||
[ [ "deps" , paths rule.deps
|
[ [ "deps" , Deps.to_sexp rule.deps
|
||||||
; "targets", paths rule.targets ]
|
; "targets", paths rule.targets ]
|
||||||
; (match rule.context with
|
; (match rule.context with
|
||||||
| None -> []
|
| None -> []
|
||||||
|
|
|
@ -1250,6 +1250,9 @@ syntax:
|
||||||
- ``(package <pkg>)`` depend on all files installed by ``<package>``, as well
|
- ``(package <pkg>)`` depend on all files installed by ``<package>``, as well
|
||||||
as on the transitive package dependencies of ``<package>``. This can be used
|
as on the transitive package dependencies of ``<package>``. This can be used
|
||||||
to test a command against the files that will be installed
|
to test a command against the files that will be installed
|
||||||
|
- ``(env <var>)``: depend on the value of the environment variable ``<var>``.
|
||||||
|
If this variable becomes set, becomes unset, or changes value, the target
|
||||||
|
will be rebuilt.
|
||||||
|
|
||||||
In all these cases, the argument supports `Variables expansion`_.
|
In all these cases, the argument supports `Variables expansion`_.
|
||||||
|
|
||||||
|
|
|
@ -789,13 +789,22 @@ module Infer = struct
|
||||||
(Unexp.infer t).targets
|
(Unexp.infer t).targets
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let symlink_managed_paths sandboxed deps =
|
||||||
|
let steps =
|
||||||
|
Path.Set.fold (Deps.paths deps)
|
||||||
|
~init:[]
|
||||||
|
~f:(fun path acc ->
|
||||||
|
if Path.is_managed path then
|
||||||
|
Symlink (path, sandboxed path)::acc
|
||||||
|
else
|
||||||
|
acc
|
||||||
|
)
|
||||||
|
in
|
||||||
|
Progn steps
|
||||||
|
|
||||||
let sandbox t ~sandboxed ~deps ~targets : t =
|
let sandbox t ~sandboxed ~deps ~targets : t =
|
||||||
Progn
|
Progn
|
||||||
[ Progn (List.filter_map deps ~f:(fun path ->
|
[ symlink_managed_paths sandboxed deps
|
||||||
if Path.is_managed path then
|
|
||||||
Some (Symlink (path, sandboxed path))
|
|
||||||
else
|
|
||||||
None))
|
|
||||||
; map t
|
; map t
|
||||||
~dir:Path.root
|
~dir:Path.root
|
||||||
~f_string:(fun ~dir:_ x -> x)
|
~f_string:(fun ~dir:_ x -> x)
|
||||||
|
|
|
@ -125,6 +125,6 @@ end
|
||||||
val sandbox
|
val sandbox
|
||||||
: t
|
: t
|
||||||
-> sandboxed:(Path.t -> Path.t)
|
-> sandboxed:(Path.t -> Path.t)
|
||||||
-> deps:Path.t list
|
-> deps:Deps.t
|
||||||
-> targets:Path.t list
|
-> targets:Path.t list
|
||||||
-> t
|
-> t
|
||||||
|
|
|
@ -29,6 +29,7 @@ module Repr = struct
|
||||||
| Memo : 'a memo -> (unit, 'a) t
|
| Memo : 'a memo -> (unit, 'a) t
|
||||||
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
|
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
|
||||||
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
|
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
|
||||||
|
| Env_var : string -> ('a, 'a) t
|
||||||
|
|
||||||
and 'a memo =
|
and 'a memo =
|
||||||
{ name : string
|
{ name : string
|
||||||
|
@ -39,7 +40,7 @@ module Repr = struct
|
||||||
and 'a memo_state =
|
and 'a memo_state =
|
||||||
| Unevaluated
|
| Unevaluated
|
||||||
| Evaluating
|
| Evaluating
|
||||||
| Evaluated of 'a * Path.Set.t
|
| Evaluated of 'a * Deps.t
|
||||||
|
|
||||||
and ('a, 'b) if_file_exists_state =
|
and ('a, 'b) if_file_exists_state =
|
||||||
| Undecided of ('a, 'b) t * ('a, 'b) t
|
| Undecided of ('a, 'b) t * ('a, 'b) t
|
||||||
|
@ -118,6 +119,8 @@ let dyn_paths t = Dyn_paths (t >>^ Path.Set.of_list)
|
||||||
let dyn_path_set t = Dyn_paths t
|
let dyn_path_set t = Dyn_paths t
|
||||||
let paths_for_rule ps = Paths_for_rule ps
|
let paths_for_rule ps = Paths_for_rule ps
|
||||||
|
|
||||||
|
let env_var s = Env_var s
|
||||||
|
|
||||||
let catch t ~on_error = Catch (t, on_error)
|
let catch t ~on_error = Catch (t, on_error)
|
||||||
|
|
||||||
let contents p = Contents p
|
let contents p = Contents p
|
||||||
|
|
|
@ -66,6 +66,10 @@ val path_set : Path.Set.t -> ('a, 'a) t
|
||||||
of the action produced by the build arrow. *)
|
of the action produced by the build arrow. *)
|
||||||
val paths_glob : loc:Loc.t -> dir:Path.t -> Re.re -> ('a, Path.Set.t) t
|
val paths_glob : loc:Loc.t -> dir:Path.t -> Re.re -> ('a, Path.Set.t) t
|
||||||
|
|
||||||
|
(** [env_var v] records [v] as an environment variable that is read by the
|
||||||
|
action produced by the build arrow. *)
|
||||||
|
val env_var : string -> ('a, 'a) t
|
||||||
|
|
||||||
(** Compute the set of source of all files present in the sub-tree
|
(** Compute the set of source of all files present in the sub-tree
|
||||||
starting at [dir] and record them as dependencies. *)
|
starting at [dir] and record them as dependencies. *)
|
||||||
val source_tree
|
val source_tree
|
||||||
|
@ -197,6 +201,7 @@ module Repr : sig
|
||||||
| Memo : 'a memo -> (unit, 'a) t
|
| Memo : 'a memo -> (unit, 'a) t
|
||||||
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
|
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
|
||||||
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
|
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
|
||||||
|
| Env_var : string -> ('a, 'a) t
|
||||||
|
|
||||||
and 'a memo =
|
and 'a memo =
|
||||||
{ name : string
|
{ name : string
|
||||||
|
@ -207,7 +212,7 @@ module Repr : sig
|
||||||
and 'a memo_state =
|
and 'a memo_state =
|
||||||
| Unevaluated
|
| Unevaluated
|
||||||
| Evaluating
|
| Evaluating
|
||||||
| Evaluated of 'a * Path.Set.t (* dynamic dependencies *)
|
| Evaluated of 'a * Deps.t (* dynamic dependencies *)
|
||||||
|
|
||||||
and ('a, 'b) if_file_exists_state =
|
and ('a, 'b) if_file_exists_state =
|
||||||
| Undecided of ('a, 'b) t * ('a, 'b) t
|
| Undecided of ('a, 'b) t * ('a, 'b) t
|
||||||
|
|
|
@ -20,8 +20,8 @@ end
|
||||||
|
|
||||||
module Static_deps = struct
|
module Static_deps = struct
|
||||||
type t =
|
type t =
|
||||||
{ rule_deps : Path.Set.t
|
{ rule_deps : Deps.t
|
||||||
; action_deps : Path.Set.t
|
; action_deps : Deps.t
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -67,13 +67,13 @@ let static_deps t ~all_targets ~file_tree =
|
||||||
| Second t -> loop t acc targets_allowed
|
| Second t -> loop t acc targets_allowed
|
||||||
| Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
|
| Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
|
||||||
| Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
|
| Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
|
||||||
| Paths fns -> { acc with action_deps = Path.Set.union fns acc.action_deps }
|
| Paths fns -> { acc with action_deps = Deps.add_paths acc.action_deps fns }
|
||||||
| Paths_for_rule fns ->
|
| Paths_for_rule fns ->
|
||||||
{ acc with rule_deps = Path.Set.union fns acc.rule_deps }
|
{ acc with rule_deps = Deps.add_paths acc.rule_deps fns }
|
||||||
| Paths_glob state -> begin
|
| Paths_glob state -> begin
|
||||||
match !state with
|
match !state with
|
||||||
| G_evaluated l ->
|
| G_evaluated l ->
|
||||||
{ acc with action_deps = Path.Set.union acc.action_deps l }
|
{ acc with action_deps = Deps.add_paths acc.action_deps l }
|
||||||
| G_unevaluated (loc, dir, re) ->
|
| G_unevaluated (loc, dir, re) ->
|
||||||
let targets = all_targets ~dir in
|
let targets = all_targets ~dir in
|
||||||
let result =
|
let result =
|
||||||
|
@ -95,7 +95,7 @@ let static_deps t ~all_targets ~file_tree =
|
||||||
()
|
()
|
||||||
end;
|
end;
|
||||||
state := G_evaluated result;
|
state := G_evaluated result;
|
||||||
let action_deps = Path.Set.union result acc.action_deps in
|
let action_deps = Deps.add_paths acc.action_deps result in
|
||||||
{ acc with action_deps }
|
{ acc with action_deps }
|
||||||
end
|
end
|
||||||
| If_file_exists (p, state) -> begin
|
| If_file_exists (p, state) -> begin
|
||||||
|
@ -114,18 +114,19 @@ let static_deps t ~all_targets ~file_tree =
|
||||||
end
|
end
|
||||||
| Dyn_paths t -> loop t acc targets_allowed
|
| Dyn_paths t -> loop t acc targets_allowed
|
||||||
| Vpath (Vspec.T (p, _)) ->
|
| Vpath (Vspec.T (p, _)) ->
|
||||||
{ acc with rule_deps = Path.Set.add acc.rule_deps p }
|
{ acc with rule_deps = Deps.add_path acc.rule_deps p }
|
||||||
| Contents p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
|
| Contents p -> { acc with rule_deps = Deps.add_path acc.rule_deps p }
|
||||||
| Lines_of p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
|
| Lines_of p -> { acc with rule_deps = Deps.add_path acc.rule_deps p }
|
||||||
| Record_lib_deps _ -> acc
|
| Record_lib_deps _ -> acc
|
||||||
| Fail _ -> acc
|
| Fail _ -> acc
|
||||||
| Memo m -> loop m.t acc targets_allowed
|
| Memo m -> loop m.t acc targets_allowed
|
||||||
| Catch (t, _) -> loop t acc targets_allowed
|
| Catch (t, _) -> loop t acc targets_allowed
|
||||||
| Lazy_no_targets t -> loop (Lazy.force t) acc false
|
| Lazy_no_targets t -> loop (Lazy.force t) acc false
|
||||||
|
| Env_var var -> { acc with action_deps = Deps.add_env_var acc.action_deps var }
|
||||||
in
|
in
|
||||||
loop (Build.repr t)
|
loop (Build.repr t)
|
||||||
{ rule_deps = Path.Set.empty
|
{ rule_deps = Deps.empty
|
||||||
; action_deps = Path.Set.empty
|
; action_deps = Deps.empty
|
||||||
}
|
}
|
||||||
true
|
true
|
||||||
|
|
||||||
|
@ -155,6 +156,7 @@ let lib_deps =
|
||||||
| Memo m -> loop m.t acc
|
| Memo m -> loop m.t acc
|
||||||
| Catch (t, _) -> loop t acc
|
| Catch (t, _) -> loop t acc
|
||||||
| Lazy_no_targets t -> loop (Lazy.force t) acc
|
| Lazy_no_targets t -> loop (Lazy.force t) acc
|
||||||
|
| Env_var _ -> acc
|
||||||
in
|
in
|
||||||
fun t -> loop (Build.repr t) Lib_name.Map.empty
|
fun t -> loop (Build.repr t) Lib_name.Map.empty
|
||||||
|
|
||||||
|
@ -198,6 +200,7 @@ let targets =
|
||||||
| Memo m -> loop m.t acc
|
| Memo m -> loop m.t acc
|
||||||
| Catch (t, _) -> loop t acc
|
| Catch (t, _) -> loop t acc
|
||||||
| Lazy_no_targets _ -> acc
|
| Lazy_no_targets _ -> acc
|
||||||
|
| Env_var _ -> acc
|
||||||
in
|
in
|
||||||
fun t -> loop (Build.repr t) []
|
fun t -> loop (Build.repr t) []
|
||||||
|
|
||||||
|
|
|
@ -35,8 +35,8 @@ end
|
||||||
|
|
||||||
module Static_deps : sig
|
module Static_deps : sig
|
||||||
type t =
|
type t =
|
||||||
{ rule_deps : Path.Set.t
|
{ rule_deps : Deps.t
|
||||||
; action_deps : Path.Set.t
|
; action_deps : Deps.t
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -37,10 +37,10 @@ let files_in_source_tree_to_delete () =
|
||||||
Promoted_to_delete.load ()
|
Promoted_to_delete.load ()
|
||||||
|
|
||||||
module Exec_status = struct
|
module Exec_status = struct
|
||||||
type rule_evaluation = (Action.t * Path.Set.t) Fiber.Future.t
|
type rule_evaluation = (Action.t * Deps.t) Fiber.Future.t
|
||||||
type rule_execution = unit Fiber.Future.t
|
type rule_execution = unit Fiber.Future.t
|
||||||
|
|
||||||
type eval_rule = unit -> (Action.t * Path.Set.t) Fiber.t
|
type eval_rule = unit -> (Action.t * Deps.t) Fiber.t
|
||||||
type exec_rule = rule_evaluation -> unit Fiber.t
|
type exec_rule = rule_evaluation -> unit Fiber.t
|
||||||
|
|
||||||
module Evaluating_rule = struct
|
module Evaluating_rule = struct
|
||||||
|
@ -139,8 +139,8 @@ module Internal_rule = struct
|
||||||
dependency paths. *)
|
dependency paths. *)
|
||||||
let root =
|
let root =
|
||||||
{ id = Id.gen ()
|
{ id = Id.gen ()
|
||||||
; static_deps = lazy { rule_deps = Path.Set.empty
|
; static_deps = lazy { rule_deps = Deps.empty
|
||||||
; action_deps = Path.Set.empty
|
; action_deps = Deps.empty
|
||||||
}
|
}
|
||||||
; targets = Path.Set.empty
|
; targets = Path.Set.empty
|
||||||
; context = None
|
; context = None
|
||||||
|
@ -484,7 +484,7 @@ module Build_exec = struct
|
||||||
|
|
||||||
let exec bs t x =
|
let exec bs t x =
|
||||||
let rec exec
|
let rec exec
|
||||||
: type a b. Path.Set.t ref -> (a, b) t -> a -> b = fun dyn_deps t x ->
|
: type a b. Deps.t ref -> (a, b) t -> a -> b = fun dyn_deps t x ->
|
||||||
match t with
|
match t with
|
||||||
| Arr f -> f x
|
| Arr f -> f x
|
||||||
| Targets _ -> x
|
| Targets _ -> x
|
||||||
|
@ -519,7 +519,7 @@ module Build_exec = struct
|
||||||
Option.value_exn file.data
|
Option.value_exn file.data
|
||||||
| Dyn_paths t ->
|
| Dyn_paths t ->
|
||||||
let fns = exec dyn_deps t x in
|
let fns = exec dyn_deps t x in
|
||||||
dyn_deps := Path.Set.union !dyn_deps fns;
|
dyn_deps := Deps.add_paths !dyn_deps fns;
|
||||||
x
|
x
|
||||||
| Record_lib_deps _ -> x
|
| Record_lib_deps _ -> x
|
||||||
| Fail { fail } -> fail ()
|
| Fail { fail } -> fail ()
|
||||||
|
@ -533,26 +533,28 @@ module Build_exec = struct
|
||||||
end
|
end
|
||||||
| Lazy_no_targets t ->
|
| Lazy_no_targets t ->
|
||||||
exec dyn_deps (Lazy.force t) x
|
exec dyn_deps (Lazy.force t) x
|
||||||
|
| Env_var _ ->
|
||||||
|
x
|
||||||
| Memo m ->
|
| Memo m ->
|
||||||
match m.state with
|
match m.state with
|
||||||
| Evaluated (x, deps) ->
|
| Evaluated (x, deps) ->
|
||||||
dyn_deps := Path.Set.union !dyn_deps deps;
|
dyn_deps := Deps.union !dyn_deps deps;
|
||||||
x
|
x
|
||||||
| Evaluating ->
|
| Evaluating ->
|
||||||
die "Dependency cycle evaluating memoized build arrow %s" m.name
|
die "Dependency cycle evaluating memoized build arrow %s" m.name
|
||||||
| Unevaluated ->
|
| Unevaluated ->
|
||||||
m.state <- Evaluating;
|
m.state <- Evaluating;
|
||||||
let dyn_deps' = ref Path.Set.empty in
|
let dyn_deps' = ref Deps.empty in
|
||||||
match exec dyn_deps' m.t x with
|
match exec dyn_deps' m.t x with
|
||||||
| x ->
|
| x ->
|
||||||
m.state <- Evaluated (x, !dyn_deps');
|
m.state <- Evaluated (x, !dyn_deps');
|
||||||
dyn_deps := Path.Set.union !dyn_deps !dyn_deps';
|
dyn_deps := Deps.union !dyn_deps !dyn_deps';
|
||||||
x
|
x
|
||||||
| exception exn ->
|
| exception exn ->
|
||||||
m.state <- Unevaluated;
|
m.state <- Unevaluated;
|
||||||
reraise exn
|
reraise exn
|
||||||
in
|
in
|
||||||
let dyn_deps = ref Path.Set.empty in
|
let dyn_deps = ref Deps.empty in
|
||||||
let result = exec dyn_deps (Build.repr t) x in
|
let result = exec dyn_deps (Build.repr t) x in
|
||||||
(result, !dyn_deps)
|
(result, !dyn_deps)
|
||||||
end
|
end
|
||||||
|
@ -630,22 +632,22 @@ let clear_targets_digests_after_rule_execution targets =
|
||||||
die "@{<error>Error@}: Rule failed to generate the following targets:\n%s"
|
die "@{<error>Error@}: Rule failed to generate the following targets:\n%s"
|
||||||
(string_of_paths missing)
|
(string_of_paths missing)
|
||||||
|
|
||||||
|
let make_local_dir t fn =
|
||||||
|
if not (Path.Set.mem t.local_mkdirs fn) then begin
|
||||||
|
Path.mkdir_p fn;
|
||||||
|
t.local_mkdirs <- Path.Set.add t.local_mkdirs fn
|
||||||
|
end
|
||||||
|
|
||||||
let make_local_dirs t paths =
|
let make_local_dirs t paths =
|
||||||
Path.Set.iter paths ~f:(fun path ->
|
Path.Set.iter paths ~f:(make_local_dir t)
|
||||||
if Path.is_managed path && not (Path.Set.mem t.local_mkdirs path) then begin
|
|
||||||
Path.mkdir_p path;
|
let make_local_parent_dirs_for t ~map_path path =
|
||||||
t.local_mkdirs <- Path.Set.add t.local_mkdirs path
|
let path = map_path path in
|
||||||
end)
|
if Path.is_managed path then
|
||||||
|
Option.iter (Path.parent path) ~f:(make_local_dir t)
|
||||||
|
|
||||||
let make_local_parent_dirs t paths ~map_path =
|
let make_local_parent_dirs t paths ~map_path =
|
||||||
Path.Set.iter paths ~f:(fun path ->
|
Path.Set.iter paths ~f:(make_local_parent_dirs_for t ~map_path)
|
||||||
let path = map_path path in
|
|
||||||
if Path.is_managed path then (
|
|
||||||
Option.iter (Path.parent path) ~f:(fun parent ->
|
|
||||||
if not (Path.Set.mem t.local_mkdirs parent) then begin
|
|
||||||
Path.mkdir_p parent;
|
|
||||||
t.local_mkdirs <- Path.Set.add t.local_mkdirs parent
|
|
||||||
end)))
|
|
||||||
|
|
||||||
let sandbox_dir = Path.relative Path.build_dir ".sandbox"
|
let sandbox_dir = Path.relative Path.build_dir ".sandbox"
|
||||||
|
|
||||||
|
@ -710,6 +712,12 @@ let no_rule_found =
|
||||||
ctx
|
ctx
|
||||||
(hint ctx (String.Map.keys t.contexts))
|
(hint ctx (String.Map.keys t.contexts))
|
||||||
|
|
||||||
|
let parallel_iter_paths paths ~f =
|
||||||
|
Fiber.parallel_iter (Path.Set.to_list paths) ~f
|
||||||
|
|
||||||
|
let parallel_iter_deps deps ~f =
|
||||||
|
parallel_iter_paths (Deps.paths deps) ~f
|
||||||
|
|
||||||
let rec compile_rule t ?(copy_source=false) pre_rule =
|
let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
let { Pre_rule.
|
let { Pre_rule.
|
||||||
context
|
context
|
||||||
|
@ -742,19 +750,21 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
wait_for_deps ~loc t static_deps)
|
wait_for_deps ~loc t static_deps)
|
||||||
(fun () ->
|
(fun () ->
|
||||||
Fiber.Future.wait rule_evaluation >>= fun (action, dyn_deps) ->
|
Fiber.Future.wait rule_evaluation >>= fun (action, dyn_deps) ->
|
||||||
wait_for_deps ~loc t (Path.Set.diff dyn_deps static_deps)
|
wait_for_path_deps ~loc t (Deps.path_diff dyn_deps static_deps)
|
||||||
>>| fun () ->
|
>>| fun () ->
|
||||||
(action, dyn_deps))
|
(action, dyn_deps))
|
||||||
>>= fun (action, dyn_deps) ->
|
>>= fun (action, dyn_deps) ->
|
||||||
make_local_parent_dirs t targets ~map_path:(fun x -> x);
|
make_local_parent_dirs t targets ~map_path:(fun x -> x);
|
||||||
let all_deps = Path.Set.union static_deps dyn_deps in
|
let all_deps = Deps.union static_deps dyn_deps in
|
||||||
let all_deps_as_list = Path.Set.to_list all_deps in
|
|
||||||
let targets_as_list = Path.Set.to_list targets in
|
let targets_as_list = Path.Set.to_list targets in
|
||||||
|
let env =
|
||||||
|
match context with
|
||||||
|
| None -> Env.empty
|
||||||
|
| Some c -> c.env
|
||||||
|
in
|
||||||
let hash =
|
let hash =
|
||||||
let trace =
|
let trace =
|
||||||
( all_deps_as_list
|
( Deps.trace all_deps env,
|
||||||
|> List.map ~f:(fun fn ->
|
|
||||||
(Path.to_string fn, Utils.Cached_digest.file fn)),
|
|
||||||
List.map targets_as_list ~f:Path.to_string,
|
List.map targets_as_list ~f:Path.to_string,
|
||||||
Option.map context ~f:(fun c -> c.name),
|
Option.map context ~f:(fun c -> c.name),
|
||||||
Action.for_shell action)
|
Action.for_shell action)
|
||||||
|
@ -796,11 +806,11 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
| Some sandbox_dir ->
|
| Some sandbox_dir ->
|
||||||
Path.rm_rf sandbox_dir;
|
Path.rm_rf sandbox_dir;
|
||||||
let sandboxed path = Path.sandbox_managed_paths ~sandbox_dir path in
|
let sandboxed path = Path.sandbox_managed_paths ~sandbox_dir path in
|
||||||
make_local_parent_dirs t all_deps ~map_path:sandboxed;
|
make_local_parent_dirs t (Deps.paths all_deps) ~map_path:sandboxed;
|
||||||
make_local_parent_dirs t targets ~map_path:sandboxed;
|
make_local_parent_dirs t targets ~map_path:sandboxed;
|
||||||
Action.sandbox action
|
Action.sandbox action
|
||||||
~sandboxed
|
~sandboxed
|
||||||
~deps:all_deps_as_list
|
~deps:all_deps
|
||||||
~targets:targets_as_list
|
~targets:targets_as_list
|
||||||
| None ->
|
| None ->
|
||||||
action
|
action
|
||||||
|
@ -1148,8 +1158,11 @@ and wait_for_file_found fn (File_spec.T file) =
|
||||||
};
|
};
|
||||||
Fiber.Future.wait rule_execution)
|
Fiber.Future.wait rule_execution)
|
||||||
|
|
||||||
|
and wait_for_path_deps ~loc t paths =
|
||||||
|
parallel_iter_paths paths ~f:(wait_for_file ~loc t)
|
||||||
|
|
||||||
and wait_for_deps ~loc t deps =
|
and wait_for_deps ~loc t deps =
|
||||||
Fiber.parallel_iter (Path.Set.to_list deps) ~f:(wait_for_file ~loc t)
|
wait_for_path_deps ~loc t (Deps.paths deps)
|
||||||
|
|
||||||
let stamp_file_for_files_of t ~dir ~ext =
|
let stamp_file_for_files_of t ~dir ~ext =
|
||||||
let files_of_dir =
|
let files_of_dir =
|
||||||
|
@ -1255,17 +1268,13 @@ let eval_request t ~request ~process_target =
|
||||||
~file_tree:t.file_tree
|
~file_tree:t.file_tree
|
||||||
in
|
in
|
||||||
|
|
||||||
let process_targets ts =
|
|
||||||
Fiber.parallel_iter (Path.Set.to_list ts) ~f:process_target
|
|
||||||
in
|
|
||||||
|
|
||||||
Fiber.fork_and_join_unit
|
Fiber.fork_and_join_unit
|
||||||
(fun () -> process_targets static_deps)
|
(fun () -> parallel_iter_deps ~f:process_target static_deps)
|
||||||
(fun () ->
|
(fun () ->
|
||||||
wait_for_deps t ~loc:None rule_deps
|
wait_for_deps t ~loc:None rule_deps
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
let result, dyn_deps = Build_exec.exec t request () in
|
let result, dyn_deps = Build_exec.exec t request () in
|
||||||
process_targets (Path.Set.diff dyn_deps static_deps)
|
parallel_iter_paths ~f:process_target (Deps.path_diff dyn_deps static_deps)
|
||||||
>>| fun () ->
|
>>| fun () ->
|
||||||
result)
|
result)
|
||||||
|
|
||||||
|
@ -1291,7 +1300,6 @@ let do_build t ~request =
|
||||||
|
|
||||||
module Ir_set = Set.Make(Internal_rule)
|
module Ir_set = Set.Make(Internal_rule)
|
||||||
|
|
||||||
|
|
||||||
let rules_for_files t paths =
|
let rules_for_files t paths =
|
||||||
Path.Set.fold paths ~init:[] ~f:(fun path acc ->
|
Path.Set.fold paths ~init:[] ~f:(fun path acc ->
|
||||||
if Path.is_in_build_dir path then
|
if Path.is_in_build_dir path then
|
||||||
|
@ -1304,11 +1312,12 @@ let rules_for_files t paths =
|
||||||
|
|
||||||
let rules_for_targets t targets =
|
let rules_for_targets t targets =
|
||||||
match
|
match
|
||||||
Internal_rule.Id.Top_closure.top_closure (rules_for_files t targets)
|
Internal_rule.Id.Top_closure.top_closure
|
||||||
|
(rules_for_files t targets)
|
||||||
~key:(fun (r : Internal_rule.t) -> r.id)
|
~key:(fun (r : Internal_rule.t) -> r.id)
|
||||||
~deps:(fun (r : Internal_rule.t) ->
|
~deps:(fun (r : Internal_rule.t) ->
|
||||||
let x = Lazy.force r.static_deps in
|
let x = Lazy.force r.static_deps in
|
||||||
rules_for_files t (Path.Set.union x.action_deps x.rule_deps))
|
rules_for_files t (Deps.path_union x.action_deps x.rule_deps))
|
||||||
with
|
with
|
||||||
| Ok l -> l
|
| Ok l -> l
|
||||||
| Error cycle ->
|
| Error cycle ->
|
||||||
|
@ -1325,7 +1334,7 @@ let static_deps_of_request t request =
|
||||||
} = Build_interpret.static_deps request ~all_targets:(targets_of t)
|
} = Build_interpret.static_deps request ~all_targets:(targets_of t)
|
||||||
~file_tree:t.file_tree
|
~file_tree:t.file_tree
|
||||||
in
|
in
|
||||||
Path.Set.union rule_deps action_deps
|
Deps.path_union rule_deps action_deps
|
||||||
|
|
||||||
let all_lib_deps t ~request =
|
let all_lib_deps t ~request =
|
||||||
let targets = static_deps_of_request t request in
|
let targets = static_deps_of_request t request in
|
||||||
|
@ -1364,7 +1373,7 @@ module Rule = struct
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ id : Id.t
|
{ id : Id.t
|
||||||
; deps : Path.Set.t
|
; deps : Deps.t
|
||||||
; targets : Path.Set.t
|
; targets : Path.Set.t
|
||||||
; context : Context.t option
|
; context : Context.t option
|
||||||
; action : Action.t
|
; action : Action.t
|
||||||
|
@ -1375,8 +1384,8 @@ end
|
||||||
|
|
||||||
module Rule_set = Set.Make(Rule)
|
module Rule_set = Set.Make(Rule)
|
||||||
|
|
||||||
let rules_for_files rules paths =
|
let rules_for_files rules deps =
|
||||||
Path.Set.fold paths ~init:Rule_set.empty ~f:(fun path acc ->
|
Path.Set.fold (Deps.paths deps) ~init:Rule_set.empty ~f:(fun path acc ->
|
||||||
match Path.Map.find rules path with
|
match Path.Map.find rules path with
|
||||||
| None -> acc
|
| None -> acc
|
||||||
| Some rule -> Rule_set.add acc rule)
|
| Some rule -> Rule_set.add acc rule)
|
||||||
|
@ -1418,7 +1427,7 @@ let build_rules_internal ?(recursive=false) t ~request =
|
||||||
let static_deps = (Lazy.force ir.static_deps).action_deps in
|
let static_deps = (Lazy.force ir.static_deps).action_deps in
|
||||||
{ Rule.
|
{ Rule.
|
||||||
id = ir.id
|
id = ir.id
|
||||||
; deps = Path.Set.union static_deps dyn_deps
|
; deps = Deps.union static_deps dyn_deps
|
||||||
; targets = ir.targets
|
; targets = ir.targets
|
||||||
; context = ir.context
|
; context = ir.context
|
||||||
; action = action
|
; action = action
|
||||||
|
@ -1429,12 +1438,12 @@ let build_rules_internal ?(recursive=false) t ~request =
|
||||||
Fiber.return ()
|
Fiber.return ()
|
||||||
else
|
else
|
||||||
Fiber.Future.wait rule >>= fun rule ->
|
Fiber.Future.wait rule >>= fun rule ->
|
||||||
Fiber.parallel_iter (Path.Set.to_list rule.deps) ~f:loop
|
parallel_iter_deps rule.deps ~f:loop
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
let targets = ref Path.Set.empty in
|
let targets = ref Deps.empty in
|
||||||
eval_request t ~request ~process_target:(fun fn ->
|
eval_request t ~request ~process_target:(fun fn ->
|
||||||
targets := Path.Set.add !targets fn;
|
targets := Deps.add_path !targets fn;
|
||||||
loop fn)
|
loop fn)
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
Fiber.all (List.map !rules ~f:Fiber.Future.wait)
|
Fiber.all (List.map !rules ~f:Fiber.Future.wait)
|
||||||
|
@ -1497,7 +1506,7 @@ let package_deps t pkg files =
|
||||||
| Not_started _ -> assert false
|
| Not_started _ -> assert false
|
||||||
in
|
in
|
||||||
Path.Set.fold
|
Path.Set.fold
|
||||||
(Path.Set.union (Lazy.force ir.static_deps).action_deps dyn_deps)
|
(Deps.path_union (Lazy.force ir.static_deps).action_deps dyn_deps)
|
||||||
~init:acc ~f:loop
|
~init:acc ~f:loop
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
|
|
|
@ -232,7 +232,7 @@ module Rule : sig
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ id : Id.t
|
{ id : Id.t
|
||||||
; deps : Path.Set.t
|
; deps : Deps.t
|
||||||
; targets : Path.Set.t
|
; targets : Path.Set.t
|
||||||
; context : Context.t option
|
; context : Context.t option
|
||||||
; action : Action.t
|
; action : Action.t
|
||||||
|
|
|
@ -0,0 +1,68 @@
|
||||||
|
open! Import
|
||||||
|
|
||||||
|
type t =
|
||||||
|
{ paths : Path.Set.t
|
||||||
|
; vars : String.Set.t
|
||||||
|
}
|
||||||
|
|
||||||
|
let paths t = t.paths
|
||||||
|
|
||||||
|
let trace_path fn =
|
||||||
|
(Path.to_string fn, Utils.Cached_digest.file fn)
|
||||||
|
|
||||||
|
let trace_var env var =
|
||||||
|
let value =
|
||||||
|
match Env.get env var with
|
||||||
|
| None -> "unset"
|
||||||
|
| Some v -> Digest.string v |> Digest.to_hex
|
||||||
|
in
|
||||||
|
(var, value)
|
||||||
|
|
||||||
|
let trace {paths; vars} env =
|
||||||
|
List.concat
|
||||||
|
[ List.map ~f:trace_path @@ Path.Set.to_list paths
|
||||||
|
; List.map ~f:(trace_var env) @@ String.Set.to_list vars
|
||||||
|
]
|
||||||
|
|
||||||
|
let union {paths = paths_a; vars = vars_a} {paths = paths_b; vars = vars_b} =
|
||||||
|
{ paths = Path.Set.union paths_a paths_b
|
||||||
|
; vars = String.Set.union vars_a vars_b
|
||||||
|
}
|
||||||
|
|
||||||
|
let path_union a b =
|
||||||
|
Path.Set.union a.paths b.paths
|
||||||
|
|
||||||
|
let path_diff a b =
|
||||||
|
Path.Set.diff a.paths b.paths
|
||||||
|
|
||||||
|
let empty =
|
||||||
|
{ paths = Path.Set.empty
|
||||||
|
; vars = String.Set.empty
|
||||||
|
}
|
||||||
|
|
||||||
|
let add_path t path =
|
||||||
|
{ t with
|
||||||
|
paths = Path.Set.add t.paths path
|
||||||
|
}
|
||||||
|
|
||||||
|
let add_paths t fns =
|
||||||
|
{ t with
|
||||||
|
paths = Path.Set.union t.paths fns
|
||||||
|
}
|
||||||
|
|
||||||
|
let add_env_var t var =
|
||||||
|
{ t with
|
||||||
|
vars = String.Set.add t.vars var
|
||||||
|
}
|
||||||
|
|
||||||
|
let to_sexp {paths; vars} =
|
||||||
|
let sexp_paths =
|
||||||
|
Dsexp.To_sexp.list Path_dsexp.dgen (Path.Set.to_list paths)
|
||||||
|
in
|
||||||
|
let sexp_vars =
|
||||||
|
Dsexp.To_sexp.list Dsexp.To_sexp.string (String.Set.to_list vars)
|
||||||
|
in
|
||||||
|
Dsexp.To_sexp.record
|
||||||
|
[ ("paths", sexp_paths)
|
||||||
|
; ("vars", sexp_vars)
|
||||||
|
]
|
|
@ -0,0 +1,40 @@
|
||||||
|
open! Import
|
||||||
|
|
||||||
|
(** An abstract value representing dependencies, like paths or environment
|
||||||
|
variables. *)
|
||||||
|
type t
|
||||||
|
|
||||||
|
(** {1} Constructors *)
|
||||||
|
|
||||||
|
(** No dependencies - neutral element for [union]. *)
|
||||||
|
val empty : t
|
||||||
|
|
||||||
|
(** Merge dependencies. *)
|
||||||
|
val union : t -> t -> t
|
||||||
|
|
||||||
|
(** Specialized version of [union] that only returns path dependencies. *)
|
||||||
|
val path_union : t -> t -> Path.Set.t
|
||||||
|
|
||||||
|
(** [path_diff a b] returns paths dependencies in [a] but not in [b]. *)
|
||||||
|
val path_diff : t -> t -> Path.Set.t
|
||||||
|
|
||||||
|
(** Add a path dependency. *)
|
||||||
|
val add_path : t -> Path.t -> t
|
||||||
|
|
||||||
|
(** Add several path dependencies. *)
|
||||||
|
val add_paths : t -> Path.Set.t -> t
|
||||||
|
|
||||||
|
(** Add a dependency to an environment variable. *)
|
||||||
|
val add_env_var : t -> string -> t
|
||||||
|
|
||||||
|
(** {1} Deconstructors *)
|
||||||
|
|
||||||
|
(** [trace t] is an abstract value that is guaranteed to change if the set of
|
||||||
|
dependencies denoted by t changes, modulo hash collisions. *)
|
||||||
|
val trace : t -> Env.t -> (string * string) list
|
||||||
|
|
||||||
|
(** Return the path dependencies only. *)
|
||||||
|
val paths : t -> Path.Set.t
|
||||||
|
|
||||||
|
(** Serializer. *)
|
||||||
|
val to_sexp : t -> Dsexp.t
|
|
@ -308,6 +308,7 @@ module Dep_conf = struct
|
||||||
| Source_tree of String_with_vars.t
|
| Source_tree of String_with_vars.t
|
||||||
| Package of String_with_vars.t
|
| Package of String_with_vars.t
|
||||||
| Universe
|
| Universe
|
||||||
|
| Env_var of String_with_vars.t
|
||||||
|
|
||||||
let remove_locs = function
|
let remove_locs = function
|
||||||
| File sw -> File (String_with_vars.remove_locs sw)
|
| File sw -> File (String_with_vars.remove_locs sw)
|
||||||
|
@ -317,6 +318,7 @@ module Dep_conf = struct
|
||||||
| Source_tree sw -> Source_tree (String_with_vars.remove_locs sw)
|
| Source_tree sw -> Source_tree (String_with_vars.remove_locs sw)
|
||||||
| Package sw -> Package (String_with_vars.remove_locs sw)
|
| Package sw -> Package (String_with_vars.remove_locs sw)
|
||||||
| Universe -> Universe
|
| Universe -> Universe
|
||||||
|
| Env_var sw -> Env_var sw
|
||||||
|
|
||||||
let dparse =
|
let dparse =
|
||||||
let dparse =
|
let dparse =
|
||||||
|
@ -337,6 +339,7 @@ module Dep_conf = struct
|
||||||
(let%map () = Syntax.since Stanza.syntax (1, 0)
|
(let%map () = Syntax.since Stanza.syntax (1, 0)
|
||||||
and x = sw in
|
and x = sw in
|
||||||
Source_tree x)
|
Source_tree x)
|
||||||
|
; "env_var", (sw >>| fun x -> Env_var x)
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
if_list
|
if_list
|
||||||
|
@ -365,6 +368,9 @@ module Dep_conf = struct
|
||||||
; String_with_vars.dgen t]
|
; String_with_vars.dgen t]
|
||||||
| Universe ->
|
| Universe ->
|
||||||
Dsexp.unsafe_atom_of_string "universe"
|
Dsexp.unsafe_atom_of_string "universe"
|
||||||
|
| Env_var t ->
|
||||||
|
List [ Dsexp.unsafe_atom_of_string "env_var"
|
||||||
|
; String_with_vars.dgen t]
|
||||||
|
|
||||||
let to_sexp t = Dsexp.to_sexp (dgen t)
|
let to_sexp t = Dsexp.to_sexp (dgen t)
|
||||||
end
|
end
|
||||||
|
|
|
@ -119,6 +119,7 @@ module Dep_conf : sig
|
||||||
| Source_tree of String_with_vars.t
|
| Source_tree of String_with_vars.t
|
||||||
| Package of String_with_vars.t
|
| Package of String_with_vars.t
|
||||||
| Universe
|
| Universe
|
||||||
|
| Env_var of String_with_vars.t
|
||||||
|
|
||||||
val remove_locs : t -> t
|
val remove_locs : t -> t
|
||||||
|
|
||||||
|
|
|
@ -79,3 +79,6 @@ let update t ~var ~f =
|
||||||
|
|
||||||
let of_string_map m =
|
let of_string_map m =
|
||||||
make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m)
|
make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m)
|
||||||
|
|
||||||
|
let iter t =
|
||||||
|
Map.iteri t.vars
|
||||||
|
|
|
@ -31,3 +31,5 @@ val update : t -> var:string -> f:(string option -> string option) -> t
|
||||||
val to_sexp : t -> Sexp.t
|
val to_sexp : t -> Sexp.t
|
||||||
|
|
||||||
val of_string_map : string String.Map.t -> t
|
val of_string_map : string String.Map.t -> t
|
||||||
|
|
||||||
|
val iter : t -> f:(string -> string -> unit) -> unit
|
||||||
|
|
|
@ -739,6 +739,10 @@ module Deps = struct
|
||||||
| Universe ->
|
| Universe ->
|
||||||
Build.path Build_system.universe_file
|
Build.path Build_system.universe_file
|
||||||
>>^ fun () -> []
|
>>^ fun () -> []
|
||||||
|
| Env_var var_sw ->
|
||||||
|
let var = expand_vars_string t ~scope ~dir var_sw in
|
||||||
|
Build.env_var var
|
||||||
|
>>^ fun () -> []
|
||||||
|
|
||||||
let interpret t ~scope ~dir l =
|
let interpret t ~scope ~dir l =
|
||||||
List.map l ~f:(dep t ~scope ~dir)
|
List.map l ~f:(dep t ~scope ~dir)
|
||||||
|
|
|
@ -159,6 +159,14 @@
|
||||||
test-cases/env
|
test-cases/env
|
||||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
(name env-tracking)
|
||||||
|
(deps (package dune) (source_tree test-cases/env-tracking))
|
||||||
|
(action
|
||||||
|
(chdir
|
||||||
|
test-cases/env-tracking
|
||||||
|
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
(name envs-and-contexts)
|
(name envs-and-contexts)
|
||||||
(deps (package dune) (source_tree test-cases/envs-and-contexts))
|
(deps (package dune) (source_tree test-cases/envs-and-contexts))
|
||||||
|
@ -867,6 +875,7 @@
|
||||||
(alias dune-project-edition)
|
(alias dune-project-edition)
|
||||||
(alias dup-fields)
|
(alias dup-fields)
|
||||||
(alias env)
|
(alias env)
|
||||||
|
(alias env-tracking)
|
||||||
(alias exclude-missing-module)
|
(alias exclude-missing-module)
|
||||||
(alias exec-cmd)
|
(alias exec-cmd)
|
||||||
(alias exec-missing)
|
(alias exec-missing)
|
||||||
|
@ -972,6 +981,7 @@
|
||||||
(alias dune-project-edition)
|
(alias dune-project-edition)
|
||||||
(alias dup-fields)
|
(alias dup-fields)
|
||||||
(alias env)
|
(alias env)
|
||||||
|
(alias env-tracking)
|
||||||
(alias exclude-missing-module)
|
(alias exclude-missing-module)
|
||||||
(alias exec-cmd)
|
(alias exec-cmd)
|
||||||
(alias exec-missing)
|
(alias exec-missing)
|
||||||
|
|
|
@ -0,0 +1,8 @@
|
||||||
|
let print_var k =
|
||||||
|
match Sys.getenv k with
|
||||||
|
| v -> Printf.printf "%s = %S\n" k v
|
||||||
|
| exception Not_found -> Printf.printf "%s is not set\n" k
|
||||||
|
|
||||||
|
let () =
|
||||||
|
print_var "X";
|
||||||
|
print_var "Y"
|
|
@ -0,0 +1,14 @@
|
||||||
|
(executable
|
||||||
|
(name a)
|
||||||
|
)
|
||||||
|
|
||||||
|
(alias
|
||||||
|
(name without_dep)
|
||||||
|
(action (run ./a.exe))
|
||||||
|
)
|
||||||
|
|
||||||
|
(alias
|
||||||
|
(name with_dep)
|
||||||
|
(deps (env_var X))
|
||||||
|
(action (run ./a.exe))
|
||||||
|
)
|
|
@ -0,0 +1 @@
|
||||||
|
(lang dune 1.1)
|
|
@ -0,0 +1,27 @@
|
||||||
|
Aliases without a (env) dependency are not rebuilt when the environment
|
||||||
|
changes:
|
||||||
|
|
||||||
|
$ dune build @without_dep
|
||||||
|
a alias without_dep
|
||||||
|
X is not set
|
||||||
|
Y is not set
|
||||||
|
$ X=x dune build @without_dep
|
||||||
|
|
||||||
|
But if there is a dependency, the alias gets rebuilt:
|
||||||
|
|
||||||
|
$ dune build @with_dep
|
||||||
|
a alias with_dep
|
||||||
|
X is not set
|
||||||
|
Y is not set
|
||||||
|
$ X=x dune build @with_dep
|
||||||
|
a alias with_dep
|
||||||
|
X = "x"
|
||||||
|
Y is not set
|
||||||
|
|
||||||
|
This only happens for tracked variables:
|
||||||
|
|
||||||
|
$ dune build @with_dep
|
||||||
|
a alias with_dep
|
||||||
|
X is not set
|
||||||
|
Y is not set
|
||||||
|
$ Y=y dune build @with_dep
|
Loading…
Reference in New Issue