Change the prog arg in Process to Path.t

This commit is contained in:
Rudi Grinberg 2018-04-25 16:30:18 +07:00
parent 729e85716c
commit b02c61f63c
8 changed files with 21 additions and 25 deletions

View File

@ -1007,8 +1007,7 @@ let install_uninstall ~what =
>>= fun libdir -> >>= fun libdir ->
Fiber.parallel_iter install_files ~f:(fun path -> Fiber.parallel_iter install_files ~f:(fun path ->
let purpose = Process.Build_job install_files in let purpose = Process.Build_job install_files in
Process.run ~purpose ~env:setup.env Strict Process.run ~purpose ~env:setup.env Strict opam_installer
(Path.to_string opam_installer)
([ sprintf "-%c" what.[0] ([ sprintf "-%c" what.[0]
; Path.to_string path ; Path.to_string path
; "--prefix" ; "--prefix"

View File

@ -109,7 +109,7 @@ let opam_config_var ~env ~cache var =
match Bin.opam with match Bin.opam with
| None -> Fiber.return None | None -> Fiber.return None
| Some fn -> | Some fn ->
Process.run_capture (Accept All) (Path.to_string fn) ~env Process.run_capture (Accept All) fn ~env
["config"; "var"; var] ["config"; "var"; var]
>>| function >>| function
| Ok s -> | Ok s ->
@ -151,7 +151,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
| Some s -> Fiber.return (Path.absolute s) | Some s -> Fiber.return (Path.absolute s)
| None -> | None ->
Process.run_capture_line ~env Strict Process.run_capture_line ~env Strict
(Path.to_string fn) ["printconf"; "conf"] fn ["printconf"; "conf"]
>>| Path.absolute) >>| Path.absolute)
in in
@ -232,7 +232,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
| None -> args | None -> args
| Some s -> "-toolchain" :: s :: args | Some s -> "-toolchain" :: s :: args
in in
Process.run_capture_lines ~env Strict (Path.to_string fn) args Process.run_capture_lines ~env Strict fn args
>>| fun l -> >>| fun l ->
(* Don't prepend the contents of [OCAMLPATH] since findlib (* Don't prepend the contents of [OCAMLPATH] since findlib
does it already *) does it already *)
@ -258,8 +258,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
Fiber.fork_and_join Fiber.fork_and_join
findlib_path findlib_path
(fun () -> (fun () ->
Process.run_capture_lines ~env Strict Process.run_capture_lines ~env Strict ocamlc ["-config"]
(Path.to_string ocamlc) ["-config"]
>>| fun lines -> >>| fun lines ->
let open Result.O in let open Result.O in
ocaml_config_ok_exn ocaml_config_ok_exn
@ -411,10 +410,9 @@ let create_for_opam ?root ~env ~targets ~switch ~name ?(merlin=false) () =
(match root with (match root with
| Some root -> Fiber.return root | Some root -> Fiber.return root
| None -> | None ->
Process.run_capture_line Strict ~env Process.run_capture_line Strict ~env fn ["config"; "var"; "root"])
(Path.to_string fn) ["config"; "var"; "root"])
>>= fun root -> >>= fun root ->
Process.run_capture ~env Strict (Path.to_string fn) Process.run_capture ~env Strict fn
["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"] ["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"]
>>= fun s -> >>= fun s ->
let vars = let vars =
@ -465,8 +463,7 @@ let install_ocaml_libdir t =
(* If ocamlfind is present, it has precedence over everything else. *) (* If ocamlfind is present, it has precedence over everything else. *)
match which t "ocamlfind" with match which t "ocamlfind" with
| Some fn -> | Some fn ->
(Process.run_capture_line ~env:t.env Strict (Process.run_capture_line ~env:t.env Strict fn ["printconf"; "destdir"]
(Path.to_string fn) ["printconf"; "destdir"]
>>| fun s -> >>| fun s ->
Some (Path.absolute s)) Some (Path.absolute s))
| None -> | None ->

View File

@ -147,9 +147,7 @@ end
in in
]} ]}
*) *)
Process.run Strict ~dir Process.run Strict ~dir ~env:context.env context.ocaml
~env:context.env
(Path.to_string context.ocaml)
args args
>>= fun () -> >>= fun () ->
if not (Path.exists generated_jbuild) then if not (Path.exists generated_jbuild) then

View File

