[Ada] Ensure Ctrl-C is not emited on terminated processes

[Pierre-Marie de Rodat <derodat at adacore dot com>]

Due to the reuse policy of PID on Windows. Sending a Ctrl-C to a dead
process might result in a Ctrl-C sent to the wrong process. The check is
also implemented on Unix platforms and avoid unecessary waits.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-22  Nicolas Roche  <roche@adacore.com>

gcc/ada/

	* terminals.c (__gnat_tty_waitpid): Support both blocking and
	not blocking mode.
	* libgnat/g-exptty.ads (Is_Process_Running): New function.
	* libgnat/g-exptty.adb (Close): Don't try to interrupt/terminate
	a process if it is already dead.

--- gcc/ada/libgnat/g-exptty.adb
+++ gcc/ada/libgnat/g-exptty.adb
@@ -38,6 +38,28 @@ package body GNAT.Expect.TTY is
    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 --
    -----------
@@ -49,10 +71,6 @@ package body GNAT.Expect.TTY is
       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");
 
@@ -63,7 +81,7 @@ package body GNAT.Expect.TTY is
       --  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
@@ -75,9 +93,6 @@ package body GNAT.Expect.TTY is
          --  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;
@@ -92,8 +107,23 @@ package body GNAT.Expect.TTY is
             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);
@@ -258,6 +288,7 @@ package body GNAT.Expect.TTY is
       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;

--- gcc/ada/libgnat/g-exptty.ads
+++ gcc/ada/libgnat/g-exptty.ads
@@ -92,6 +92,11 @@ package GNAT.Expect.TTY is
       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 ???
@@ -129,9 +134,14 @@ private
       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;

--- gcc/ada/terminals.c
+++ gcc/ada/terminals.c
@@ -108,7 +108,7 @@ __gnat_tty_supported (void)
 }
 
 int
-__gnat_tty_waitpid (void *desc ATTRIBUTE_UNUSED)
+__gnat_tty_waitpid (void *desc ATTRIBUTE_UNUSED, int blocking)
 {
   return 1;
 }
@@ -152,6 +152,7 @@ __gnat_setup_winsize (void *desc ATTRIBUTE_UNUSED,
 #include <stdlib.h>
 
 #include <windows.h>
+#include <winternl.h>
 
 #define MAXPATHLEN 1024
 
@@ -1014,20 +1015,28 @@ __gnat_terminate_pid (int pid)
    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;
 }
 
@@ -1556,11 +1565,21 @@ __gnat_terminate_pid (int pid)
  *   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 ?