From 74db582b044fc468ad39429e03ffe370cd4b319b Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 3 Sep 2018 13:20:03 +0200 Subject: [PATCH] Add (env var) dependencies Signed-off-by: Etienne Millon --- CHANGES.md | 3 + bin/main.ml | 4 +- doc/dune-files.rst | 3 + src/action.ml | 19 ++- src/action.mli | 2 +- src/build.ml | 5 +- src/build.mli | 7 +- src/build_interpret.ml | 25 ++-- src/build_interpret.mli | 4 +- src/build_system.ml | 109 ++++++++++-------- src/build_system.mli | 2 +- src/deps.ml | 68 +++++++++++ src/deps.mli | 40 +++++++ src/dune_file.ml | 6 + src/dune_file.mli | 1 + src/env.ml | 3 + src/env.mli | 2 + src/super_context.ml | 4 + test/blackbox-tests/dune.inc | 10 ++ .../test-cases/env-tracking/a.ml | 8 ++ .../test-cases/env-tracking/dune | 14 +++ .../test-cases/env-tracking/dune-project | 1 + .../test-cases/env-tracking/run.t | 27 +++++ 23 files changed, 293 insertions(+), 74 deletions(-) create mode 100644 src/deps.ml create mode 100644 src/deps.mli create mode 100644 test/blackbox-tests/test-cases/env-tracking/a.ml create mode 100644 test/blackbox-tests/test-cases/env-tracking/dune create mode 100644 test/blackbox-tests/test-cases/env-tracking/dune-project create mode 100644 test/blackbox-tests/test-cases/env-tracking/run.t diff --git a/CHANGES.md b/CHANGES.md index d05dcf75..5dd3b44a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -44,6 +44,9 @@ next - 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) ------------------ diff --git a/bin/main.ml b/bin/main.ml index e97d373f..686ad492 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1003,7 +1003,7 @@ let rules = Format.pp_print_string ppf (Path.to_string p))) (Path.Set.to_list rule.targets) (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))) Dsexp.pp_split_strings (sexp_of_action rule.action)) end else begin @@ -1014,7 +1014,7 @@ let rules = in Dsexp.To_sexp.record ( List.concat - [ [ "deps" , paths rule.deps + [ [ "deps" , Deps.to_sexp rule.deps ; "targets", paths rule.targets ] ; (match rule.context with | None -> [] diff --git a/doc/dune-files.rst b/doc/dune-files.rst index ce87c4dc..bb777dd1 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -1250,6 +1250,9 @@ syntax: - ``(package )`` depend on all files installed by ````, as well as on the transitive package dependencies of ````. This can be used to test a command against the files that will be installed +- ``(env )``: depend on the value of the environment variable ````. + If this variable becomes set, becomes unset, or changes value, the target + will be rebuilt. In all these cases, the argument supports `Variables expansion`_. diff --git a/src/action.ml b/src/action.ml index 880de4fe..6b1beb93 100644 --- a/src/action.ml +++ b/src/action.ml @@ -789,13 +789,22 @@ module Infer = struct (Unexp.infer t).targets 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 = Progn - [ Progn (List.filter_map deps ~f:(fun path -> - if Path.is_managed path then - Some (Symlink (path, sandboxed path)) - else - None)) + [ symlink_managed_paths sandboxed deps ; map t ~dir:Path.root ~f_string:(fun ~dir:_ x -> x) diff --git a/src/action.mli b/src/action.mli index c81dfafd..f69c1664 100644 --- a/src/action.mli +++ b/src/action.mli @@ -125,6 +125,6 @@ end val sandbox : t -> sandboxed:(Path.t -> Path.t) - -> deps:Path.t list + -> deps:Deps.t -> targets:Path.t list -> t diff --git a/src/build.ml b/src/build.ml index 757cfefb..3d73a2eb 100644 --- a/src/build.ml +++ b/src/build.ml @@ -29,6 +29,7 @@ module Repr = struct | Memo : 'a memo -> (unit, 'a) t | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t | Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t + | Env_var : string -> ('a, 'a) t and 'a memo = { name : string @@ -39,7 +40,7 @@ module Repr = struct and 'a memo_state = | Unevaluated | Evaluating - | Evaluated of 'a * Path.Set.t + | Evaluated of 'a * Deps.t and ('a, 'b) if_file_exists_state = | 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 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 contents p = Contents p diff --git a/src/build.mli b/src/build.mli index 7624ad35..613c1121 100644 --- a/src/build.mli +++ b/src/build.mli @@ -66,6 +66,10 @@ val path_set : Path.Set.t -> ('a, 'a) t of the action produced by the build arrow. *) 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 starting at [dir] and record them as dependencies. *) val source_tree @@ -197,6 +201,7 @@ module Repr : sig | Memo : 'a memo -> (unit, 'a) t | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t | Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t + | Env_var : string -> ('a, 'a) t and 'a memo = { name : string @@ -207,7 +212,7 @@ module Repr : sig and 'a memo_state = | Unevaluated | Evaluating - | Evaluated of 'a * Path.Set.t (* dynamic dependencies *) + | Evaluated of 'a * Deps.t (* dynamic dependencies *) and ('a, 'b) if_file_exists_state = | Undecided of ('a, 'b) t * ('a, 'b) t diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 6601e146..748625f8 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -20,8 +20,8 @@ end module Static_deps = struct type t = - { rule_deps : Path.Set.t - ; action_deps : Path.Set.t + { rule_deps : Deps.t + ; action_deps : Deps.t } end @@ -67,13 +67,13 @@ let static_deps t ~all_targets ~file_tree = | Second t -> loop t acc 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 - | 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 -> - { 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 match !state with | 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) -> let targets = all_targets ~dir in let result = @@ -95,7 +95,7 @@ let static_deps t ~all_targets ~file_tree = () end; 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 } end | If_file_exists (p, state) -> begin @@ -114,18 +114,19 @@ let static_deps t ~all_targets ~file_tree = end | Dyn_paths t -> loop t acc targets_allowed | Vpath (Vspec.T (p, _)) -> - { acc with rule_deps = Path.Set.add acc.rule_deps p } - | Contents p -> { acc with rule_deps = Path.Set.add acc.rule_deps p } - | Lines_of 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 = Deps.add_path acc.rule_deps p } + | Lines_of p -> { acc with rule_deps = Deps.add_path acc.rule_deps p } | Record_lib_deps _ -> acc | Fail _ -> acc | Memo m -> loop m.t acc targets_allowed | Catch (t, _) -> loop t acc targets_allowed | 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 loop (Build.repr t) - { rule_deps = Path.Set.empty - ; action_deps = Path.Set.empty + { rule_deps = Deps.empty + ; action_deps = Deps.empty } true @@ -155,6 +156,7 @@ let lib_deps = | Memo m -> loop m.t acc | Catch (t, _) -> loop t acc | Lazy_no_targets t -> loop (Lazy.force t) acc + | Env_var _ -> acc in fun t -> loop (Build.repr t) Lib_name.Map.empty @@ -198,6 +200,7 @@ let targets = | Memo m -> loop m.t acc | Catch (t, _) -> loop t acc | Lazy_no_targets _ -> acc + | Env_var _ -> acc in fun t -> loop (Build.repr t) [] diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 6e4989fc..b625b686 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -35,8 +35,8 @@ end module Static_deps : sig type t = - { rule_deps : Path.Set.t - ; action_deps : Path.Set.t + { rule_deps : Deps.t + ; action_deps : Deps.t } end diff --git a/src/build_system.ml b/src/build_system.ml index f6158551..df8aa6ba 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -37,10 +37,10 @@ let files_in_source_tree_to_delete () = Promoted_to_delete.load () 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 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 module Evaluating_rule = struct @@ -139,8 +139,8 @@ module Internal_rule = struct dependency paths. *) let root = { id = Id.gen () - ; static_deps = lazy { rule_deps = Path.Set.empty - ; action_deps = Path.Set.empty + ; static_deps = lazy { rule_deps = Deps.empty + ; action_deps = Deps.empty } ; targets = Path.Set.empty ; context = None @@ -484,7 +484,7 @@ module Build_exec = struct let exec bs t x = 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 | Arr f -> f x | Targets _ -> x @@ -519,7 +519,7 @@ module Build_exec = struct Option.value_exn file.data | Dyn_paths t -> 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 | Record_lib_deps _ -> x | Fail { fail } -> fail () @@ -533,26 +533,28 @@ module Build_exec = struct end | Lazy_no_targets t -> exec dyn_deps (Lazy.force t) x + | Env_var _ -> + x | Memo m -> match m.state with | Evaluated (x, deps) -> - dyn_deps := Path.Set.union !dyn_deps deps; + dyn_deps := Deps.union !dyn_deps deps; x | Evaluating -> die "Dependency cycle evaluating memoized build arrow %s" m.name | Unevaluated -> 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 | x -> m.state <- Evaluated (x, !dyn_deps'); - dyn_deps := Path.Set.union !dyn_deps !dyn_deps'; + dyn_deps := Deps.union !dyn_deps !dyn_deps'; x | exception exn -> m.state <- Unevaluated; reraise exn 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 (result, !dyn_deps) end @@ -630,22 +632,22 @@ let clear_targets_digests_after_rule_execution targets = die "@{Error@}: Rule failed to generate the following targets:\n%s" (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 = - Path.Set.iter paths ~f:(fun path -> - if Path.is_managed path && not (Path.Set.mem t.local_mkdirs path) then begin - Path.mkdir_p path; - t.local_mkdirs <- Path.Set.add t.local_mkdirs path - end) + Path.Set.iter paths ~f:(make_local_dir t) + +let make_local_parent_dirs_for t ~map_path path = + let path = map_path path in + 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 = - Path.Set.iter paths ~f:(fun 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))) + Path.Set.iter paths ~f:(make_local_parent_dirs_for t ~map_path) let sandbox_dir = Path.relative Path.build_dir ".sandbox" @@ -710,6 +712,12 @@ let no_rule_found = ctx (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 { Pre_rule. context @@ -742,19 +750,21 @@ let rec compile_rule t ?(copy_source=false) pre_rule = wait_for_deps ~loc t static_deps) (fun () -> 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 () -> (action, dyn_deps)) >>= fun (action, dyn_deps) -> 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_as_list = Path.Set.to_list all_deps in + let all_deps = Deps.union static_deps dyn_deps 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 trace = - ( all_deps_as_list - |> List.map ~f:(fun fn -> - (Path.to_string fn, Utils.Cached_digest.file fn)), + ( Deps.trace all_deps env, List.map targets_as_list ~f:Path.to_string, Option.map context ~f:(fun c -> c.name), Action.for_shell action) @@ -796,11 +806,11 @@ let rec compile_rule t ?(copy_source=false) pre_rule = | Some sandbox_dir -> Path.rm_rf sandbox_dir; 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; Action.sandbox action ~sandboxed - ~deps:all_deps_as_list + ~deps:all_deps ~targets:targets_as_list | None -> action @@ -1148,8 +1158,11 @@ and wait_for_file_found fn (File_spec.T file) = }; 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 = - 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 files_of_dir = @@ -1255,17 +1268,13 @@ let eval_request t ~request ~process_target = ~file_tree:t.file_tree in - let process_targets ts = - Fiber.parallel_iter (Path.Set.to_list ts) ~f:process_target - in - Fiber.fork_and_join_unit - (fun () -> process_targets static_deps) + (fun () -> parallel_iter_deps ~f:process_target static_deps) (fun () -> wait_for_deps t ~loc:None rule_deps >>= fun () -> 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 () -> result) @@ -1291,7 +1300,6 @@ let do_build t ~request = module Ir_set = Set.Make(Internal_rule) - let rules_for_files t paths = Path.Set.fold paths ~init:[] ~f:(fun path acc -> if Path.is_in_build_dir path then @@ -1304,11 +1312,12 @@ let rules_for_files t paths = let rules_for_targets t targets = 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) ~deps:(fun (r : Internal_rule.t) -> 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 | Ok l -> l | Error cycle -> @@ -1325,7 +1334,7 @@ let static_deps_of_request t request = } = Build_interpret.static_deps request ~all_targets:(targets_of t) ~file_tree:t.file_tree in - Path.Set.union rule_deps action_deps + Deps.path_union rule_deps action_deps let all_lib_deps t ~request = let targets = static_deps_of_request t request in @@ -1364,7 +1373,7 @@ module Rule = struct type t = { id : Id.t - ; deps : Path.Set.t + ; deps : Deps.t ; targets : Path.Set.t ; context : Context.t option ; action : Action.t @@ -1375,8 +1384,8 @@ end module Rule_set = Set.Make(Rule) -let rules_for_files rules paths = - Path.Set.fold paths ~init:Rule_set.empty ~f:(fun path acc -> +let rules_for_files rules deps = + Path.Set.fold (Deps.paths deps) ~init:Rule_set.empty ~f:(fun path acc -> match Path.Map.find rules path with | None -> acc | 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 { Rule. id = ir.id - ; deps = Path.Set.union static_deps dyn_deps + ; deps = Deps.union static_deps dyn_deps ; targets = ir.targets ; context = ir.context ; action = action @@ -1429,12 +1438,12 @@ let build_rules_internal ?(recursive=false) t ~request = Fiber.return () else 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 in - let targets = ref Path.Set.empty in + let targets = ref Deps.empty in eval_request t ~request ~process_target:(fun fn -> - targets := Path.Set.add !targets fn; + targets := Deps.add_path !targets fn; loop fn) >>= fun () -> Fiber.all (List.map !rules ~f:Fiber.Future.wait) @@ -1497,7 +1506,7 @@ let package_deps t pkg files = | Not_started _ -> assert false in 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 end in diff --git a/src/build_system.mli b/src/build_system.mli index 716dc23b..9ce9855c 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -232,7 +232,7 @@ module Rule : sig type t = { id : Id.t - ; deps : Path.Set.t + ; deps : Deps.t ; targets : Path.Set.t ; context : Context.t option ; action : Action.t diff --git a/src/deps.ml b/src/deps.ml new file mode 100644 index 00000000..e6f76de8 --- /dev/null +++ b/src/deps.ml @@ -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) + ] diff --git a/src/deps.mli b/src/deps.mli new file mode 100644 index 00000000..569106fe --- /dev/null +++ b/src/deps.mli @@ -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 diff --git a/src/dune_file.ml b/src/dune_file.ml index 2d874794..321829f4 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -308,6 +308,7 @@ module Dep_conf = struct | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe + | Env_var of String_with_vars.t let remove_locs = function | 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) | Package sw -> Package (String_with_vars.remove_locs sw) | Universe -> Universe + | Env_var sw -> Env_var sw let dparse = let dparse = @@ -337,6 +339,7 @@ module Dep_conf = struct (let%map () = Syntax.since Stanza.syntax (1, 0) and x = sw in Source_tree x) + ; "env_var", (sw >>| fun x -> Env_var x) ] in if_list @@ -365,6 +368,9 @@ module Dep_conf = struct ; String_with_vars.dgen t] | 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) end diff --git a/src/dune_file.mli b/src/dune_file.mli index c462c5d0..e025649a 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -119,6 +119,7 @@ module Dep_conf : sig | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe + | Env_var of String_with_vars.t val remove_locs : t -> t diff --git a/src/env.ml b/src/env.ml index 7d2a5fc9..2091d73d 100644 --- a/src/env.ml +++ b/src/env.ml @@ -79,3 +79,6 @@ let update t ~var ~f = let of_string_map 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 diff --git a/src/env.mli b/src/env.mli index c7a15429..72e68a6c 100644 --- a/src/env.mli +++ b/src/env.mli @@ -31,3 +31,5 @@ val update : t -> var:string -> f:(string option -> string option) -> t val to_sexp : t -> Sexp.t val of_string_map : string String.Map.t -> t + +val iter : t -> f:(string -> string -> unit) -> unit diff --git a/src/super_context.ml b/src/super_context.ml index 30a60948..2ccf30f9 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -739,6 +739,10 @@ module Deps = struct | Universe -> Build.path Build_system.universe_file >>^ 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 = List.map l ~f:(dep t ~scope ~dir) diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 1f5680f3..32f9f5db 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -159,6 +159,14 @@ test-cases/env (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 (name envs-and-contexts) (deps (package dune) (source_tree test-cases/envs-and-contexts)) @@ -867,6 +875,7 @@ (alias dune-project-edition) (alias dup-fields) (alias env) + (alias env-tracking) (alias exclude-missing-module) (alias exec-cmd) (alias exec-missing) @@ -972,6 +981,7 @@ (alias dune-project-edition) (alias dup-fields) (alias env) + (alias env-tracking) (alias exclude-missing-module) (alias exec-cmd) (alias exec-missing) diff --git a/test/blackbox-tests/test-cases/env-tracking/a.ml b/test/blackbox-tests/test-cases/env-tracking/a.ml new file mode 100644 index 00000000..85d70d79 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-tracking/a.ml @@ -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" diff --git a/test/blackbox-tests/test-cases/env-tracking/dune b/test/blackbox-tests/test-cases/env-tracking/dune new file mode 100644 index 00000000..1b80d9a1 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-tracking/dune @@ -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)) +) diff --git a/test/blackbox-tests/test-cases/env-tracking/dune-project b/test/blackbox-tests/test-cases/env-tracking/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-tracking/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/env-tracking/run.t b/test/blackbox-tests/test-cases/env-tracking/run.t new file mode 100644 index 00000000..09bdcaa9 --- /dev/null +++ b/test/blackbox-tests/test-cases/env-tracking/run.t @@ -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