@ -24,8 +24,7 @@ let print path1 path2 =
| None -> fallback () | None -> fallback ()
| Some prog -> | Some prog ->
Format.eprintf "%a@?" Loc.print loc; Format.eprintf "%a@?" Loc.print loc;
Process.run ~dir ~env:Env.initial Strict (Path.to_string prog) Process.run ~dir ~env:Env.initial Strict prog ["-u"; file1; file2]
["-u"; file1; file2]
>>= fun () -> >>= fun () ->
fallback () fallback ()
in in
@ -35,7 +34,7 @@ let print path1 path2 =
let cmd = let cmd =
sprintf "%s %s %s" cmd (quote_for_shell file1) (quote_for_shell file2) sprintf "%s %s %s" cmd (quote_for_shell file1) (quote_for_shell file2)
in in
Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd] Process.run ~dir ~env:Env.initial Strict sh [arg; cmd]
>>= fun () -> >>= fun () ->
die "command reported no differences: %s" die "command reported no differences: %s"
(if Path.is_root dir then (if Path.is_root dir then
@ -46,7 +45,7 @@ let print path1 path2 =
match Bin.which "patdiff" with match Bin.which "patdiff" with
| None -> normal_diff () | None -> normal_diff ()
| Some prog -> | Some prog ->
Process.run ~dir ~env:Env.initial Strict (Path.to_string prog) Process.run ~dir ~env:Env.initial Strict prog
[ "-keep-whitespace" [ "-keep-whitespace"
; "-location-style"; "omake" ; "-location-style"; "omake"
; if Lazy.force Colors.stderr_supports_colors then ; if Lazy.force Colors.stderr_supports_colors then

View File

@ -112,6 +112,7 @@ module Fancy = struct
| x :: rest -> x :: colorize_args rest | x :: rest -> x :: colorize_args rest
let command_line ~prog ~args ~dir ~stdout_to ~stderr_to = let command_line ~prog ~args ~dir ~stdout_to ~stderr_to =
let prog = Path.to_string prog in
let quote = quote_for_shell in let quote = quote_for_shell in
let prog = colorize_prog (quote prog) in let prog = colorize_prog (quote prog) in
let s = let s =
@ -228,6 +229,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
if display = Verbose then if display = Verbose then
Format.eprintf "@{<kwd>Running@}[@{<id>%d@}]: %s@." id Format.eprintf "@{<kwd>Running@}[@{<id>%d@}]: %s@." id
(Colors.strip_colors_for_stderr command_line); (Colors.strip_colors_for_stderr command_line);
let prog = Path.to_string prog in
let argv = Array.of_list (prog :: args) in let argv = Array.of_list (prog :: args) in
let output_filename, stdout_fd, stderr_fd, to_close = let output_filename, stdout_fd, stderr_fd, to_close =
match stdout_to, stderr_to with match stdout_to, stderr_to with
@ -342,6 +344,7 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args =
| [x] -> x | [x] -> x
| l -> | l ->
let cmdline = let cmdline =
let prog = Path.to_string prog in
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

View File

@ -44,7 +44,7 @@ val run
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (unit, 'a) failure_mode -> (unit, 'a) failure_mode
-> string -> Path.t
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t
@ -54,7 +54,7 @@ val run_capture
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string, 'a) failure_mode -> (string, 'a) failure_mode
-> string -> Path.t
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t
val run_capture_line val run_capture_line
@ -62,7 +62,7 @@ val run_capture_line
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string, 'a) failure_mode -> (string, 'a) failure_mode
-> string -> Path.t
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t
val run_capture_lines val run_capture_lines
@ -70,7 +70,7 @@ val run_capture_lines
-> env:Env.t -> env:Env.t
-> ?purpose:purpose -> ?purpose:purpose
-> (string list, 'a) failure_mode -> (string list, 'a) failure_mode
-> string -> Path.t
-> string list -> string list
-> 'a Fiber.t -> 'a Fiber.t

View File

@ -70,7 +70,7 @@ val absolute : string -> t
val to_absolute_filename : t -> root:string -> string val to_absolute_filename : t -> root:string -> string
val reach : t -> from:t -> string val reach : t -> from:t -> string
val reach_for_running : t -> from:t -> string val reach_for_running : t -> from:t -> t
val descendant : t -> of_:t -> t option val descendant : t -> of_:t -> t option
val is_descendant : t -> of_:t -> bool val is_descendant : t -> of_:t -> bool

View File

@ -201,7 +201,7 @@ let subst_git ?name () =
let rev = "HEAD" in let rev = "HEAD" in
let git = let git =
match Bin.which "git" with match Bin.which "git" with
| Some x -> Path.to_string x | Some x -> x
| None -> Utils.program_not_found "git" | None -> Utils.program_not_found "git"
in in
let env = Env.initial in let env = Env.initial in