Mercurial > hg > CbC > CbC_gcc
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;