On_Windows : constant Boolean := Directory_Separator = '\';
-- True when on Windows
+ function Waitpid (Process : System.Address; Blocking : Integer)
+ return Integer;
+ pragma Import (C, Waitpid, "__gnat_tty_waitpid");
+ -- Wait for a specific process id, and return its exit code
+
+ ------------------------
+ -- Is_Process_Running --
+ ------------------------
+
+ function Is_Process_Running
+ (Descriptor : in out TTY_Process_Descriptor)
+ return Boolean
+ is
+ begin
+ if Descriptor.Process = System.Null_Address then
+ return False;
+ end if;
+
+ Descriptor.Exit_Status := Waitpid (Descriptor.Process, Blocking => 0);
+ return Descriptor.Exit_Status = Still_Active;
+ end Is_Process_Running;
+
-----------
-- Close --
-----------
procedure Terminate_Process (Process : System.Address);
pragma Import (C, Terminate_Process, "__gnat_terminate_process");
- function Waitpid (Process : System.Address) return Integer;
- pragma Import (C, Waitpid, "__gnat_tty_waitpid");
- -- Wait for a specific process id, and return its exit code
-
procedure Free_Process (Process : System.Address);
pragma Import (C, Free_Process, "__gnat_free_process");
-- If we haven't already closed the process
if Descriptor.Process = System.Null_Address then
- Status := -1;
+ Status := Descriptor.Exit_Status;
else
-- Send a Ctrl-C to the process first. This way, if the launched
-- signal, so this needs to be done while the file descriptors are
-- still open (it used to be after the closes and that was wrong).
- Interrupt (Descriptor);
- delay (0.05);
-
if Descriptor.Input_Fd /= Invalid_FD then
Close (Descriptor.Input_Fd);
end if;
Close (Descriptor.Output_Fd);
end if;
- Terminate_Process (Descriptor.Process);
- Status := Waitpid (Descriptor.Process);
+ if Descriptor.Exit_Status = Still_Active then
+ Status := Waitpid (Descriptor.Process, Blocking => 0);
+
+ if Status = Still_Active then
+ -- In theory the process might hav died since the check. In
+ -- practice the following calls should not cause any issue.
+ Interrupt (Descriptor);
+ delay (0.05);
+ Terminate_Process (Descriptor.Process);
+ Status := Waitpid (Descriptor.Process, Blocking => 1);
+ Descriptor.Exit_Status := Status;
+ end if;
+ else
+ -- If Exit_Status is not STILL_ACTIVE just retrieve the saved
+ -- exit status
+ Status := Descriptor.Exit_Status;
+ end if;
if not On_Windows then
Close_TTY (Descriptor.Process);
pragma Import (C, Internal, "__gnat_setup_communication");
begin
+ Pid.Exit_Status := Still_Active;
if Internal (Pid.Process'Address) /= 0 then
raise Invalid_Process with "cannot setup communication.";
end if;
Columns : Natural);
-- Sets up the size of the terminal as reported to the spawned process
+ function Is_Process_Running
+ (Descriptor : in out TTY_Process_Descriptor)
+ return Boolean;
+ -- Return True is the process is still alive
+
private
-- All declarations in the private part must be fully commented ???
Cmd : String;
Args : System.Address);
+ Still_Active : constant Integer := -1;
+
type TTY_Process_Descriptor is new Process_Descriptor with record
- Process : System.Address; -- Underlying structure used in C
- Use_Pipes : Boolean := True;
+ Process : System.Address;
+ -- Underlying structure used in C
+ Exit_Status : Integer := Still_Active;
+ -- Hold the exit status of the process.
+ Use_Pipes : Boolean := True;
end record;
end GNAT.Expect.TTY;
}
int
-__gnat_tty_waitpid (void *desc ATTRIBUTE_UNUSED)
+__gnat_tty_waitpid (void *desc ATTRIBUTE_UNUSED, int blocking)
{
return 1;
}
#include <stdlib.h>
#include <windows.h>
+#include <winternl.h>
#define MAXPATHLEN 1024
the Win32 API instead of the C one. */
int
-__gnat_tty_waitpid (struct TTY_Process* p)
+__gnat_tty_waitpid (struct TTY_Process* p, int blocking)
{
DWORD exitcode;
- DWORD res;
- HANDLE proc_hand = p->procinfo.hProcess;
+ HANDLE hprocess = p->procinfo.hProcess;
- res = WaitForSingleObject (proc_hand, 0);
- GetExitCodeProcess (proc_hand, &exitcode);
+ if (blocking) {
+ /* Wait is needed on Windows only in blocking mode. */
+ WaitForSingleObject (hprocess, 0);
+ }
- CloseHandle (p->procinfo.hThread);
- CloseHandle (p->procinfo.hProcess);
+ GetExitCodeProcess (hprocess, &exitcode);
- /* No need to close the handles: they were closed on the ada side */
+ if (exitcode == STILL_ACTIVE) {
+ /* If process is still active return -1. */
+ exitcode = -1;
+ } else {
+ /* Process is dead, so handle to process and main thread can be closed. */
+ CloseHandle (p->procinfo.hThread);
+ CloseHandle (hprocess);
+ }
+ /* No need to close the handles: they were closed on the ada side */
return (int) exitcode;
}
* exit status of the child process
*/
int
-__gnat_tty_waitpid (pty_desc *desc)
+__gnat_tty_waitpid (pty_desc *desc, int blocking)
{
- int status = 0;
- waitpid (desc->child_pid, &status, 0);
- return WEXITSTATUS (status);
+ int status = -1;
+ int options = 0;
+
+ if (blocking) {
+ options = 0;
+ } else {
+ options = WNOHANG;
+ }
+ waitpid (desc->child_pid, &status, options);
+ if WIFEXITED (status) {
+ status = WEXITSTATUS (status);
+ }
+ return status;
}
/* __gnat_tty_supported - Are tty supported ?
projects / gcc.git / commitdiff