Change Process.run's ~dir argument to use Path.t

This also requires Scheduler.with_chdir to use Path.t as well
This commit is contained in:
Rudi Grinberg 2018-04-25 13:25:07 +07:00
parent 7820e29d28
commit 5eb444e357
7 changed files with 22 additions and 16 deletions

View File

@ -735,7 +735,7 @@ let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args =
invalid_prefix ("_build/" ^ target.name); invalid_prefix ("_build/" ^ target.name);
invalid_prefix ("_build/install/" ^ target.name); invalid_prefix ("_build/install/" ^ target.name);
end; end;
Process.run Strict ~dir:(Path.to_string dir) ~env Process.run Strict ~dir ~env
~stdout_to ~stderr_to ~stdout_to ~stderr_to
~purpose:ectx.purpose ~purpose:ectx.purpose
(Path.reach_for_running ~from:dir prog) args (Path.reach_for_running ~from:dir prog) args

View File

@ -147,7 +147,7 @@ end
in in
]} ]}
*) *)
Process.run Strict ~dir:(Path.to_string dir) Process.run Strict ~dir
~env:context.env ~env:context.env
(Path.to_string context.ocaml) (Path.to_string context.ocaml)
args args

View File

@ -9,9 +9,9 @@ let print path1 path2 =
Path.extract_build_context_dir path2 Path.extract_build_context_dir path2
with with
| Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 -> | Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 ->
(Path.to_string dir1, Path.to_string f1, Path.to_string f2) (dir1, Path.to_string f1, Path.to_string f2)
| _ -> | _ ->
(".", Path.to_string path1, Path.to_string path2) (Path.root, Path.to_string path1, Path.to_string path2)
in in
let loc = Loc.in_file file1 in let loc = Loc.in_file file1 in
let fallback () = let fallback () =
@ -38,10 +38,10 @@ let print path1 path2 =
Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd] Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd]
>>= fun () -> >>= fun () ->
die "command reported no differences: %s" die "command reported no differences: %s"
(if dir = "." then (if Path.is_root dir then
cmd cmd
else else
sprintf "cd %s && %s" (quote_for_shell dir) cmd) sprintf "cd %s && %s" (quote_for_shell (Path.to_string dir)) cmd)
| None -> | None ->
match Bin.which "patdiff" with match Bin.which "patdiff" with
| None -> normal_diff () | None -> normal_diff ()

View File

@ -121,7 +121,7 @@ module Fancy = struct
let s = let s =
match dir with match dir with
| None -> s | None -> s
| Some dir -> sprintf "(cd %s && %s)" dir s | Some dir -> sprintf "(cd %s && %s)" (Path.to_string dir) s
in in
match stdout_to, stderr_to with match stdout_to, stderr_to with
| (File fn1 | Opened_file { filename = fn1; _ }), | (File fn1 | Opened_file { filename = fn1; _ }),
@ -216,8 +216,12 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
let display = Scheduler.display scheduler in let display = Scheduler.display scheduler in
let dir = let dir =
match dir with match dir with
| Some "." -> None | Some p ->
| _ -> dir if Path.is_root p then
None
else
Some p
| None -> dir
in in
let id = gen_id () in let id = gen_id () in
let ok_codes = accepted_codes fail_mode in let ok_codes = accepted_codes fail_mode in
@ -344,7 +348,7 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args =
let s = String.concat (prog :: args) ~sep:" " in let s = String.concat (prog :: args) ~sep:" " in
match dir with match dir with
| None -> s | None -> s
| Some dir -> sprintf "cd %s && %s" dir s | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) s
in in
match l with match l with
| [] -> | [] ->

View File

@ -38,7 +38,7 @@ type purpose =
(** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *) (** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *)
val run val run
: ?dir:string : ?dir:Path.t
-> ?stdout_to:std_output_to -> ?stdout_to:std_output_to
-> ?stderr_to:std_output_to -> ?stderr_to:std_output_to
-> env:Env.t -> env:Env.t
@ -50,7 +50,7 @@ val run
(** Run a command and capture its output *) (** Run a command and capture its output *)
val run_capture val run_capture
: ?dir:string : ?dir:Path.t
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string, 'a) failure_mode -> (string, 'a) failure_mode
@ -58,7 +58,7 @@ val run_capture
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t
val run_capture_line val run_capture_line
: ?dir:string : ?dir:Path.t
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string, 'a) failure_mode -> (string, 'a) failure_mode
@ -66,7 +66,7 @@ val run_capture_line
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t
val run_capture_lines val run_capture_lines
: ?dir:string : ?dir:Path.t
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string list, 'a) failure_mode -> (string list, 'a) failure_mode

View File

@ -72,7 +72,7 @@ let log t = t.log
let display t = t.display let display t = t.display
let with_chdir t ~dir ~f = let with_chdir t ~dir ~f =
Sys.chdir dir; Sys.chdir (Path.to_string dir);
protectx () ~finally:(fun () -> Sys.chdir t.original_cwd) ~f protectx () ~finally:(fun () -> Sys.chdir t.original_cwd) ~f
let hide_status_line s = let hide_status_line s =

View File

@ -1,5 +1,7 @@
(** Scheduling *) (** Scheduling *)
open Stdune
(** [go ?log ?config ?gen_status_line fiber] runs the following fiber until it (** [go ?log ?config ?gen_status_line fiber] runs the following fiber until it
terminates. [gen_status_line] is used to print a status line when [config.display = terminates. [gen_status_line] is used to print a status line when [config.display =
Progress]. *) Progress]. *)
@ -27,7 +29,7 @@ val wait_for_available_job : unit -> t Fiber.t
val log : t -> Log.t val log : t -> Log.t
(** Execute the given callback with current directory temporarily changed *) (** Execute the given callback with current directory temporarily changed *)
val with_chdir : t -> dir:string -> f:(unit -> 'a) -> 'a val with_chdir : t -> dir:Path.t -> f:(unit -> 'a) -> 'a
(** Display mode for this scheduler *) (** Display mode for this scheduler *)
val display : t -> Config.Display.t val display : t -> Config.Display.t