diff --git a/CHANGES.md b/CHANGES.md index 82ed695b152..301eb893f90 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,6 +13,9 @@ unreleased - Fix preprocessing for libraries with `(include_subdirs ..)` (#1624, fix #1626, @nojb, @rgrinberg) +- Delay opening redirected output files until executing commands (#1633, + @jonludlam) + 1.6.2 (05/12/2018) ------------------ diff --git a/src/action_exec.ml b/src/action_exec.ml index 274e18bc971..a19113a5639 100644 --- a/src/action_exec.ml +++ b/src/action_exec.ml @@ -8,12 +8,8 @@ type exec_context = } let get_std_output : _ -> Process.std_output_to = function - | None -> Terminal - | Some (fn, oc) -> - Opened_file { filename = fn - ; tail = false - ; desc = Channel oc } - + | None -> Terminal + | Some fn -> File fn let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args = begin match ectx.context with @@ -44,7 +40,7 @@ let exec_echo stdout_to str = Fiber.return (match stdout_to with | None -> print_string str; flush stdout - | Some (_, oc) -> output_string oc str) + | Some fn -> Io.write_file fn str) let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = match (t : Action.t) with @@ -60,15 +56,6 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = | Redirect (Stdout, fn, Echo s) -> Io.write_file fn (String.concat s ~sep:" "); Fiber.return () - | Redirect (outputs, fn, Run (Ok prog, args)) -> - let out = Process.File fn in - let stdout_to, stderr_to = - match outputs with - | Stdout -> (out, get_std_output stderr_to) - | Stderr -> (get_std_output stdout_to, out) - | Outputs -> (out, out) - in - exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args | Redirect (outputs, fn, t) -> redirect ~ectx ~dir outputs fn t ~env ~stdout_to ~stderr_to | Ignore (outputs, t) -> @@ -78,12 +65,9 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = | Echo strs -> exec_echo stdout_to (String.concat strs ~sep:" ") | Cat fn -> Io.with_file_in fn ~f:(fun ic -> - let oc = - match stdout_to with - | None -> stdout - | Some (_, oc) -> oc - in - Io.copy_channels ic oc); + match stdout_to with + | None -> Io.copy_channels ic stdout + | Some fn -> Io.with_file_out fn ~f:(fun oc -> Io.copy_channels ic oc)); Fiber.return () | Copy (src, dst) -> Io.copy_file ~src ~dst (); @@ -195,16 +179,16 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Fiber.return () and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = - let oc = Io.open_out fn in - let out = Some (fn, oc) in + (* We resolve the path to an absolute one here to ensure no + Chdir actions change the eventual path of the file *) + let out = Some (Path.to_absolute fn) in let stdout_to, stderr_to = match outputs with | Stdout -> (out, stderr_to) | Stderr -> (stdout_to, out) | Outputs -> (out, out) in - exec t ~ectx ~dir ~env ~stdout_to ~stderr_to >>| fun () -> - close_out oc + exec t ~ectx ~dir ~env ~stdout_to ~stderr_to and exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to = match l with diff --git a/src/build.ml b/src/build.ml index 7027ed48b99..277e16d5929 100644 --- a/src/build.ml +++ b/src/build.ml @@ -249,7 +249,7 @@ let symlink ~src ~dst = action ~targets:[dst] (Symlink (src, dst)) let create_file fn = - action ~targets:[fn] (Redirect (Stdout, fn, Progn [])) + action ~targets:[fn] (Redirect (Stdout, fn, Echo [])) let remove_tree dir = arr (fun _ -> Action.Remove_tree dir) diff --git a/src/process.ml b/src/process.ml index 59e2ed983fc..78a5c0249cd 100644 --- a/src/process.ml +++ b/src/process.ml @@ -33,17 +33,6 @@ let map_result type std_output_to = | Terminal | File of Path.t - | Opened_file of opened_file - -and opened_file = - { filename : Path.t - ; desc : opened_file_desc - ; tail : bool - } - -and opened_file_desc = - | Fd of Unix.file_descr - | Channel of out_channel type purpose = | Internal_job @@ -125,19 +114,18 @@ module Fancy = struct | Some dir -> sprintf "(cd %s && %s)" (Path.to_string dir) s in match stdout_to, stderr_to with - | (File fn1 | Opened_file { filename = fn1; _ }), - (File fn2 | Opened_file { filename = fn2; _ }) when Path.equal fn1 fn2 -> + | File fn1, File fn2 when Path.equal fn1 fn2 -> sprintf "%s &> %s" s (Path.to_string fn1) | _ -> let s = match stdout_to with | Terminal -> s - | File fn | Opened_file { filename = fn; _ } -> + | File fn -> sprintf "%s > %s" s (Path.to_string fn) in match stderr_to with | Terminal -> s - | File fn | Opened_file { filename = fn; _ } -> + | File fn -> sprintf "%s 2> %s" s (Path.to_string fn) let pp_purpose ppf = function @@ -196,19 +184,11 @@ let get_std_output ~default = function | File fn -> let fd = Unix.openfile (Path.to_string fn) [O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in - (fd, Some (Fd fd)) - | Opened_file { desc; tail; _ } -> - let fd = - match desc with - | Fd fd -> fd - | Channel oc -> flush oc; Unix.descr_of_out_channel oc - in - (fd, Option.some_if tail desc) + (fd, Some fd) let close_std_output = function | None -> () - | Some (Fd fd) -> Unix.close fd - | Some (Channel oc) -> close_out oc + | Some fd -> Unix.close fd let gen_id = let next = ref (-1) in diff --git a/src/process.mli b/src/process.mli index 3c882636f97..a3d842929bd 100644 --- a/src/process.mli +++ b/src/process.mli @@ -18,18 +18,6 @@ type ('a, 'b) failure_mode = type std_output_to = | Terminal | File of Path.t - | Opened_file of opened_file - -and opened_file = - { filename : Path.t - ; desc : opened_file_desc - ; tail : bool - (** If [true], the descriptor is closed after starting the command *) - } - -and opened_file_desc = - | Fd of Unix.file_descr - | Channel of out_channel (** Why a Fiber.t was run *) type purpose = diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 0a321d9f439..003381fb41a 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -643,6 +643,8 @@ let of_filename_relative_to_initial_cwd fn = let to_absolute_filename t = Kind.to_absolute_filename (kind t) +let to_absolute t = external_ (External.of_string (to_absolute_filename t)) + let external_of_local x ~root = External.to_string (External.relative root (Local.to_string x)) diff --git a/src/stdune/path.mli b/src/stdune/path.mli index e40c6c47742..c00d3682881 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -76,6 +76,9 @@ val of_filename_relative_to_initial_cwd : string -> t root has been set. [root] is the root directory of local paths *) val to_absolute_filename : t -> string +(** Convert any path to an absolute path *) +val to_absolute : t -> t + val reach : t -> from:t -> string (** [from] defaults to [Path.root] *)