Merge pull request #619 from rgrinberg/install-run-fixes
Tweaks to Actions
This commit is contained in:
commit
3c7e6adc73
|
@ -49,6 +49,7 @@ let set_common c ~targets =
|
||||||
]
|
]
|
||||||
|
|
||||||
let restore_cwd_and_execve common prog argv env =
|
let restore_cwd_and_execve common prog argv env =
|
||||||
|
let env = Env.to_unix env in
|
||||||
let prog =
|
let prog =
|
||||||
if Filename.is_relative prog then
|
if Filename.is_relative prog then
|
||||||
Filename.concat common.root prog
|
Filename.concat common.root prog
|
||||||
|
|
|
@ -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 t ~ectx ~dir ~env ~stdout_to ~stderr_to >>= fun () ->
|
||||||
exec_list rest ~ectx ~dir ~env ~stdout_to ~stderr_to
|
exec_list rest ~ectx ~dir ~env ~stdout_to ~stderr_to
|
||||||
|
|
||||||
let exec ~targets ?context t =
|
let exec ~targets ~context t =
|
||||||
let env =
|
let env =
|
||||||
match (context : Context.t option) with
|
match (context : Context.t option) with
|
||||||
| None -> Env.initial ()
|
| None -> Env.initial ()
|
||||||
|
|
|
@ -112,7 +112,7 @@ module Unexpanded : sig
|
||||||
-> Partial.t
|
-> Partial.t
|
||||||
end
|
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 *)
|
(* Return a sandboxed version of an action *)
|
||||||
val sandbox
|
val sandbox
|
||||||
|
|
|
@ -191,7 +191,7 @@ module Rule = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza)
|
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 targets = targets build in
|
||||||
let dir =
|
let dir =
|
||||||
match targets with
|
match targets with
|
||||||
|
|
|
@ -25,7 +25,7 @@ module Rule : sig
|
||||||
val make
|
val make
|
||||||
: ?sandbox:bool
|
: ?sandbox:bool
|
||||||
-> ?mode:Jbuild.Rule.Mode.t
|
-> ?mode:Jbuild.Rule.Mode.t
|
||||||
-> ?context:Context.t
|
-> context:Context.t option
|
||||||
-> ?locks:Path.t list
|
-> ?locks:Path.t list
|
||||||
-> ?loc:Loc.t
|
-> ?loc:Loc.t
|
||||||
-> (unit, Action.t) Build.t
|
-> (unit, Action.t) Build.t
|
||||||
|
|
|
@ -292,6 +292,7 @@ module Dir_status = struct
|
||||||
{ stamp : Digest.t
|
{ stamp : Digest.t
|
||||||
; action : (unit, Action.t) Build.t
|
; action : (unit, Action.t) Build.t
|
||||||
; locks : Path.t list
|
; locks : Path.t list
|
||||||
|
; context : Context.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -736,7 +737,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
in
|
in
|
||||||
make_local_dirs t (Action.chdirs action);
|
make_local_dirs t (Action.chdirs action);
|
||||||
with_locks locks ~f:(fun () ->
|
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;
|
Option.iter sandbox_dir ~f:Path.rm_rf;
|
||||||
(* All went well, these targets are no longer pending *)
|
(* All went well, these targets are no longer pending *)
|
||||||
pending_targets := Pset.diff !pending_targets targets;
|
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
|
This allows to keep generated files in tarballs. Maybe we
|
||||||
should allow it on a case-by-case basis though. *)
|
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 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
|
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 base_path = Path.relative alias_dir name in
|
||||||
let rules, deps =
|
let rules, deps =
|
||||||
List.fold_left actions ~init:(rules, deps)
|
List.fold_left actions ~init:(rules, deps)
|
||||||
~f:(fun (rules, deps) { Dir_status. stamp; action; locks } ->
|
~f:(fun (rules, deps)
|
||||||
let path =
|
{ Dir_status. stamp; action; locks ; context } ->
|
||||||
Path.extend_basename base_path
|
let path =
|
||||||
~suffix:("-" ^ Digest.to_hex stamp)
|
Path.extend_basename base_path
|
||||||
in
|
~suffix:("-" ^ Digest.to_hex stamp)
|
||||||
let rule =
|
in
|
||||||
Pre_rule.make ~locks
|
let rule =
|
||||||
(Build.progn [ action; Build.create_file path ])
|
Pre_rule.make ~locks ~context:(Some context)
|
||||||
in
|
(Build.progn [ action; Build.create_file path ])
|
||||||
(rule :: rules, Pset.add deps path))
|
in
|
||||||
|
(rule :: rules, Pset.add deps path))
|
||||||
in
|
in
|
||||||
let path = Path.extend_basename base_path ~suffix:Alias0.suffix in
|
let path = Path.extend_basename base_path ~suffix:Alias0.suffix in
|
||||||
(Pre_rule.make
|
(Pre_rule.make
|
||||||
|
~context:None
|
||||||
(Build.path_set deps >>>
|
(Build.path_set deps >>>
|
||||||
Build.action ~targets:[path]
|
Build.action ~targets:[path]
|
||||||
(Redirect (Stdout,
|
(Redirect (Stdout,
|
||||||
|
@ -1074,6 +1077,7 @@ let stamp_file_for_files_of t ~dir ~ext =
|
||||||
compile_rule t
|
compile_rule t
|
||||||
(let open Build.O in
|
(let open Build.O in
|
||||||
Pre_rule.make
|
Pre_rule.make
|
||||||
|
~context:None
|
||||||
(Build.paths files >>>
|
(Build.paths files >>>
|
||||||
Build.action ~targets:[stamp_file]
|
Build.action ~targets:[stamp_file]
|
||||||
(Action.with_stdout_to stamp_file
|
(Action.with_stdout_to stamp_file
|
||||||
|
@ -1477,11 +1481,12 @@ module Alias = struct
|
||||||
let def = get_alias_def build_system t in
|
let def = get_alias_def build_system t in
|
||||||
def.deps <- Pset.union def.deps (Pset.of_list deps)
|
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
|
let def = get_alias_def build_system t in
|
||||||
def.actions <- { stamp = Digest.string (Sexp.to_string stamp)
|
def.actions <- { stamp = Digest.string (Sexp.to_string stamp)
|
||||||
; action
|
; action
|
||||||
; locks
|
; locks
|
||||||
|
; context
|
||||||
} :: def.actions
|
} :: def.actions
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -140,6 +140,7 @@ module Alias : sig
|
||||||
val add_action
|
val add_action
|
||||||
: build_system
|
: build_system
|
||||||
-> t
|
-> t
|
||||||
|
-> context:Context.t
|
||||||
-> ?locks:Path.t list
|
-> ?locks:Path.t list
|
||||||
-> stamp:Sexp.t
|
-> stamp:Sexp.t
|
||||||
-> (unit, Action.t) Build.t
|
-> (unit, Action.t) Build.t
|
||||||
|
|
|
@ -433,7 +433,7 @@ let env_for_exec t =
|
||||||
(Config.local_install_man_dir ~context:t.name)
|
(Config.local_install_man_dir ~context:t.name)
|
||||||
]
|
]
|
||||||
in
|
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) =
|
let compiler t (mode : Mode.t) =
|
||||||
match mode with
|
match mode with
|
||||||
|
|
|
@ -130,7 +130,7 @@ val opam_config_var : t -> string -> string option Fiber.t
|
||||||
val install_prefix : t -> Path.t Fiber.t
|
val install_prefix : t -> Path.t Fiber.t
|
||||||
val install_ocaml_libdir : t -> Path.t option 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 *)
|
(** Return the compiler needed for this compilation mode *)
|
||||||
val compiler : t -> Mode.t -> Path.t option
|
val compiler : t -> Mode.t -> Path.t option
|
||||||
|
|
|
@ -69,6 +69,9 @@ let add t ~var ~value =
|
||||||
let extend t ~vars =
|
let extend t ~vars =
|
||||||
make (Map.union t.vars vars ~f:(fun _ _ v -> Some v))
|
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 sexp_of_t t =
|
||||||
let open Sexp.To_sexp in
|
let open Sexp.To_sexp in
|
||||||
(list (pair string string)) (Map.to_list t.vars)
|
(list (pair string string)) (Map.to_list t.vars)
|
||||||
|
|
|
@ -17,6 +17,8 @@ val get : t -> Var.t -> string option
|
||||||
|
|
||||||
val extend : t -> vars:string Map.t -> t
|
val extend : t -> vars:string Map.t -> t
|
||||||
|
|
||||||
|
val extend_env : t -> t -> t
|
||||||
|
|
||||||
val add : t -> var:Var.t -> value:string -> t
|
val add : t -> var:Var.t -> value:string -> t
|
||||||
|
|
||||||
val diff : t -> t -> t
|
val diff : t -> t -> t
|
||||||
|
|
|
@ -209,13 +209,13 @@ let add_rule t ?sandbox ?mode ?locks ?loc build =
|
||||||
let build = Build.O.(>>>) build t.chdir in
|
let build = Build.O.(>>>) build t.chdir in
|
||||||
Build_system.add_rule t.build_system
|
Build_system.add_rule t.build_system
|
||||||
(Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
|
(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 add_rule_get_targets t ?sandbox ?mode ?locks ?loc build =
|
||||||
let build = Build.O.(>>>) build t.chdir in
|
let build = Build.O.(>>>) build t.chdir in
|
||||||
let rule =
|
let rule =
|
||||||
Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
|
Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
|
||||||
~context:t.context build
|
~context:(Some t.context) build
|
||||||
in
|
in
|
||||||
Build_system.add_rule t.build_system rule;
|
Build_system.add_rule t.build_system rule;
|
||||||
List.map rule.targets ~f:Build_interpret.Target.path
|
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
|
Alias.add_deps t.build_system alias deps
|
||||||
|
|
||||||
let add_alias_action t alias ?locks ~stamp action =
|
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 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
|
let load_dir t ~dir = Build_system.load_dir t.build_system ~dir
|
||||||
|
|
Loading…
Reference in New Issue