[multiple changes]

2015-11-18  Pascal Obry  <obry@adacore.com>

	* adaint.c, s-os_lib.adb, s-os_lib.ads (Kill_Process_Tree): New.

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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

1 files changed, 96 insertions, 0 deletions

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 1c6d323..4f162e9 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -173,6 +173,7 @@ UINT CurrentCCSEncoding;
 #include <windows.h>
 #include <accctrl.h>
 #include <aclapi.h>
+#include <tlhelp32.h>
 #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/<PID>/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/<PID>/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