From dea2ac77cab3f35ac6d8cca9d3ba0ca82793a5aa Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 15 Mar 2018 18:17:00 +0800 Subject: [PATCH 1/3] No optional args for context --- src/action.ml | 2 +- src/action.mli | 2 +- src/build_interpret.ml | 2 +- src/build_interpret.mli | 2 +- src/build_system.ml | 8 +++++--- src/super_context.ml | 4 ++-- 6 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/action.ml b/src/action.ml index 2e5bd7e7..f91ac157 100644 --- a/src/action.ml +++ b/src/action.ml @@ -888,7 +888,7 @@ and exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to = exec t ~ectx ~dir ~env ~stdout_to ~stderr_to >>= fun () -> exec_list rest ~ectx ~dir ~env ~stdout_to ~stderr_to -let exec ~targets ?context t = +let exec ~targets ~context t = let env = match (context : Context.t option) with | None -> Env.initial () diff --git a/src/action.mli b/src/action.mli index b85f7254..87df693b 100644 --- a/src/action.mli +++ b/src/action.mli @@ -112,7 +112,7 @@ module Unexpanded : sig -> Partial.t end -val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Fiber.t +val exec : targets:Path.Set.t -> context:Context.t option -> t -> unit Fiber.t (* Return a sandboxed version of an action *) val sandbox diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 42c4a902..37c55471 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -191,7 +191,7 @@ module Rule = struct } let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza) - ?context ?(locks=[]) ?loc build = + ~context ?(locks=[]) ?loc build = let targets = targets build in let dir = match targets with diff --git a/src/build_interpret.mli b/src/build_interpret.mli index e96b1794..5d2f08c7 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -25,7 +25,7 @@ module Rule : sig val make : ?sandbox:bool -> ?mode:Jbuild.Rule.Mode.t - -> ?context:Context.t + -> context:Context.t option -> ?locks:Path.t list -> ?loc:Loc.t -> (unit, Action.t) Build.t diff --git a/src/build_system.ml b/src/build_system.ml index ac56495a..05997a31 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -736,7 +736,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = in make_local_dirs t (Action.chdirs action); with_locks locks ~f:(fun () -> - Action.exec ?context ~targets action) >>| fun () -> + Action.exec ~context ~targets action) >>| fun () -> Option.iter sandbox_dir ~f:Path.rm_rf; (* All went well, these targets are no longer pending *) pending_targets := Pset.diff !pending_targets targets; @@ -783,7 +783,7 @@ and setup_copy_rules t ~ctx_dir ~non_target_source_files = This allows to keep generated files in tarballs. Maybe we should allow it on a case-by-case basis though. *) - compile_rule t (Pre_rule.make build) ~copy_source:true) + compile_rule t (Pre_rule.make build ~context:None) ~copy_source:true) and load_dir t ~dir = ignore (load_dir_and_get_targets t ~dir : Pset.t) and targets_of t ~dir = load_dir_and_get_targets t ~dir @@ -860,13 +860,14 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = ~suffix:("-" ^ Digest.to_hex stamp) in let rule = - Pre_rule.make ~locks + Pre_rule.make ~locks ~context:None (Build.progn [ action; Build.create_file path ]) in (rule :: rules, Pset.add deps path)) in let path = Path.extend_basename base_path ~suffix:Alias0.suffix in (Pre_rule.make + ~context:None (Build.path_set deps >>> Build.action ~targets:[path] (Redirect (Stdout, @@ -1074,6 +1075,7 @@ let stamp_file_for_files_of t ~dir ~ext = compile_rule t (let open Build.O in Pre_rule.make + ~context:None (Build.paths files >>> Build.action ~targets:[stamp_file] (Action.with_stdout_to stamp_file diff --git a/src/super_context.ml b/src/super_context.ml index ca13e310..6865261d 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -209,13 +209,13 @@ let add_rule t ?sandbox ?mode ?locks ?loc build = let build = Build.O.(>>>) build t.chdir in Build_system.add_rule t.build_system (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc - ~context:t.context build) + ~context:(Some t.context) build) let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build = let build = Build.O.(>>>) build t.chdir in let rule = Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc - ~context:t.context build + ~context:(Some t.context) build in Build_system.add_rule t.build_system rule; List.map rule.targets ~f:Build_interpret.Target.path From bd457ea549b9e30fca996a7a85e65b51bc306666 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 15 Mar 2018 18:18:15 +0800 Subject: [PATCH 2/3] Use Env.t over string array in another place --- bin/main.ml | 1 + src/context.ml | 2 +- src/context.mli | 2 +- src/env.ml | 3 +++ src/env.mli | 2 ++ 5 files changed, 8 insertions(+), 2 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 318f1046..28f6539f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -49,6 +49,7 @@ let set_common c ~targets = ] let restore_cwd_and_execve common prog argv env = + let env = Env.to_unix env in let prog = if Filename.is_relative prog then Filename.concat common.root prog diff --git a/src/context.ml b/src/context.ml index 794464c8..3cce4ab6 100644 --- a/src/context.ml +++ b/src/context.ml @@ -433,7 +433,7 @@ let env_for_exec t = (Config.local_install_man_dir ~context:t.name) ] in - Env.to_unix (Env.extend t.env ~vars:(Env.Map.of_list_exn vars)) + Env.extend t.env ~vars:(Env.Map.of_list_exn vars) let compiler t (mode : Mode.t) = match mode with diff --git a/src/context.mli b/src/context.mli index 974b0bd7..a1b54065 100644 --- a/src/context.mli +++ b/src/context.mli @@ -130,7 +130,7 @@ val opam_config_var : t -> string -> string option Fiber.t val install_prefix : t -> Path.t Fiber.t val install_ocaml_libdir : t -> Path.t option Fiber.t -val env_for_exec : t -> string array +val env_for_exec : t -> Env.t (** Return the compiler needed for this compilation mode *) val compiler : t -> Mode.t -> Path.t option diff --git a/src/env.ml b/src/env.ml index 7b625243..ce553e87 100644 --- a/src/env.ml +++ b/src/env.ml @@ -69,6 +69,9 @@ let add t ~var ~value = let extend t ~vars = make (Map.union t.vars vars ~f:(fun _ _ v -> Some v)) +let extend_env x y = + extend x ~vars:y.vars + let sexp_of_t t = let open Sexp.To_sexp in (list (pair string string)) (Map.to_list t.vars) diff --git a/src/env.mli b/src/env.mli index 7a91a654..37cd5fe1 100644 --- a/src/env.mli +++ b/src/env.mli @@ -17,6 +17,8 @@ val get : t -> Var.t -> string option val extend : t -> vars:string Map.t -> t +val extend_env : t -> t -> t + val add : t -> var:Var.t -> value:string -> t val diff : t -> t -> t From 9a1910cf6f8d436636be9cf7d045ca5f8f3a87a6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 15 Mar 2018 18:19:20 +0800 Subject: [PATCH 3/3] Add context for alias actions --- src/build_system.ml | 25 ++++++++++++++----------- src/build_system.mli | 1 + src/super_context.ml | 2 +- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 05997a31..275fed05 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -292,6 +292,7 @@ module Dir_status = struct { stamp : Digest.t ; action : (unit, Action.t) Build.t ; locks : Path.t list + ; context : Context.t } @@ -854,16 +855,17 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = let base_path = Path.relative alias_dir name in let rules, deps = List.fold_left actions ~init:(rules, deps) - ~f:(fun (rules, deps) { Dir_status. stamp; action; locks } -> - let path = - Path.extend_basename base_path - ~suffix:("-" ^ Digest.to_hex stamp) - in - let rule = - Pre_rule.make ~locks ~context:None - (Build.progn [ action; Build.create_file path ]) - in - (rule :: rules, Pset.add deps path)) + ~f:(fun (rules, deps) + { Dir_status. stamp; action; locks ; context } -> + let path = + Path.extend_basename base_path + ~suffix:("-" ^ Digest.to_hex stamp) + in + let rule = + Pre_rule.make ~locks ~context:(Some context) + (Build.progn [ action; Build.create_file path ]) + in + (rule :: rules, Pset.add deps path)) in let path = Path.extend_basename base_path ~suffix:Alias0.suffix in (Pre_rule.make @@ -1479,11 +1481,12 @@ module Alias = struct let def = get_alias_def build_system t in def.deps <- Pset.union def.deps (Pset.of_list deps) - let add_action build_system t ?(locks=[]) ~stamp action = + let add_action build_system t ~context ?(locks=[]) ~stamp action = let def = get_alias_def build_system t in def.actions <- { stamp = Digest.string (Sexp.to_string stamp) ; action ; locks + ; context } :: def.actions end diff --git a/src/build_system.mli b/src/build_system.mli index b10a10fc..df6edbc5 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -140,6 +140,7 @@ module Alias : sig val add_action : build_system -> t + -> context:Context.t -> ?locks:Path.t list -> stamp:Sexp.t -> (unit, Action.t) Build.t diff --git a/src/super_context.ml b/src/super_context.ml index 6865261d..a646304a 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -227,7 +227,7 @@ let add_alias_deps t alias deps = Alias.add_deps t.build_system alias deps let add_alias_action t alias ?locks ~stamp action = - Alias.add_action t.build_system alias ?locks ~stamp action + Alias.add_action t.build_system ~context:t.context alias ?locks ~stamp action let eval_glob t ~dir re = Build_system.eval_glob t.build_system ~dir re let load_dir t ~dir = Build_system.load_dir t.build_system ~dir