Fix Unix.create_process in the case where the same descriptor is used several times (continued)

After the revert to 4.04 implementation in commit d54f631, Damien Doligez came up with a very nice solution, see
https://github.com/ocaml/ocaml/pull/1105#issuecomment-286455646

This commit adopts Damien's solution, and adds a test for swapping stdout and stderr.

1 files changed, 18 insertions, 20 deletions

diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index f60b6fbe74..de379c9639 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -884,36 +884,34 @@ let system cmd =
           end
   | id -> snd(waitpid_non_intr id)
 
-(* Duplicate [fd] and make sure that the resulting descriptor
-   is not one of the standard descriptors 0, 1, 2.
+(* Duplicate [fd] if needed to make sure it isn't one of the
+   standard descriptors (stdin, stdout, stderr).
+   Note that this function always leaves the standard descriptors open,
+   the caller must take care of closing them if needed.
    The "cloexec" mode doesn't matter, because
    the descriptor returned by [dup] will be closed before the [exec],
    and because no other thread is running concurrently
-   (we are in the child process of a fork). *)
-
-let rec safe_dup fd =
-  let new_fd = dup fd in
-  if new_fd >= 3 then
-    new_fd
-  else begin
-    let res = safe_dup fd in
-    close new_fd;
-    res
-  end
+   (we are in the child process of a fork).
+ *)
+let rec file_descr_not_standard fd =
+  if fd >= 3 then fd else file_descr_not_standard (dup fd)
 
 let safe_close fd =
   try close fd with Unix_error(_,_,_) -> ()
 
 let perform_redirections new_stdin new_stdout new_stderr =
-  let newnewstdin = safe_dup new_stdin in
-  let newnewstdout = safe_dup new_stdout in
-  let newnewstderr = safe_dup new_stderr in
+  let new_stdin = file_descr_not_standard new_stdin in
+  let new_stdout = file_descr_not_standard new_stdout in
+  let new_stderr = file_descr_not_standard new_stderr in
+  (*  The three dup2 close the original stdin, stdout, stderr,
+      which are the descriptors possibly left open
+      by file_descr_not_standard *)
+  dup2 ~cloexec:false new_stdin stdin;
+  dup2 ~cloexec:false new_stdout stdout;
+  dup2 ~cloexec:false new_stderr stderr;
   safe_close new_stdin;
   safe_close new_stdout;
-  safe_close new_stderr;
-  dup2 ~cloexec:false newnewstdin stdin; close newnewstdin;
-  dup2 ~cloexec:false newnewstdout stdout; close newnewstdout;
-  dup2 ~cloexec:false newnewstderr stderr; close newnewstderr
+  safe_close new_stderr
 
 let create_process cmd args new_stdin new_stdout new_stderr =
   match fork() with