ada/spawn
0
0
Fork 0
mirror of https://github.com/AdaCore/spawn.git synced 2026-02-12 13:09:41 -08:00
Code Issues Packages Projects Releases Wiki Activity

U505-038 Implementation of Kill/Terminate for POSIX

Browse Source
This commit is contained in:
Maxim Reznik
2021-05-19 18:58:10 +03:00
committed by Vadim Godunko
parent 22b8d8160a
commit 28115620eb
11 changed files with 279 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@@ -13,6 +13,10 @@ GPRINSTALL_FLAGS = --prefix=$(PREFIX) --sources-subdir=$(INSTALL_INCLUDE_DIR)\
SPAWN_TESTS=.obj/spawn_test/spawn_test .obj/spawn_test/spawn_unexpected
ifneq ($(OS),Windows_NT)
SPAWN_TESTS += .obj/spawn_test/spawn_kill
endif
all:
gprbuild $(GPRBUILD_FLAGS) -P gnat/spawn.gpr
gprbuild $(GPRBUILD_FLAGS) -P gnat/spawn_tests.gpr

15
gnat/spawn_tests.gpr
View File

@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2018, AdaCore --
-- Copyright (C) 2018-2021, AdaCore --
-- --
-- This 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- --
@@ -23,9 +23,19 @@ with "spawn";
project Spawn_Tests is
Main := ("spawn_test.adb", "spawn_unexpected.adb");
case Spawn.OS_API is
when "unix" | "osx" =>
Main := Main & ("spawn_kill.adb");
when "Windows_NT" =>
null;
end case;
for Source_Dirs use ("../testsuite/spawn");
for Object_Dir use "../.obj/spawn_test";
for Main use ("spawn_test.adb", "spawn_unexpected.adb");
for Main use Main;
package Compiler renames Spawn.Compiler;
@@ -34,4 +44,3 @@ project Spawn_Tests is
end Binder;
end Spawn_Tests;

7
source/spawn/spawn-posix.ads
View File

@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2018-2019, AdaCore --
-- Copyright (C) 2018-2021, AdaCore --
-- --
-- This 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- --
@@ -62,6 +62,11 @@ package Spawn.Posix is
function fork return Interfaces.C.int
with Import, Convention => C, External_Name => "fork";
function kill
(pid : Interfaces.C.int;
sig : Interfaces.C.int) return Interfaces.C.int
with Import, Convention => C, External_Name => "kill";
function dup2
(oldfd : Interfaces.C.int;
newfd : Interfaces.C.int)

16
source/spawn/spawn-processes__glib.adb
View File

