s-os_lib.ads, [...] (Kill): New routine.

2015-10-26  Pascal Obry  <obry@adacore.com>

	* s-os_lib.ads, s-os_lib.adb (Kill): New routine. This routine
	makes visible support for killing processes in expect.c.
	* expect.c (__gnat_kill): Removed from here.
	* adaint.c (__gnat_kill): Added here to be usable in the compiler
	(System.OS_Lib).
	* make.adb (Sigint_Intercepted): Use the Kill routine from
	System.OS_Lib.

From-SVN: r229348

6 files changed, 71 insertions, 50 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 87bf6be..6236717 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2015-10-26  Pascal Obry  <obry@adacore.com>
+
+	* s-os_lib.ads, s-os_lib.adb (Kill): New routine. This routine
+	makes visible support for killing processes in expect.c.
+	* expect.c (__gnat_kill): Removed from here.
+	* adaint.c (__gnat_kill): Added here to be usable in the compiler
+	(System.OS_Lib).
+	* make.adb (Sigint_Intercepted): Use the Kill routine from
+	System.OS_Lib.
+
 2015-10-26  Arnaud Charlet  <charlet@adacore.com>
 
 	* einfo.ads, einfo.adb, exp_unst.adb (Needs_Typedef,
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 5903247..df6dbff 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -168,6 +168,7 @@ UINT CurrentCCSEncoding;
 #if defined (_WIN32)
 
 #include <process.h>
+#include <signal.h>
 #include <dir.h>
 #include <windows.h>
 #include <accctrl.h>
@@ -3183,6 +3184,35 @@ __gnat_get_executable_load_address (void)
 #endif
 }
 
+void
+__gnat_kill (int pid, int sig, int close ATTRIBUTE_UNUSED)
+{
+#if defined(_WIN32)
+  HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid);
+  if (h == NULL)
+    return;
+  if (sig == 9)
+    {
+      TerminateProcess (h, 0);
+      __gnat_win32_remove_handle (NULL, pid);
+    }
+  else if (sig == SIGINT)
+    GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid);
+  else if (sig == SIGBREAK)
+    GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid);
+  /* ??? The last two alternatives don't really work. SIGBREAK requires setting
+     up process groups at start time which we don't do; treating SIGINT is just
+     not possible apparently. So we really only support signal 9. Fortunately
+     that's all we use in GNAT.Expect */
+
+  CloseHandle (h);
+#elif defined (__vxworks)
+  /* Not implemented */
+#else
+  kill (pid, sig);
+#endif
+}
+
 #ifdef __cplusplus
 }
 #endif
diff --git a/gcc/ada/expect.c b/gcc/ada/expect.c
index a6c1c8f..4da7018 100644
--- a/gcc/ada/expect.c
+++ b/gcc/ada/expect.c
@@ -83,29 +83,6 @@
 #include <io.h>
 #include "mingw32.h"
 
-void
-__gnat_kill (int pid, int sig, int close)
-{
-  HANDLE h = OpenProcess (PROCESS_ALL_ACCESS, FALSE, pid);
-  if (h == NULL)
-    return;
-  if (sig == 9)
-    {
-      TerminateProcess (h, 0);
-      __gnat_win32_remove_handle (NULL, pid);
-    }
-  else if (sig == SIGINT)
-    GenerateConsoleCtrlEvent (CTRL_C_EVENT, pid);
-  else if (sig == SIGBREAK)
-    GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid);
-  /* ??? The last two alternatives don't really work. SIGBREAK requires setting
-     up process groups at start time which we don't do; treating SIGINT is just
-     not possible apparently. So we really only support signal 9. Fortunately
-     that's all we use in GNAT.Expect */
-
-  CloseHandle (h);
-}
-
 int
 __gnat_waitpid (int pid)
 {
@@ -214,12 +191,6 @@ __gnat_expect_poll (int *fd,
 #include <vms/iodef.h>
 #include <signal.h>
 
-void
-__gnat_kill (int pid, int sig, int close)
-{
-  kill (pid, sig);
-}
-
 int
 __gnat_waitpid (int pid)
 {
@@ -371,12 +342,6 @@ typedef long fd_mask;
 #endif /* !_IBMR2 */
 #endif /* !NO_FD_SET */
 
-void
-__gnat_kill (int pid, int sig, int close)
-{
-  kill (pid, sig);
-}
-
 int
 __gnat_waitpid (int pid)
 {
@@ -497,13 +462,6 @@ __gnat_expect_poll (int *fd,
 
 #else
 
-void
-__gnat_kill (int pid ATTRIBUTE_UNUSED,
-	     int sig ATTRIBUTE_UNUSED,
-	     int close ATTRIBUTE_UNUSED)
-{
-}
-
 int
 __gnat_waitpid (int pid ATTRIBUTE_UNUSED, int sig ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 90eb0ed..f4bd63c 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -87,10 +87,6 @@ package body Make is
    --  Every program depends on this package, that must then be checked,
    --  especially when -f and -a are used.
 
-   procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
-   pragma Import (C, Kill, "__gnat_kill");
-   --  Called by Sigint_Intercepted to kill all spawned compilation processes
-
    type Sigint_Handler is access procedure;
    pragma Convention (C, Sigint_Handler);
 
@@ -7306,8 +7302,6 @@ package body Make is
    ------------------------
 
    procedure Sigint_Intercepted is
-      SIGINT  : constant := 2;
-
    begin
       Set_Standard_Error;
       Write_Line ("*** Interrupted ***");
@@ -7315,7 +7309,7 @@ package body Make is
       --  Send SIGINT to all outstanding compilation processes spawned
 
       for J in 1 .. Outstanding_Compiles loop
-         Kill (Running_Compile (J).Pid, SIGINT, 1);
+         Kill (Running_Compile (J).Pid, Hard_Kill => False);
       end loop;
 
       Finish_Program (Project_Tree, E_No_Compile);
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index 46fdd00..61c0b41 100644
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1995-2014, AdaCore                     --
+--                     Copyright (C) 1995-2015, 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- --
@@ -1497,6 +1497,25 @@ package body System.OS_Lib is
       return Is_Writable_File (F_Name'Address);
    end Is_Writable_File;
 
+   ----------
+   -- Kill --
+   ----------
+
+   procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True) is
+      SIGKILL : constant := 9;
+      SIGINT  : constant := 2;
+
+      procedure C_Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
+      pragma Import (C, C_Kill, "__gnat_kill");
+
+   begin
+      if Hard_Kill then
+         C_Kill (Pid, SIGKILL, 1);
+      else
+         C_Kill (Pid, SIGINT, 1);
+      end if;
+   end Kill;
+
    -------------------------
    -- Locate_Exec_On_Path --
    -------------------------
diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index 142937e..e9bb9bf 100644
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -876,6 +876,16 @@ package System.OS_Lib is
    --  This function will always set success to False under VxWorks, since
    --  there is no notion of executables under this OS.
 
+   procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True);
+   --  Kill process known as Pid by the OS. Does nothing if Pid is
+   --  Invalid_Pid or on platforms where it is not supported like
+   --  VxWorks.
+   --  Hard_Kill is True by default and in this case the process
+   --  is terminated immediately. If Hard_Kill is False a signal
+   --  SIGINT is sent to the process on POSIX OS or a CTRL-C event
+   --  on Windows, this let the process a chance to quit properly
+   --  using a corresponding handler.
+
    function Argument_String_To_List
      (Arg_String : String) return Argument_List_Access;
    --  Take a string that is a program and its arguments and parse it into an