s-os_lib.ads, [...] (Kill): New routine.
authorPascal Obry <obry@adacore.com>
Mon, 26 Oct 2015 11:59:42 +0000 (11:59 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 26 Oct 2015 11:59:42 +0000 (12:59 +0100)
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

gcc/ada/ChangeLog
gcc/ada/adaint.c
gcc/ada/expect.c
gcc/ada/make.adb
gcc/ada/s-os_lib.adb
gcc/ada/s-os_lib.ads

index 87bf6be7ba5e53fc8076b08eb6605d30f77c02c5..62367175f266afee01ede13a1455e0c12f62afd2 100644 (file)
@@ -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,
index 59032470365977843d5b29c15d97f084f0b9dc22..df6dbffaadfb6ab6e151a4cee9754b5643bbf86f 100644 (file)
@@ -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
index a6c1c8fee03ab48c6267ae9e0d82717c6a6e9d85..4da70180b77b4c48245d630d82ba6cf16ed6c2cd 100644 (file)
 #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)
 {
index 90eb0ed1c9c9cfb84a8b3bc00197143043973bdf..f4bd63c81b21ffbf05fa99abcc58a35809d35d89 100644 (file)
@@ -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);
index 46fdd0067847b03fb1d62e475d51868605b13484..61c0b41ea1686ceee6731ddd3ee6f58053dc33cf 100644 (file)
@@ -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 --
    -------------------------
index 142937ea41476de52104f395a0a833fb86bb075e..e9bb9bf65b9d394dca16dc16a1e88ceb57158783 100644 (file)
@@ -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