* adaint.h, adaint.c

	(__gnat_portable_spawn): Fix cast of spawnvp third parameter
	to avoid warnings.
	Add also a cast to kill another warning.
	(win32_no_block_spawn): Initialize CreateProcess's dwCreationFlags
	parameter with the priority class of the parent process instead of
	always using the NORMAL_PRIORITY_CLASS.
	(__gnat_dup): New function.
	(__gnat_dup2): New function.
	(__gnat_is_symbolic_link): Enable the effective body of this
	function when __APPLE__ is defined.

	* g-os_lib.ads, g-os_lib.adb (Spawn): Two new procedures.
	Update comments.

From-SVN: r90899

1 files changed, 74 insertions, 0 deletions

diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb
index d0db36ea5ff..2513d6682d0 100644
--- a/gcc/ada/g-os_lib.adb
+++ b/gcc/ada/g-os_lib.adb
@@ -2143,6 +2143,80 @@ package body GNAT.OS_Lib is
       Success := (Spawn (Program_Name, Args) = 0);
    end Spawn;
 
+   procedure Spawn
+     (Program_Name           : String;
+      Args                   : Argument_List;
+      Output_File_Descriptor : File_Descriptor;
+      Return_Code            : out Integer;
+      Err_To_Out             : Boolean := True)
+   is
+      function Dup (Fd : File_Descriptor) return File_Descriptor;
+      pragma Import (C, Dup, "__gnat_dup");
+
+      procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
+      pragma Import (C, Dup2, "__gnat_dup2");
+
+      Saved_Output : File_Descriptor;
+      Saved_Error  : File_Descriptor;
+
+   begin
+      --  Set standard output and error to the temporary file
+
+      Saved_Output := Dup (Standout);
+      Dup2 (Output_File_Descriptor, Standout);
+
+      if Err_To_Out then
+         Saved_Error  := Dup (Standerr);
+         Dup2 (Output_File_Descriptor, Standerr);
+      end if;
+
+      --  Spawn the program
+
+      Return_Code := Spawn (Program_Name, Args);
+
+      --  Restore the standard output and error
+
+      Dup2 (Saved_Output, Standout);
+
+      if Err_To_Out then
+         Dup2 (Saved_Error, Standerr);
+      end if;
+
+      --  And close the saved standard output and error file descriptors.
+
+      Close (Saved_Output);
+
+      if Err_To_Out then
+         Close (Saved_Error);
+      end if;
+   end Spawn;
+
+   procedure Spawn
+     (Program_Name  : String;
+      Args          : Argument_List;
+      Output_File   : String;
+      Success       : out Boolean;
+      Return_Code   : out Integer;
+      Err_To_Out    : Boolean := True)
+   is
+      FD : File_Descriptor;
+
+   begin
+      Success := True;
+      Return_Code := 0;
+
+      FD := Create_Output_Text_File (Output_File);
+
+      if FD = Invalid_FD then
+         Success := False;
+         return;
+      end if;
+
+      Spawn (Program_Name, Args, FD, Return_Code, Err_To_Out);
+
+      Close (FD, Success);
+   end Spawn;
+
    --------------------
    -- Spawn_Internal --
    --------------------