diff gcc/ada/libgnat/g-exptty.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
line wrap: on
line diff
--- a/gcc/ada/libgnat/g-exptty.adb	Thu Oct 25 07:37:49 2018 +0900
+++ b/gcc/ada/libgnat/g-exptty.adb	Thu Feb 13 11:34:05 2020 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2000-2018, AdaCore                      --
+--                    Copyright (C) 2000-2019, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -38,6 +38,29 @@
    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,21 +72,14 @@
       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");
 
-      procedure Close_TTY (Process : System.Address);
-      pragma Import (C, Close_TTY, "__gnat_close_tty");
-
    begin
       --  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,12 +91,7 @@
          --  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_Input (Descriptor);
 
          if Descriptor.Error_Fd /= Descriptor.Output_Fd
            and then Descriptor.Error_Fd /= Invalid_FD
@@ -92,11 +103,25 @@
             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 have died since the check. In
+               --  practice the following calls should not cause any issue.
 
-         if not On_Windows then
-            Close_TTY (Descriptor.Process);
+               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;
 
          Free_Process (Descriptor.Process'Address);
@@ -113,6 +138,47 @@
       Close (Descriptor, Status);
    end Close;
 
+   -----------------
+   -- Close_Input --
+   -----------------
+
+   overriding procedure Close_Input
+     (Descriptor : in out TTY_Process_Descriptor)
+   is
+      function TTY_FD
+        (Handle : System.Address) return GNAT.OS_Lib.File_Descriptor;
+      pragma Import (C, TTY_FD, "__gnat_tty_fd");
+
+      procedure Close_TTY (Process : System.Address);
+      pragma Import (C, Close_TTY, "__gnat_close_tty");
+
+   begin
+      if not On_Windows and then Descriptor.Process /= System.Null_Address then
+         --  Check whether input/output/error streams use master descriptor and
+         --  reset corresponding members.
+
+         if Descriptor.Input_Fd = TTY_FD (Descriptor.Process) then
+            Descriptor.Input_Fd := Invalid_FD;
+         end if;
+
+         if Descriptor.Output_Fd = TTY_FD (Descriptor.Process) then
+            Descriptor.Output_Fd := Invalid_FD;
+         end if;
+
+         if Descriptor.Error_Fd = TTY_FD (Descriptor.Process) then
+            Descriptor.Error_Fd := Invalid_FD;
+         end if;
+
+         --  Close master descriptor.
+
+         Close_TTY (Descriptor.Process);
+      end if;
+
+      --  Call parent's implementation to close all remaining descriptors.
+
+      Process_Descriptor (Descriptor).Close_Input;
+   end Close_Input;
+
    -----------------------------
    -- Close_Pseudo_Descriptor --
    -----------------------------
@@ -258,6 +324,7 @@
       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;