Change the prog arg in Process to Path.t
This commit is contained in:
parent
729e85716c
commit
b02c61f63c
|
@ -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"
|
||||||
|
|
|
@ -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 ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue