* 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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@90899 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 147 insertions, 11 deletions

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index c1b85a07616..8ed3b40fe18 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -1512,7 +1512,7 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
 #if defined (__vxworks)
   return 0;
 
-#elif defined (_AIX) || defined (__unix__)
+#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
   int ret;
   struct stat statbuf;
 
@@ -1557,11 +1557,11 @@ __gnat_portable_spawn (char *args[])
   strcat (args[0], args_0);
   strcat (args[0], "\"");
 
-  status = spawnvp (P_WAIT, args_0, (const char* const*)args);
+  status = spawnvp (P_WAIT, args_0, (char* const*)args);
 
   /* restore previous value */
   free (args[0]);
-  args[0] = args_0;
+  args[0] = (char *)args_0;
 
   if (status < 0)
     return -1;
@@ -1606,6 +1606,34 @@ __gnat_portable_spawn (char *args[])
   return 0;
 }
 
+/* Create a copy of the given file descriptor.
+   Return -1 if an error occurred.  */
+
+int
+__gnat_dup (int oldfd)
+{
+#if defined (__vxworks)
+   /* Not supported on VxWorks.  */
+   return -1;
+#else
+   return dup (oldfd);
+#endif
+}
+
+/* Make newfd be the copy of oldfd, closing newfd first if necessary.
+   Return -1 if an error occured.  */
+
+int
+__gnat_dup2 (int oldfd, int newfd)
+{
+#if defined (__vxworks)
+  /* Not supported on VxWorks.  */
+  return -1;
+#else
+  return dup2 (oldfd, newfd);
+#endif
+}
+
 /* WIN32 code to implement a wait call that wait for any child process.  */
 
 #ifdef _WIN32
@@ -1743,8 +1771,9 @@ win32_no_block_spawn (char *command, char *args[])
       k++;
     }
 
-  result = CreateProcess (NULL, (char *) full_command, &SA, NULL, TRUE,
-                          NORMAL_PRIORITY_CLASS, NULL, NULL, &SI, &PI);
+  result = CreateProcess
+	     (NULL, (char *) full_command, &SA, NULL, TRUE,
+              GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
 
   free (full_command);
 
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index c45a5332309..ebf99a59bd8 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -147,6 +147,8 @@ extern void   __gnat_set_binary_mode		   (int);
 extern void   __gnat_set_text_mode		   (int);
 extern char  *__gnat_ttyname			   (int);
 extern int    __gnat_lseek			   (int, long, int);
+extern int    __gnat_dup			   (int);
+extern int    __gnat_dup2			   (int, int);
 
 #ifdef __MINGW32__
 extern void   __gnat_plist_init                    (void);
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 --
    --------------------
diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads
index 2db605b34cb..fb32ac1dd7b 100644
--- a/gcc/ada/g-os_lib.ads
+++ b/gcc/ada/g-os_lib.ads
@@ -420,12 +420,12 @@ pragma Elaborate_Body (OS_Lib);
    --  returns an empty string.
    --
    --  For case-sensitive file systems, the value of Case_Sensitive parameter
-   --  is ignored. In systems that have a non case-sensitive file system like
-   --  Windows and OpenVMS, if this parameter is set OFF, then the result
-   --  is returned folded to lower case, this allows to checks if two files
-   --  are the same by applying this function to their names and by comparing
-   --  the results of these calls. If Case_Sensitive is ON, this function does
-   --  not change the casing of file and directory names.
+   --  is ignored.  For file systems that are not case-sensitive, such as
+   --  Windows and OpenVMS, if this parameter is set to False, then the file
+   --  and directory names are folded to lower case. This allows checking
+   --  whether two files are the same by applying this function to their names
+   --  and comparing the results.  If Case_Sensitive is set to True, this
+   --  function does not change the casing of file and directory names.
 
    function Is_Absolute_Path (Name : String) return Boolean;
    --  Returns True if Name is an absolute path name, i.e. it designates
@@ -652,7 +652,38 @@ pragma Elaborate_Body (OS_Lib);
    --  operating systems which have no notion of separately spawnable programs.
    --
    --  "Spawn" should not be used in tasking applications.
+
+   procedure Spawn
+     (Program_Name           : String;
+      Args                   : Argument_List;
+      Output_File_Descriptor : File_Descriptor;
+      Return_Code            : out Integer;
+      Err_To_Out             : Boolean := True);
+   --  Similar to the procedure above, but redirects the output to
+   --  the file designated by Output_File_Descriptor. If Err_To_Out
+   --  is True, then the Standard Error output is also redirected.
+   --
+   --  Return_Code is set to the status code returned by the operating
+   --  system as described above.
    --
+   --  "Spawn" should not be used in tasking applications.
+
+   procedure Spawn
+     (Program_Name  : String;
+      Args          : Argument_List;
+      Output_File   : String;
+      Success       : out Boolean;
+      Return_Code   : out Integer;
+      Err_To_Out    : Boolean := True);
+   --  Similar to the procedure above, but saves the output of the command
+   --  to a file with the name Output_File.
+   --
+   --  Success is set to True if the command is executed and its output
+   --  successfully written to the file. If Success is True, then
+   --  Return_Code will be set to the status code returned by the
+   --  operating system. Otherwise, Return_Code is undefined.
+   --
+   --  "Spawn" should not be used in tasking applications.
 
    type Process_Id is private;
    --  A private type used to identify a process activated by the following