Commit 3fee081a by Pascal Obry Committed by Arnaud Charlet

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
parent fbf90e54
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> 2015-10-26 Arnaud Charlet <charlet@adacore.com>
* einfo.ads, einfo.adb, exp_unst.adb (Needs_Typedef, * einfo.ads, einfo.adb, exp_unst.adb (Needs_Typedef,
......
...@@ -168,6 +168,7 @@ UINT CurrentCCSEncoding; ...@@ -168,6 +168,7 @@ UINT CurrentCCSEncoding;
#if defined (_WIN32) #if defined (_WIN32)
#include <process.h> #include <process.h>
#include <signal.h>
#include <dir.h> #include <dir.h>
#include <windows.h> #include <windows.h>
#include <accctrl.h> #include <accctrl.h>
...@@ -3183,6 +3184,35 @@ __gnat_get_executable_load_address (void) ...@@ -3183,6 +3184,35 @@ __gnat_get_executable_load_address (void)
#endif #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 #ifdef __cplusplus
} }
#endif #endif
...@@ -83,29 +83,6 @@ ...@@ -83,29 +83,6 @@
#include <io.h> #include <io.h>
#include "mingw32.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 int
__gnat_waitpid (int pid) __gnat_waitpid (int pid)
{ {
...@@ -214,12 +191,6 @@ __gnat_expect_poll (int *fd, ...@@ -214,12 +191,6 @@ __gnat_expect_poll (int *fd,
#include <vms/iodef.h> #include <vms/iodef.h>
#include <signal.h> #include <signal.h>
void
__gnat_kill (int pid, int sig, int close)
{
kill (pid, sig);
}
int int
__gnat_waitpid (int pid) __gnat_waitpid (int pid)
{ {
...@@ -371,12 +342,6 @@ typedef long fd_mask; ...@@ -371,12 +342,6 @@ typedef long fd_mask;
#endif /* !_IBMR2 */ #endif /* !_IBMR2 */
#endif /* !NO_FD_SET */ #endif /* !NO_FD_SET */
void
__gnat_kill (int pid, int sig, int close)
{
kill (pid, sig);
}
int int
__gnat_waitpid (int pid) __gnat_waitpid (int pid)
{ {
...@@ -497,13 +462,6 @@ __gnat_expect_poll (int *fd, ...@@ -497,13 +462,6 @@ __gnat_expect_poll (int *fd,
#else #else
void
__gnat_kill (int pid ATTRIBUTE_UNUSED,
int sig ATTRIBUTE_UNUSED,
int close ATTRIBUTE_UNUSED)
{
}
int int
__gnat_waitpid (int pid ATTRIBUTE_UNUSED, int sig ATTRIBUTE_UNUSED) __gnat_waitpid (int pid ATTRIBUTE_UNUSED, int sig ATTRIBUTE_UNUSED)
{ {
......
...@@ -87,10 +87,6 @@ package body Make is ...@@ -87,10 +87,6 @@ package body Make is
-- Every program depends on this package, that must then be checked, -- Every program depends on this package, that must then be checked,
-- especially when -f and -a are used. -- 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; type Sigint_Handler is access procedure;
pragma Convention (C, Sigint_Handler); pragma Convention (C, Sigint_Handler);
...@@ -7306,8 +7302,6 @@ package body Make is ...@@ -7306,8 +7302,6 @@ package body Make is
------------------------ ------------------------
procedure Sigint_Intercepted is procedure Sigint_Intercepted is
SIGINT : constant := 2;
begin begin
Set_Standard_Error; Set_Standard_Error;
Write_Line ("*** Interrupted ***"); Write_Line ("*** Interrupted ***");
...@@ -7315,7 +7309,7 @@ package body Make is ...@@ -7315,7 +7309,7 @@ package body Make is
-- Send SIGINT to all outstanding compilation processes spawned -- Send SIGINT to all outstanding compilation processes spawned
for J in 1 .. Outstanding_Compiles loop for J in 1 .. Outstanding_Compiles loop
Kill (Running_Compile (J).Pid, SIGINT, 1); Kill (Running_Compile (J).Pid, Hard_Kill => False);
end loop; end loop;
Finish_Program (Project_Tree, E_No_Compile); Finish_Program (Project_Tree, E_No_Compile);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1497,6 +1497,25 @@ package body System.OS_Lib is ...@@ -1497,6 +1497,25 @@ package body System.OS_Lib is
return Is_Writable_File (F_Name'Address); return Is_Writable_File (F_Name'Address);
end Is_Writable_File; 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 -- -- Locate_Exec_On_Path --
------------------------- -------------------------
......
...@@ -876,6 +876,16 @@ package System.OS_Lib is ...@@ -876,6 +876,16 @@ package System.OS_Lib is
-- This function will always set success to False under VxWorks, since -- This function will always set success to False under VxWorks, since
-- there is no notion of executables under this OS. -- 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 function Argument_String_To_List
(Arg_String : String) return Argument_List_Access; (Arg_String : String) return Argument_List_Access;
-- Take a string that is a program and its arguments and parse it into an -- Take a string that is a program and its arguments and parse it into an
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment