diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/adaint.c | 39 | ||||
| -rw-r--r-- | gcc/ada/adaint.h | 2 | ||||
| -rw-r--r-- | gcc/ada/g-os_lib.adb | 74 | ||||
| -rw-r--r-- | gcc/ada/g-os_lib.ads | 43 |
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 |