* 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
This commit is contained in:
parent
f99652b5e3
commit
f5a0cbf108
@ -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);
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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 --
|
||||
--------------------
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user