(__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
#if defined (__vxworks)
return 0;
-#elif defined (_AIX) || defined (__unix__)
+#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int ret;
struct stat statbuf;
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;
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
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);
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);
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 --
--------------------
-- 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
-- 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
OSDN Git Service
