Merge pull request #619 from rgrinberg/install-run-fixes

Tweaks to Actions

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

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 ()

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

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

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

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
     }
 
 
@@ -736,7 +737,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 +784,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
@@ -854,19 +855,21 @@ 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
-                  (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
+           ~context:None
            (Build.path_set deps >>>
             Build.action ~targets:[path]
               (Redirect (Stdout,
@@ -1074,6 +1077,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
@@ -1477,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
 

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

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

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

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)

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

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
@@ -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