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

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.

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.

From-SVN: r273672

2 files changed, 53 insertions, 12 deletions

diff --git a/gcc/ada/libgnat/g-exptty.adb b/gcc/ada/libgnat/g-exptty.adb
index 1a977b5..728c5c6 100644
--- a/gcc/ada/libgnat/g-exptty.adb
+++ b/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;
diff --git a/gcc/ada/libgnat/g-exptty.ads b/gcc/ada/libgnat/g-exptty.ads
index 3a90d8d..57aa8d7 100644
--- a/gcc/ada/libgnat/g-exptty.ads
+++ b/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;