@@ -19,9 +19,11 @@
-- version 3.1, as published by the Free Software Foundation. --
------------------------------------------------------------------------------
with Ada.Interrupts.Names;
with Interfaces.C;
with Spawn.Environments.Internal;
with Spawn.Posix;
with Glib.Error;
with Glib.IOChannel;
@@ -360,8 +362,13 @@ package body Spawn.Processes is
------------------
procedure Kill_Process (Self : in out Process'Class) is
use type Interfaces.C.int;
Code : constant Interfaces.C.int := Spawn.Posix.kill
(Interfaces.C.int (Self.pid),
Interfaces.C.int (Ada.Interrupts.Names.SIGKILL));
begin
raise Program_Error;
pragma Assert (Code = 0);
end Kill_Process;
--------------
@@ -602,8 +609,13 @@ package body Spawn.Processes is
-----------------------
procedure Terminate_Process (Self : in out Process'Class) is
use type Interfaces.C.int;
Code : constant Interfaces.C.int := Spawn.Posix.kill
(Interfaces.C.int (Self.pid),
Interfaces.C.int (Ada.Interrupts.Names.SIGTERM));
begin
raise Program_Error;
pragma Assert (Code = 0);
end Terminate_Process;
-----------------------

15
source/spawn/spawn-processes__posix.adb
View File

@@ -22,6 +22,7 @@
with Spawn.Processes.Monitor;
with Spawn.Posix;
with GNAT.OS_Lib;
with Ada.Interrupts.Names;
with Interfaces.C;
@@ -121,8 +122,13 @@ package body Spawn.Processes is
------------------
procedure Kill_Process (Self : in out Process'Class) is
use type Interfaces.C.int;
Code : constant Interfaces.C.int :=
Spawn.Posix.kill
(Self.pid, Interfaces.C.int (Ada.Interrupts.Names.SIGKILL));
begin
raise Program_Error;
pragma Assert (Code = 0);
end Kill_Process;
--------------
@@ -294,8 +300,13 @@ package body Spawn.Processes is
-----------------------
procedure Terminate_Process (Self : in out Process'Class) is
use type Interfaces.C.int;
Code : constant Interfaces.C.int :=
Spawn.Posix.kill
(Self.pid, Interfaces.C.int (Ada.Interrupts.Names.SIGTERM));
begin
raise Program_Error;
pragma Assert (Code = 0);
end Terminate_Process;
-----------------------

22
testsuite/spawn/signals.adb Normal file
View File

@@ -0,0 +1,22 @@
with Ada.Text_IO;
package body Signals is
--------------------
-- Signal_Handler --
--------------------
protected body Signal_Handler is
--------------------
-- On_Term_Signal --
--------------------
procedure On_Term_Signal is
begin
Ada.Text_IO.Put_Line ("Got TERM");
end On_Term_Signal;
end Signal_Handler;
end Signals;

14
testsuite/spawn/signals.ads Normal file
View File

@@ -0,0 +1,14 @@
with Ada.Interrupts.Names;
package Signals is
pragma Unreserve_All_Interrupts;
protected Signal_Handler is
procedure On_Term_Signal;
pragma Attach_Handler (On_Term_Signal, Ada.Interrupts.Names.SIGTERM);
end Signal_Handler;
end Signals;

14
testsuite/spawn/spawn_glib_args_test.adb
View File

@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2020, AdaCore --
-- Copyright (C) 2020-2021, AdaCore --
-- --
-- This 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- --
@@ -44,8 +44,9 @@ procedure Spawn_Glib_Args_Test is
(Self : in out Listener);
overriding procedure Finished
(Self : in out Listener;
Exit_Code : Integer);
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code);
overriding procedure Error_Occurred
(Self : in out Listener;
@@ -75,8 +76,9 @@ procedure Spawn_Glib_Args_Test is
--------------
overriding procedure Finished
(Self : in out Listener;
Exit_Code : Integer) is
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code) is
begin
Ada.Text_IO.Put_Line ("Finished" & (Exit_Code'Img));
Self.App.Release;
@@ -107,8 +109,6 @@ procedure Spawn_Glib_Args_Test is
overriding procedure Standard_Output_Available
(Self : in out Listener)
is
use type Ada.Streams.Stream_Element_Offset;
Data : Ada.Streams.Stream_Element_Array (1 .. 256);
Last : Ada.Streams.Stream_Element_Count;

12
testsuite/spawn/spawn_glib_test.adb
View File

@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- Language Server Protocol --
-- --
-- Copyright (C) 2018, AdaCore --
-- Copyright (C) 2018-2021, AdaCore --
-- --
-- This 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- --
@@ -51,8 +51,9 @@ procedure Spawn_Glib_Test is
overriding procedure Started (Self : in out Listener);
overriding procedure Finished
(Self : in out Listener;
Exit_Code : Integer);
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code);
overriding procedure Error_Occurred
(Self : in out Listener;
@@ -121,8 +122,9 @@ procedure Spawn_Glib_Test is
end Started;
overriding procedure Finished
(Self : in out Listener;
Exit_Code : Integer) is
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code) is
begin
Ada.Text_IO.Put_Line ("Finished" & (Exit_Code'Img));
Self.Stopped := True;

179
testsuite/spawn/spawn_kill.adb Normal file
View File

@@ -0,0 +1,179 @@
with Ada.Command_Line;
with Ada.Directories;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Spawn.String_Vectors;
with Spawn.Processes;
with Spawn.Processes.Monitor_Loop;
with Signals;
pragma Unreferenced (Signals);
procedure Spawn_Kill is
pragma Assertion_Policy (Check);
package Listeners is
type Listener is limited new Spawn.Processes.Process_Listener with record
Proc : Spawn.Processes.Process;
Stdout : Ada.Strings.Unbounded.Unbounded_String;
Stderr : Ada.Strings.Unbounded.Unbounded_String;
Started : Boolean := False;
Stopped : Boolean := False;
Error : Integer := 0;
end record;
overriding procedure Standard_Output_Available
(Self : in out Listener);
overriding procedure Standard_Error_Available
(Self : in out Listener);
overriding procedure Started (Self : in out Listener);
overriding procedure Finished
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code);
overriding procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer);
end Listeners;
package body Listeners is
overriding procedure Standard_Output_Available
(Self : in out Listener)
is
use type Ada.Streams.Stream_Element_Count;
begin
loop
declare
Data : Ada.Streams.Stream_Element_Array (1 .. 5);
Last : Ada.Streams.Stream_Element_Count;
begin
Self.Proc.Read_Standard_Output (Data, Last);
exit when Last < Data'First;
for Char of Data (1 .. Last) loop
if Char not in 16#0D# | 16#0A# then
Ada.Strings.Unbounded.Append
(Self.Stdout, Character'Val (Char));
end if;
end loop;
end;
end loop;
end Standard_Output_Available;
overriding procedure Standard_Error_Available
(Self : in out Listener)
is
use type Ada.Streams.Stream_Element_Count;
begin
loop
declare
Data : Ada.Streams.Stream_Element_Array (1 .. 5);
Last : Ada.Streams.Stream_Element_Count;
begin
Self.Proc.Read_Standard_Error (Data, Last);
exit when Last < Data'First;
for Char of Data (1 .. Last) loop
if Char not in 16#0D# | 16#0A# then
Ada.Strings.Unbounded.Append
(Self.Stderr, Character'Val (Char));
end if;
end loop;
end;
end loop;
Self.Proc.Close_Standard_Input;
end Standard_Error_Available;
overriding procedure Started (Self : in out Listener) is
begin
Self.Started := True;
end Started;
overriding procedure Finished
(Self : in out Listener;
Exit_Status : Spawn.Processes.Process_Exit_Status;
Exit_Code : Spawn.Processes.Process_Exit_Code)
is
use type Spawn.Processes.Process_Exit_Code;
begin
if Exit_Code /= 9 then
Ada.Text_IO.Put_Line ("Unexpected exit code" & (Exit_Code'Img));
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
end if;
Self.Stopped := True;
end Finished;
overriding procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer)
is
pragma Unreferenced (Self);
begin
Ada.Text_IO.Put_Line ("Error_Occurred:" & (Process_Error'Img));
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
Self.Stopped := True;
Self.Error := Process_Error;
end Error_Occurred;
end Listeners;
Command : constant String := Ada.Directories.Full_Name
(Ada.Command_Line.Command_Name);
Args : Spawn.String_Vectors.UTF_8_String_Vector;
L : aliased Listeners.Listener;
begin
if Ada.Command_Line.Argument_Count > 0 then
Ada.Text_IO.Put_Line (Ada.Text_IO.Get_Line);
return;
end if;
-- Otherwise launch a driven process.
Args.Append ("Wait for signal");
L.Proc.Set_Program (Command);
L.Proc.Set_Arguments (Args);
L.Proc.Set_Working_Directory (Ada.Directories.Current_Directory);
L.Proc.Set_Listener (L'Unchecked_Access);
L.Proc.Start;
while not L.Started loop
Spawn.Processes.Monitor_Loop (1);
end loop;
L.Proc.Terminate_Process;
while Ada.Strings.Unbounded.Length (L.Stdout) = 0 loop
Spawn.Processes.Monitor_Loop (1);
end loop;
L.Proc.Kill_Process;
while not L.Stopped loop
Spawn.Processes.Monitor_Loop (1);
end loop;
declare
Stdout : constant String := Ada.Strings.Unbounded.To_String (L.Stdout);
Stderr : constant String := Ada.Strings.Unbounded.To_String (L.Stderr);
begin
pragma Assert (Stdout = "Got TERM");
pragma Assert (Stderr = "");
pragma Assert (L.Started);
pragma Assert (L.Error = 0);
end;
end Spawn_Kill;

2
testsuite/spawn/spawn_test.adb
View File

@@ -173,11 +173,11 @@ procedure Spawn_Test is
(Self : in out Listener;
Process_Error : Integer)
is
pragma Unreferenced (Self);
begin
Ada.Text_IO.Put_Line ("Error_Occurred:" & (Process_Error'Img));
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
Self.Error := Process_Error;
Self.Stopped := True;
end Error_Occurred;