From: Arnaud Charlet Date: Wed, 18 Nov 2015 09:38:46 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=287aa0ed9267e7afe6d9350a6b5b95f271db28ce;p=gcc.git [multiple changes] 2015-11-18 Pascal Obry * adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New. 2015-11-18 Hristian Kirtchev * sem_util.adb (Check_Nonvolatile_Function_Profile): Place the error message concerning the return type on the result definition. (Is_Volatile_Function): A function with a parameter of a protected type is a protected function if it is defined within a protected definition. 2015-11-18 Ed Schonberg * sem_ch4.adb (Try_Container_Indexing): When building the parameter list for the function call on indexing functions, preserve overloading of the parameters, which may themselves be generalized indexing operations. From-SVN: r230522 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ef84a56d7fc..f330589e46a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2015-11-18 Pascal Obry + + * adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New. + +2015-11-18 Hristian Kirtchev + + * sem_util.adb (Check_Nonvolatile_Function_Profile): Place the error + message concerning the return type on the result definition. + (Is_Volatile_Function): A function with a parameter of a protected + type is a protected function if it is defined within a protected + definition. + +2015-11-18 Ed Schonberg + + * sem_ch4.adb (Try_Container_Indexing): When building the + parameter list for the function call on indexing functions, + preserve overloading of the parameters, which may themselves be + generalized indexing operations. + 2015-11-13 Arnaud Charlet PR ada/68345 diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 1c6d323f0e7..4f162e9e267 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -173,6 +173,7 @@ UINT CurrentCCSEncoding; #include #include #include +#include #undef DIR_SEPARATOR #define DIR_SEPARATOR '\\' @@ -3219,6 +3220,101 @@ __gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED) #endif } +void __gnat_killprocesstree (int pid, int sig_num) +{ +#if defined(_WIN32) + HANDLE hWnd; + PROCESSENTRY32 pe; + + memset(&pe, 0, sizeof(PROCESSENTRY32)); + pe.dwSize = sizeof(PROCESSENTRY32); + + HANDLE hSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0); + + /* cannot take snapshot, just kill the parent process */ + + if (hSnap == INVALID_HANDLE_VALUE) + { + __gnat_kill (pid, sig_num, 1); + return; + } + + if (Process32First(hSnap, &pe)) + { + BOOL bContinue = TRUE; + + /* kill child processes first */ + + while (bContinue) + { + if (pe.th32ParentProcessID == (int)pid) + __gnat_killprocesstree (pe.th32ProcessID, sig_num); + + bContinue = Process32Next (hSnap, &pe); + } + } + + CloseHandle (hSnap); + + /* kill process */ + + __gnat_kill (pid, sig_num, 1); +#else + DIR *dir; + struct dirent *d; + + /* read all processes' pid and ppid */ + + dir = opendir ("/proc"); + + /* cannot open proc, just kill the parent process */ + + if (!dir) + { + __gnat_kill (pid, sig_num, 1); + return; + } + + /* kill child processes first */ + + while (d = readdir (dir)) + { + if ((d->d_type & DT_DIR) == DT_DIR) + { + char statfile[64] = { 0 }; + int _pid, _ppid; + + /* read /proc//stat */ + + strncpy (statfile, "/proc/", sizeof(statfile)); + strncat (statfile, d->d_name, sizeof(statfile)); + strncat (statfile, "/stat", sizeof(statfile)); + + FILE *fd = fopen (statfile, "r"); + + if (fd) + { + const int match = fscanf (fd, "%d %*s %*s %d", &_pid, &_ppid); + fclose (fd); + + if (match == 2 && _ppid == pid) + __gnat_killprocesstree (_pid, sig_num); + } + } + } + + closedir (dir); + + /* kill process */ + + __gnat_kill (pid, sig_num, 1); +#endif + /* Note on Solaris it is possible to read /proc//status. + The 5th and 6th words are the pid and the 7th and 8th the ppid. + See: /usr/include/sys/procfs.h (struct pstatus). + */ +} + #ifdef __cplusplus } #endif diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 295ef4bae64..069a4b3c48b 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1609,6 +1609,27 @@ package body System.OS_Lib is end if; end Kill; + ----------------------- + -- Kill_Process_Tree -- + ----------------------- + + procedure Kill_Process_Tree + (Pid : Process_Id; Hard_Kill : Boolean := True) + is + SIGKILL : constant := 9; + SIGINT : constant := 2; + + procedure C_Kill_PT (Pid : Process_Id; Sig_Num : Integer); + pragma Import (C, C_Kill_PT, "__gnat_killprocesstree"); + + begin + if Hard_Kill then + C_Kill_PT (Pid, SIGKILL); + else + C_Kill_PT (Pid, SIGINT); + end if; + end Kill_Process_Tree; + ------------------------- -- Locate_Exec_On_Path -- ------------------------- diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index b86d052ec55..044e38bd5c5 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -746,6 +746,19 @@ package System.OS_Lib is -- POSIX OS or a ctrl-C event on Windows, allowing the process a chance to -- terminate properly using a corresponding handler. + procedure Kill_Process_Tree (Pid : Process_Id; Hard_Kill : Boolean := True); + -- Kill the process designated by Pid and all it's children processes. + -- Does nothing if Pid is Invalid_Pid or on platforms where it is not + -- supported, such as VxWorks. Hard_Kill is True by default, and when True + -- the processes are terminated immediately. If Hard_Kill is False, then a + -- signal SIGINT is sent to the processes on POSIX OS or a ctrl-C event + -- on Windows, allowing the processes a chance to terminate properly + -- using a corresponding handler. + -- + -- Note that this routine is not atomic and is supported only on Linux + -- and Windows. On other OS it will only kill the process identified by + -- Pid. + function Non_Blocking_Spawn (Program_Name : String; Args : Argument_List) return Process_Id; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 68988d3c3b2..35bb7f2afbb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7425,12 +7425,20 @@ package body Sem_Ch4 is Check_Compiler_Unit ("generalized indexing", N); end if; + -- Create argument list for function call that represents generalized + -- indexing. Note that indices (i.e. actuals) may themselves be + -- overloaded. + declare - Arg : Node_Id; + Arg : Node_Id; + New_Arg : Node_Id; + begin Arg := First (Exprs); while Present (Arg) loop - Append (Relocate_Node (Arg), Assoc); + New_Arg := Relocate_Node (Arg); + Save_Interps (Arg, New_Arg); + Append (New_Arg, Assoc); Next (Arg); end loop; end; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 712d03d258d..435f03b90ec 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3120,9 +3120,9 @@ package body Sem_Util is -- Inspect the return type if Is_Effectively_Volatile (Etype (Func_Id)) then - Error_Msg_N + Error_Msg_NE ("nonvolatile function & cannot have a volatile return type", - Func_Id); + Result_Definition (Parent (Func_Id)), Func_Id); end if; end Check_Nonvolatile_Function_Profile; @@ -14010,6 +14010,7 @@ package body Sem_Util is if Is_Primitive (Func_Id) and then Present (First_Formal (Func_Id)) and then Is_Protected_Type (Etype (First_Formal (Func_Id))) + and then Etype (First_Formal (Func_Id)) = Scope (Func_Id) then return True;