From 95b3235da8bcc8717e5cc906839a71ffcbab0f52 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 11 Dec 2018 23:52:26 +0100 Subject: [PATCH] Revert "Delay opening redirected files until execing cmd (#1635)" This reverts commit 59c4daa34fd441fadb7d56e69774da3ce64bf465. Signed-off-by: Rudi Grinberg --- CHANGES.md | 5 +-- src/action_exec.ml | 36 +++++++++++++------ src/build.ml | 2 +- src/process.ml | 30 +++++++++++++--- src/process.mli | 12 +++++++ src/stdune/path.ml | 2 -- src/stdune/path.mli | 3 -- .../test-cases/double-echo/run.t | 2 +- .../test-cases/enabled_if/run.t | 4 +-- .../test-cases/inline_tests/run.t | 2 +- .../test-cases/redirections/run.t | 15 ++------ test/unit-tests/path.mlt | 2 -- 12 files changed, 70 insertions(+), 45 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 4c54a290794e..18df83a9e849 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,13 +15,10 @@ unreleased - Fix preprocessing for libraries with `(include_subdirs ..)` (#1624, fix #1626, @nojb, @rgrinberg) -- Delay opening redirected output files until executing commands in - order to reduce the number of maximum number of open file - descriptors (#1635, fixes #1633, @jonludlam) - - Do not generate targets for archive that don't match the `modes` field. (#1632, fix #1617, @rgrinberg) +>>>>>>> parent of 59c4daa3... Delay opening redirected files until execing cmd (#1635) 1.6.2 (05/12/2018) ------------------ diff --git a/src/action_exec.ml b/src/action_exec.ml index a19113a56396..274e18bc971b 100644 --- a/src/action_exec.ml +++ b/src/action_exec.ml @@ -8,8 +8,12 @@ type exec_context = } let get_std_output : _ -> Process.std_output_to = function - | None -> Terminal - | Some fn -> File fn + | None -> Terminal + | Some (fn, oc) -> + Opened_file { filename = fn + ; tail = false + ; desc = Channel oc } + let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args = begin match ectx.context with @@ -40,7 +44,7 @@ let exec_echo stdout_to str = Fiber.return (match stdout_to with | None -> print_string str; flush stdout - | Some fn -> Io.write_file fn str) + | Some (_, oc) -> output_string oc str) let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = match (t : Action.t) with @@ -56,6 +60,15 @@ 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) -> @@ -65,9 +78,12 @@ 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 -> - 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)); + let oc = + match stdout_to with + | None -> stdout + | Some (_, oc) -> oc + in + Io.copy_channels ic oc); Fiber.return () | Copy (src, dst) -> Io.copy_file ~src ~dst (); @@ -179,16 +195,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 = - (* 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 oc = Io.open_out fn in + let out = Some (fn, oc) 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 + exec t ~ectx ~dir ~env ~stdout_to ~stderr_to >>| fun () -> + close_out oc 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 277e16d5929d..7027ed48b992 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, Echo [])) + action ~targets:[fn] (Redirect (Stdout, fn, Progn [])) let remove_tree dir = arr (fun _ -> Action.Remove_tree dir) diff --git a/src/process.ml b/src/process.ml index 78a5c0249cdf..59e2ed983fc2 100644 --- a/src/process.ml +++ b/src/process.ml @@ -33,6 +33,17 @@ 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 @@ -114,18 +125,19 @@ module Fancy = struct | Some dir -> sprintf "(cd %s && %s)" (Path.to_string dir) s in match stdout_to, stderr_to with - | File fn1, File fn2 when Path.equal fn1 fn2 -> + | (File fn1 | Opened_file { filename = fn1; _ }), + (File fn2 | Opened_file { filename = fn2; _ }) when Path.equal fn1 fn2 -> sprintf "%s &> %s" s (Path.to_string fn1) | _ -> let s = match stdout_to with | Terminal -> s - | File fn -> + | File fn | Opened_file { filename = fn; _ } -> sprintf "%s > %s" s (Path.to_string fn) in match stderr_to with | Terminal -> s - | File fn -> + | File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s (Path.to_string fn) let pp_purpose ppf = function @@ -184,11 +196,19 @@ 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, 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) let close_std_output = function | None -> () - | Some fd -> Unix.close fd + | Some (Fd fd) -> Unix.close fd + | Some (Channel oc) -> close_out oc let gen_id = let next = ref (-1) in diff --git a/src/process.mli b/src/process.mli index a3d842929bd4..3c882636f97e 100644 --- a/src/process.mli +++ b/src/process.mli @@ -18,6 +18,18 @@ 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 003381fb41a8..0a321d9f439a 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -643,8 +643,6 @@ 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 c00d36828813..e40c6c477423 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -76,9 +76,6 @@ 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] *) diff --git a/test/blackbox-tests/test-cases/double-echo/run.t b/test/blackbox-tests/test-cases/double-echo/run.t index 8b04386b9bb0..86fdd4abfa86 100644 --- a/test/blackbox-tests/test-cases/double-echo/run.t +++ b/test/blackbox-tests/test-cases/double-echo/run.t @@ -1,2 +1,2 @@ $ dune build - bar + foobar diff --git a/test/blackbox-tests/test-cases/enabled_if/run.t b/test/blackbox-tests/test-cases/enabled_if/run.t index 97885a325db2..71475e1fdb0a 100644 --- a/test/blackbox-tests/test-cases/enabled_if/run.t +++ b/test/blackbox-tests/test-cases/enabled_if/run.t @@ -15,6 +15,4 @@ This rule is disabled, trying to build a should fail: This one is enabled: $ dune build b - Building file bError: Rule failed to generate the following targets: - - b - [1] + Building file b diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index 42eeb838336f..2806738a405b 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -51,4 +51,4 @@ (echo "\n") (echo "let () = print_int 43;;"))))) run alias dune-file/runtest - 43 + 414243 diff --git a/test/blackbox-tests/test-cases/redirections/run.t b/test/blackbox-tests/test-cases/redirections/run.t index 44923d83f55b..8df19d09eedf 100644 --- a/test/blackbox-tests/test-cases/redirections/run.t +++ b/test/blackbox-tests/test-cases/redirections/run.t @@ -4,16 +4,5 @@ diff alias runtest sh both sh both - diff alias runtest (exit 1) - (cd _build/default && /usr/bin/diff -uw both.expected both) - --- both.expected 2018-12-11 23:49:42.000000000 +0100 - +++ both 2018-12-11 23:49:42.000000000 +0100 - @@ -1,2 +1 @@ - -toto - titi - diff alias runtest (exit 1) - (cd _build/default && /usr/bin/diff -uw stdout.expected stdout) - --- stdout.expected 2018-12-11 23:49:42.000000000 +0100 - +++ stdout 2018-12-11 23:49:42.000000000 +0100 - @@ -1 +0,0 @@ - -toto + diff alias runtest + diff alias runtest diff --git a/test/unit-tests/path.mlt b/test/unit-tests/path.mlt index c96aaf874ccb..434f590461d8 100644 --- a/test/unit-tests/path.mlt +++ b/test/unit-tests/path.mlt @@ -134,7 +134,6 @@ Path.(descendant (relative build_dir "foo") ~of_:(absolute "/foo/bar")) [%%expect{| File "test/unit-tests/path.mlt", line 133, characters 50-58: Error: Unbound value absolute -Hint: Did you mean to_absolute? |}] Path.(descendant (relative build_dir "foo/bar") ~of_:build_dir) @@ -156,7 +155,6 @@ Path.(descendant (absolute "/foo/bar") ~of_:(absolute "/foo")) [%%expect{| File "test/unit-tests/path.mlt", line 154, characters 18-26: Error: Unbound value absolute -Hint: Did you mean to_absolute? |}] Path.explode (Path.of_string "a/b/c");