* 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:
Arnaud Charlet 2004-11-19 11:54:33 +01:00
parent f99652b5e3
commit f5a0cbf108
4 changed files with 147 additions and 11 deletions

View File

@ -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);

View File

@ -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);

View File

@ -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 --
--------------------

View File

@ -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