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

Restructure implementation types/packages hierarchy

Browse Source 
* Move `Process_Listener` to a dedicated package.

* Make `Spawn.Processes.Process` as a wrapper for
  `Spawn.Internal.Process` to hide internal details from a user.

* Make `Spawn.Internal.Process` API compatible/equal to
  `Spawn.Processes.Process`. Inherit all implementation from
  `Spawn.Common.Process` and move common trivial functionality
  there.

* Move other logic from Process.Platform packages to corresponding
  `Spawn.Internal` package.

* Move `Spawn.Process.Monitor` to `Spawn.Internal.Monitor`.
This commit is contained in:
Maxim Reznik
2022-12-09 19:07:22 +02:00
parent 7b0087c1c9
commit 30c4c83668
31 changed files with 1205 additions and 987 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
gnat/spawn.gpr
View File

@@ -39,8 +39,8 @@ library project Spawn is
for Excluded_Source_Files use Common_Excluded &
("pipe2.c",
"spawn-windows_api.ads",
"spawn-processes-windows.ads",
"spawn-processes-windows.adb");
"spawn-internal-windows.ads",
"spawn-internal-windows.adb");
when "Windows_NT" =>
for Excluded_Source_Files use Common_Excluded &
@@ -50,8 +50,8 @@ library project Spawn is
when "osx" =>
for Excluded_Source_Files use Common_Excluded &
("spawn-windows_api.ads",
"spawn-processes-windows.ads",
"spawn-processes-windows.adb");
"spawn-internal-windows.ads",
"spawn-internal-windows.adb");
end case;
Ada_Switches := ();
@@ -131,14 +131,12 @@ library project Spawn is
use "spawn-environments-internal__posix.ads";
for Body ("Spawn.Environments.Internal")
use "spawn-environments-internal__posix.adb";
for Body ("Spawn.Processes.Platform")
use "spawn-processes-platform__posix.adb";
for Body ("Spawn.Environments.Search_In_Path")
use "spawn-environments-search_in_path__posix.adb";
for Body ("Spawn.Processes.Monitor")
use "spawn-processes-monitor__posix.adb";
for Body ("Spawn.Processes.Monitor.Initialize")
use "spawn-processes-monitor-" & OS_API & "_initialize.adb";
for Body ("Spawn.Internal.Monitor")
use "spawn-internal-monitor__posix.adb";
for Body ("Spawn.Internal.Monitor.Initialize")
use "spawn-internal-monitor-" & OS_API & "_initialize.adb";
when "Windows_NT" =>
for Spec ("Spawn.Internal")
use "spawn-internal__windows.ads";
@@ -150,12 +148,10 @@ library project Spawn is
use "spawn-environments-internal__windows.ads";
for Body ("Spawn.Environments.Internal")
use "spawn-environments-internal__windows.adb";
for Body ("Spawn.Processes.Platform")
use "spawn-processes-platform__windows.adb";
for Body ("Spawn.Environments.Search_In_Path")
use "spawn-environments-search_in_path__windows.adb";
for Body ("Spawn.Processes.Monitor")
use "spawn-processes-monitor__windows.adb";
for Body ("Spawn.Internal.Monitor")
use "spawn-internal-monitor__windows.adb";
end case;
end Naming;

16
gnat/spawn_glib.gpr
View File

@@ -40,7 +40,7 @@ library project Spawn_Glib is
end case;
Common_Excluded :=
("spawn-processes-monitor.ads",
("spawn-internal-monitor.ads",
"spawn-processes-monitor_loop.ads",
"spawn-processes-monitor_loop.adb");
@@ -48,8 +48,8 @@ library project Spawn_Glib is
when "unix" | "osx" =>
for Excluded_Source_Files use Common_Excluded &
("spawn-windows_api.ads",
"spawn-processes-windows.ads",
"spawn-processes-windows.adb");
"spawn-internal-windows.ads",
"spawn-internal-windows.adb");
when "Windows_NT" =>
for Excluded_Source_Files use Common_Excluded &
@@ -118,9 +118,9 @@ library project Spawn_Glib is
case OS_API is
when "unix" | "osx" =>
for Spec ("Spawn.Internal")
use "spawn-internal__glib.ads";
use "spawn-internal__glib_posix.ads";
for Body ("Spawn.Internal")
use "spawn-internal__posix.adb";
use "spawn-internal__glib_posix.adb";
for Body ("Spawn.Environments.Initialize_Default")
use "spawn-environments-initialize_default__glib.adb";
for Spec ("Spawn.Environments.Internal")
@@ -129,13 +129,11 @@ library project Spawn_Glib is
use "spawn-environments-internal__glib.adb";
for Body ("Spawn.Environments.Search_In_Path")
use "spawn-environments-search_in_path__posix.adb";
for Body ("Spawn.Processes.Platform")
use "spawn-processes-platform__glib.adb";
when "Windows_NT" =>
for Spec ("Spawn.Internal")
use "spawn-internal__glib_windows.ads";
for Body ("Spawn.Internal")
use "spawn-internal__windows.adb";
use "spawn-internal__glib_windows.adb";
for Body ("Spawn.Environments.Initialize_Default")
use "spawn-environments-initialize_default__windows.adb";
for Spec ("Spawn.Environments.Internal")
@@ -144,8 +142,6 @@ library project Spawn_Glib is
use "spawn-environments-internal__windows.adb";
for Body ("Spawn.Environments.Search_In_Path")
use "spawn-environments-search_in_path__windows.adb";
for Body ("Spawn.Processes.Platform")
use "spawn-processes-platform__glib_windows.adb";
end case;
end Naming;

2
packages/glib/alire.toml
View File

@@ -14,7 +14,7 @@ tags = ["process", "launch", "pipe", "glib"]
disabled = true
[[depends-on]]
gtkada = "^19" # GtkAda 2019 and latter
gtkada = "^23" # GtkAda 23 and latter
[gpr-externals]
OS = ["unix", "osx", "Windows_NT"]

152
source/spawn/spawn-channels.adb
View File

@@ -77,6 +77,15 @@ package body Spawn.Channels is
with Convention => C;
-- Common code to start (continue) watching of the IO channel.
procedure Emit_Error_Occurred
(Self : Channels;
Process_Error : Integer);
procedure Emit_Stderr_Available (Self : Channels);
procedure Emit_Stdin_Available (Self : Channels);
procedure Emit_Stdout_Available (Self : Channels);
procedure On_Close_Channels (Self : Channels);
------------------
-- Child_Stderr --
------------------
@@ -139,6 +148,56 @@ package body Spawn.Channels is
end if;
end Close_Child_Descriptors;
-------------------------
-- Emit_Error_Occurred --
-------------------------
procedure Emit_Error_Occurred
(Self : Channels;
Process_Error : Integer) is
begin
Self.Process.Listener.Error_Occurred (Process_Error);
exception
when others =>
null;
end Emit_Error_Occurred;
---------------------------
-- Emit_Stderr_Available --
---------------------------
procedure Emit_Stderr_Available (Self : Channels) is
begin
Self.Process.Listener.Standard_Error_Available;
exception
when others =>
null;
end Emit_Stderr_Available;
--------------------------
-- Emit_Stdin_Available --
--------------------------
procedure Emit_Stdin_Available (Self : Channels) is
begin
Self.Process.Listener.Standard_Input_Available;
exception
when others =>
null;
end Emit_Stdin_Available;
---------------------------
-- Emit_Stdout_Available --
---------------------------
procedure Emit_Stdout_Available (Self : Channels) is
begin
Self.Process.Listener.Standard_Output_Available;
exception
when others =>
null;
end Emit_Stdout_Available;
---------------
-- Is_Active --
---------------
@@ -149,6 +208,23 @@ package body Spawn.Channels is
or Self.Stderr_Event /= Glib.Main.No_Source_Id;
end Is_Active;
-----------------------
-- On_Close_Channels --
-----------------------
procedure On_Close_Channels (Self : Channels) is
begin
if Self.Process.Pending_Finish then
Self.Process.Pending_Finish := False;
Self.Process.Listener.Finished
(Self.Process.Exit_Status, Self.Process.Exit_Code);
end if;
exception
when others =>
null;
end On_Close_Channels;
---------------------
-- On_Stderr_Event --
---------------------
@@ -166,7 +242,7 @@ package body Spawn.Channels is
if (condition and Glib.IOChannel.G_Io_In) /= 0 then
Self.Stderr_Lock := @ - 1;
Self.Process.Emit_Stderr_Available;
Emit_Stderr_Available (Self);
if Self.Stderr_Lock = 0 then
Self.Stderr_Event := Glib.Main.No_Source_Id;
@@ -178,7 +254,7 @@ package body Spawn.Channels is
Self.Stderr_Event := Glib.Main.No_Source_Id;
if Self.Stdout_Event = Glib.Main.No_Source_Id then
Self.Process.On_Close_Channels;
On_Close_Channels (Self);
end if;
end if;
@@ -202,7 +278,7 @@ package body Spawn.Channels is
begin
Self.Stdin_Lock := @ - 1;
Self.Process.Emit_Stdin_Available;
Emit_Stdin_Available (Self);
if Self.Stdin_Lock = 0 then
Self.Stdin_Event := Glib.Main.No_Source_Id;
@@ -228,7 +304,7 @@ package body Spawn.Channels is
if (condition and Glib.IOChannel.G_Io_In) /= 0 then
Self.Stdout_Lock := @ - 1;
Self.Process.Emit_Stdout_Available;
Emit_Stdout_Available (Self);
if Self.Stdout_Lock = 0 then
Self.Stdout_Event := Glib.Main.No_Source_Id;
@@ -240,7 +316,7 @@ package body Spawn.Channels is
Self.Stdout_Event := Glib.Main.No_Source_Id;
if Self.Stderr_Event = Glib.Main.No_Source_Id then
Self.Process.On_Close_Channels;
On_Close_Channels (Self);
end if;
end if;
@@ -306,8 +382,8 @@ package body Spawn.Channels is
Start_Stderr_Watch (Self);
when Glib.IOChannel.G_Io_Status_Error =>
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
end case;
end Read_Stderr;
@@ -360,8 +436,8 @@ package body Spawn.Channels is
Start_Stdout_Watch (Self);
when Glib.IOChannel.G_Io_Status_Error =>
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
end case;
end Read_Stdout;
@@ -433,8 +509,8 @@ package body Spawn.Channels is
-- Create pipe
if Spawn.Posix.pipe2 (Fds, Posix.O_CLOEXEC) /= 0 then
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -457,8 +533,8 @@ package body Spawn.Channels is
Glib.IOChannel.G_Io_Flag_Nonblock,
Error'Access) /= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -470,8 +546,8 @@ package body Spawn.Channels is
if Glib.IOChannel.Set_Encoding (Read, "", Error'Access)
/= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -526,8 +602,8 @@ package body Spawn.Channels is
-- Create pipe
if Spawn.Posix.pipe2 (Fds, Posix.O_CLOEXEC) /= 0 then
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -550,8 +626,8 @@ package body Spawn.Channels is
Glib.IOChannel.G_Io_Flag_Nonblock,
Error'Access) /= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -563,8 +639,8 @@ package body Spawn.Channels is
if Glib.IOChannel.Set_Encoding (Write, "", Error'Access)
/= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -630,8 +706,8 @@ package body Spawn.Channels is
(Spawn.Posix.O_RDWR + Spawn.Posix.O_NOCTTY);
if PTY_Master = -1 then
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
@@ -645,8 +721,8 @@ package body Spawn.Channels is
= -1
then
Cleanup;
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -656,8 +732,8 @@ package body Spawn.Channels is
if Spawn.Posix.grantpt (PTY_Master) /= 0 then
Cleanup;
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -667,8 +743,8 @@ package body Spawn.Channels is
if Spawn.Posix.unlockpt (PTY_Master) /= 0 then
Cleanup;
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -682,7 +758,7 @@ package body Spawn.Channels is
if Status /= 0 then
Cleanup;
Self.Process.Emit_Error_Occurred (Integer (Status));
Emit_Error_Occurred (Self, Integer (Status));
Success := False;
return;
@@ -697,8 +773,8 @@ package body Spawn.Channels is
if Self.PTY_Slave = -1 then
Cleanup;
Self.Process.Emit_Error_Occurred
(Integer (System.OS_Interface.errno));
Emit_Error_Occurred (Self,
Integer (System.OS_Interface.errno));
Success := False;
return;
@@ -719,8 +795,8 @@ package body Spawn.Channels is
Glib.IOChannel.G_Io_Flag_Nonblock,
Error'Access) /= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -732,8 +808,8 @@ package body Spawn.Channels is
if Glib.IOChannel.Set_Encoding (PTY_Channel, "", Error'Access)
/= Glib.IOChannel.G_Io_Status_Normal
then
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
Cleanup;
Success := False;
@@ -977,8 +1053,8 @@ package body Spawn.Channels is
Start_Stdin_Watch (Self);
when Glib.IOChannel.G_Io_Status_Error =>
Self.Process.Emit_Error_Occurred
(Integer (Glib.Error.Get_Code (Error)));
Emit_Error_Occurred (Self,
Integer (Glib.Error.Get_Code (Error)));
when others =>
raise Program_Error;

90
source/spawn/spawn-common.adb Normal file
View File

@@ -0,0 +1,90 @@
--
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
package body Spawn.Common is
-------------------
-- Set_Arguments --
-------------------
procedure Set_Arguments
(Self : in out Process'Class;
Arguments : Spawn.String_Vectors.UTF_8_String_Vector) is
begin
Self.Arguments := Arguments;
end Set_Arguments;
---------------------
-- Set_Environment --
---------------------
procedure Set_Environment
(Self : in out Process'Class;
Environment : Spawn.Environments.Process_Environment) is
begin
Self.Environment := Environment;
end Set_Environment;
------------------
-- Set_Listener --
------------------
procedure Set_Listener
(Self : in out Process'Class;
Listener : Spawn.Process_Listeners.Process_Listener_Access) is
begin
Self.Listener := Listener;
end Set_Listener;
-----------------
-- Set_Program --
-----------------
procedure Set_Program
(Self : in out Process'Class;
Program : UTF_8_String) is
begin
Self.Command := Ada.Strings.Unbounded.To_Unbounded_String (Program);
end Set_Program;
----------------------------
-- Set_Standard_Error_PTY --
----------------------------
procedure Set_Standard_Error_PTY (Self : in out Process'Class) is
begin
Self.Use_PTY (Stderr) := True;
end Set_Standard_Error_PTY;
----------------------------
-- Set_Standard_Input_PTY --
----------------------------
procedure Set_Standard_Input_PTY (Self : in out Process'Class) is
begin
Self.Use_PTY (Stdin) := True;
end Set_Standard_Input_PTY;
-----------------------------
-- Set_Standard_Output_PTY --
-----------------------------
procedure Set_Standard_Output_PTY (Self : in out Process'Class) is
begin
Self.Use_PTY (Stdout) := True;
end Set_Standard_Output_PTY;
---------------------------
-- Set_Working_Directory --
---------------------------
procedure Set_Working_Directory
(Self : in out Process'Class; Directory : UTF_8_String) is
begin
Self.Directory := Ada.Strings.Unbounded.To_Unbounded_String (Directory);
end Set_Working_Directory;
end Spawn.Common;

91
source/spawn/spawn-common.ads Normal file
View File

@@ -0,0 +1,91 @@
--
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
-- Base type for process implementation on all platforms.
with Ada.Finalization;
with Ada.Strings.Unbounded;
with Spawn.Environments;
with Spawn.Process_Listeners;
with Spawn.String_Vectors;
private
package Spawn.Common is
type Pipe_Kinds is (Stdin, Stdout, Stderr, Launch);
subtype Standard_Pipe is Pipe_Kinds range Stdin .. Stderr;
type Pipe_Flags is array (Standard_Pipe) of Boolean;
type Process is new Ada.Finalization.Limited_Controlled with record
Arguments : Spawn.String_Vectors.UTF_8_String_Vector;
Environment : Spawn.Environments.Process_Environment :=
Spawn.Environments.System_Environment;
Exit_Status : Process_Exit_Status := Normal;
Exit_Code : Process_Exit_Code := Process_Exit_Code'Last;
Status : Process_Status := Not_Running;
Listener : Spawn.Process_Listeners.Process_Listener_Access;
-- The associated listener. Note: this may be null.
Command : Ada.Strings.Unbounded.Unbounded_String;
Directory : Ada.Strings.Unbounded.Unbounded_String;
Use_PTY : Pipe_Flags := (others => False);
end record;
function Arguments (Self : Process'Class)
return Spawn.String_Vectors.UTF_8_String_Vector is
(Self.Arguments);
procedure Set_Arguments
(Self : in out Process'Class;
Arguments : Spawn.String_Vectors.UTF_8_String_Vector);
function Environment (Self : Process'Class)
return Spawn.Environments.Process_Environment is
(Self.Environment);
procedure Set_Environment
(Self : in out Process'Class;
Environment : Spawn.Environments.Process_Environment);
function Working_Directory (Self : Process'Class) return UTF_8_String is
(Ada.Strings.Unbounded.To_String (Self.Directory));
procedure Set_Working_Directory
(Self : in out Process'Class;
Directory : UTF_8_String);
function Program (Self : Process'Class) return UTF_8_String is
(Ada.Strings.Unbounded.To_String (Self.Command));
procedure Set_Program
(Self : in out Process'Class;
Program : UTF_8_String);
procedure Set_Standard_Input_PTY (Self : in out Process'Class);
procedure Set_Standard_Output_PTY (Self : in out Process'Class);
procedure Set_Standard_Error_PTY (Self : in out Process'Class);
function Status (Self : Process'Class) return Process_Status is
(Self.Status);
function Exit_Status (Self : Process'Class) return Process_Exit_Status is
(Self.Exit_Status);
-- Return the exit status of last process that finishes.
function Exit_Code (Self : Process'Class) return Process_Exit_Code is
(Self.Exit_Code);
function Listener (Self : Process'Class)
return Spawn.Process_Listeners.Process_Listener_Access is
(Self.Listener);
procedure Set_Listener
(Self : in out Process'Class;
Listener : Spawn.Process_Listeners.Process_Listener_Access);
end Spawn.Common;

10
source/spawn/spawn-environments.adb
View File

@@ -1,9 +1,11 @@
--
-- Copyright (C) 2018-2019, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
private with Spawn.Internal;
package body Spawn.Environments is
procedure Initialize_Default (Default : out Process_Environment);
@@ -15,6 +17,12 @@ package body Spawn.Environments is
Default : Process_Environment;
function Less (Left, Right : UTF_8_String) return Boolean
renames Spawn.Internal.Environments."<";
function Equal (Left, Right : UTF_8_String) return Boolean
renames Spawn.Internal.Environments."=";
-----------
-- Clear --
-----------

10
source/spawn/spawn-environments.ads
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2019, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -10,7 +10,6 @@
with Spawn.String_Vectors;
private with Ada.Containers.Indefinite_Ordered_Maps;
private with Spawn.Internal;
package Spawn.Environments is
@@ -62,11 +61,14 @@ package Spawn.Environments is
private
function Less (Left, Right : UTF_8_String) return Boolean;
function Equal (Left, Right : UTF_8_String) return Boolean;
package UTF_8_String_Maps is new Ada.Containers.Indefinite_Ordered_Maps
(Key_Type => UTF_8_String,
Element_Type => UTF_8_String,
"<" => Spawn.Internal.Environments."<",
"=" => Spawn.Internal.Environments."=");
"<" => Less,
"=" => Equal); -- Spawn.Internal.Environments."=");
type Process_Environment is tagged record
Map : UTF_8_String_Maps.Map;

4
source/spawn/spawn-processes-monitor-osx_initialize.adb → source/spawn/spawn-internal-monitor-osx_initialize.adb
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2020, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -16,7 +16,7 @@ pragma Warnings (Off);
with System.OS_Interface;
pragma Warnings (Off);
separate (Spawn.Processes.Monitor)
separate (Spawn.Internal.Monitor)
procedure Initialize is
Ignore : Interfaces.C.int;
Value : aliased System.OS_Interface.struct_sigaction :=

4
source/spawn/spawn-processes-monitor-unix_initialize.adb → source/spawn/spawn-internal-monitor-unix_initialize.adb
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2020, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -7,7 +7,7 @@
--
-- This is an empty implementation used in Linux.
--
separate (Spawn.Processes.Monitor)
separate (Spawn.Internal.Monitor)
procedure Initialize is
begin
null;

12
source/spawn/spawn-processes-monitor.ads → source/spawn/spawn-internal-monitor.ads
View File

@@ -1,21 +1,23 @@
--
-- Copyright (C) 2018-2019, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
private package Spawn.Processes.Monitor is
with Spawn.Common;
private package Spawn.Internal.Monitor is
type Command_Kind is
(Start, Close_Pipe, Watch_Pipe);
type Command (Kind : Command_Kind := Start) is record
Process : access Spawn.Processes.Process'Class;
Process : access Spawn.Internal.Process'Class;
case Kind is
when Start =>
null;
when Close_Pipe | Watch_Pipe =>
Pipe : Standard_Pipe;
Pipe : Spawn.Common.Standard_Pipe;
end case;
end record;
@@ -24,4 +26,4 @@ private package Spawn.Processes.Monitor is
procedure Loop_Cycle (Timeout : Integer);
-- Timeout in milliseconds. Dont wait if zero. Wait forever if < 0
end Spawn.Processes.Monitor;
end Spawn.Internal.Monitor;

30
source/spawn/spawn-processes-monitor__posix.adb → source/spawn/spawn-internal-monitor__posix.adb
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2021, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -9,16 +9,21 @@ with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Containers.Unbounded_Synchronized_Queues;
with Ada.Containers.Vectors;
with Ada.Interrupts.Names;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Interfaces.C.Strings;
with GNAT.OS_Lib;
with Spawn.Posix;
with Spawn.Environments.Internal;
with Interfaces.C.Strings;
with Spawn.Posix;
with Spawn.Process_Listeners;
package body Spawn.Processes.Monitor is
package body Spawn.Internal.Monitor is
use type Interfaces.C.int;
use type Spawn.Process_Listeners.Process_Listener_Access;
use all type Pipe_Kinds;
type Process_Access is access all Process'Class;
@@ -26,7 +31,7 @@ package body Spawn.Processes.Monitor is
procedure Do_Close_Pipe
(Self : Process_Access;
Kind : Standard_Pipe);
Kind : Common.Standard_Pipe);
procedure My_IO_Callback
(Process : Process_Access;
@@ -97,7 +102,7 @@ package body Spawn.Processes.Monitor is
procedure Watch_Pipe
(Self : Process_Access;
Kind : Standard_Pipe);
Kind : Common.Standard_Pipe);
procedure Wait
(Timeout : Interfaces.C.int;
@@ -321,9 +326,9 @@ package body Spawn.Processes.Monitor is
procedure Watch_Pipe
(Self : Process_Access;
Kind : Standard_Pipe)
Kind : Common.Standard_Pipe)
is
Event_Map : constant array (Standard_Pipe) of
Event_Map : constant array (Common.Standard_Pipe) of
Interfaces.C.unsigned_short :=
(Stdin => Posix.POLLOUT,
others => Posix.POLLIN);
@@ -424,7 +429,7 @@ package body Spawn.Processes.Monitor is
procedure Do_Close_Pipe
(Self : Process_Access;
Kind : Standard_Pipe)
Kind : Common.Standard_Pipe)
is
Ignore : Interfaces.C.int := Posix.close (Self.pipe (Kind));
begin
@@ -588,8 +593,7 @@ package body Spawn.Processes.Monitor is
procedure Prepare_Arguments (argv : out Posix.chars_ptr_array) is
begin
argv (0) := Interfaces.C.Strings.New_String
(To_String (Self.Program));
argv (0) := Interfaces.C.Strings.New_String (Self.Program);
for J in 1 .. Self.Arguments.Last_Index loop
argv (J) := Interfaces.C.Strings.New_String
@@ -697,7 +701,7 @@ package body Spawn.Processes.Monitor is
end if;
-- Make stdio non-blocking
if (for some X in Standard_Pipe =>
if (for some X in Common.Standard_Pipe =>
Posix.fcntl
(std (X) (Parent_Ends (X)),
Posix.F_SETFL,
@@ -728,4 +732,4 @@ package body Spawn.Processes.Monitor is
begin
Initialize;
end Spawn.Processes.Monitor;
end Spawn.Internal.Monitor;

19
source/spawn/spawn-processes-monitor__windows.adb → source/spawn/spawn-internal-monitor__windows.adb
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2020, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -13,17 +13,18 @@ pragma Warnings (Off);
with System.Win32;
pragma Warnings (On);
with Spawn.Processes.Windows;
with Spawn.Windows_API;
with Spawn.Internal.Windows;
package body Spawn.Processes.Monitor is
package body Spawn.Internal.Monitor is
use all type Spawn.Common.Pipe_Kinds;
subtype Context is Internal.Context;
subtype Stream_Element_Buffer is Internal.Stream_Element_Buffer;
type Process_Access is access all Processes.Process'Class;
type Process_Access is access all Process'Class;
procedure Start_Process (Self : access Processes.Process'Class);
procedure Start_Process (Self : access Process'Class);
package Command_Queue_Interfaces is
new Ada.Containers.Synchronized_Queue_Interfaces (Command);
@@ -54,7 +55,7 @@ package body Spawn.Processes.Monitor is
procedure Do_Watch_Pipe
(Process : not null Process_Access;
Kind : Standard_Pipe);
Kind : Spawn.Common.Standard_Pipe);
Callback : constant array (Stdout .. Stderr) of Read_Write_Ex.Callback :=
(Standard_Output_Callback'Access,
@@ -197,7 +198,7 @@ package body Spawn.Processes.Monitor is
procedure Do_Watch_Pipe
(Process : not null Process_Access;
Kind : Standard_Pipe)
Kind : Spawn.Common.Standard_Pipe)
is
use type Ada.Streams.Stream_Element_Count;
use type Windows_API.BOOL;
@@ -315,7 +316,7 @@ package body Spawn.Processes.Monitor is
-- Start_Process --
-------------------
procedure Start_Process (Self : access Processes.Process'Class) is
procedure Start_Process (Self : access Process'Class) is
procedure On_Start;
procedure On_Start is
@@ -326,4 +327,4 @@ package body Spawn.Processes.Monitor is
Windows.Do_Start_Process (Self.all, On_Start'Access);
end Start_Process;
end Spawn.Processes.Monitor;
end Spawn.Internal.Monitor;

36
source/spawn/spawn-processes-windows.adb → source/spawn/spawn-internal-windows.adb
View File

@@ -1,5 +1,5 @@
--
-- Copyright (C) 2018-2021, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
@@ -8,6 +8,7 @@ with Ada.Characters.Wide_Latin_1;
with Ada.Strings.UTF_Encoding.Wide_Strings;
with Ada.Strings.Wide_Fixed;
with Ada.Strings.Wide_Unbounded;
with Ada.Strings.Unbounded;
with Interfaces.C.Strings;
pragma Warnings (Off);
@@ -17,7 +18,8 @@ pragma Warnings (On);
with Spawn.Environments.Internal;
package body Spawn.Processes.Windows is
package body Spawn.Internal.Windows is
use all type Spawn.Common.Pipe_Kinds;
Terminate_Code : constant Windows_API.UINT := 16#F291#;
-- Arbitrary code to use as exit code for TerminateProcess call.
@@ -39,7 +41,7 @@ package body Spawn.Processes.Windows is
procedure Append_Escaped_String
(Command_Line : in out Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
Argument : Ada.Strings.Unbounded.Unbounded_String);
Argument : UTF_8_String);
-- Append the given argument to a command line such that CommandLineToArgvW
-- return the argument string unchanged. Arguments in a command line should
-- be separated by spaces; this subprogram doesn't add these spaces.
@@ -64,7 +66,7 @@ package body Spawn.Processes.Windows is
procedure Append_Escaped_String
(Command_Line : in out Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
Argument : Ada.Strings.Unbounded.Unbounded_String)
Argument : UTF_8_String)
is
-- Implementation of the subprogram based on Microsoft's blog post
-- "Everyone quotes command line arguments the wrong way".
@@ -78,9 +80,8 @@ package body Spawn.Processes.Windows is
& Ada.Characters.Wide_Latin_1.HT
& Ada.Characters.Wide_Latin_1.VT;
S : constant Wide_String :=
Ada.Strings.UTF_Encoding.Wide_Strings.Decode
(Ada.Strings.Unbounded.To_String (Argument));
S : constant Wide_String := Ada.Strings.UTF_Encoding.Wide_Strings.Decode
(Argument);
J : Natural; -- Iterator
N : Natural; -- Number of sequential backslashes.
@@ -255,7 +256,7 @@ package body Spawn.Processes.Windows is
function Make_Command_Line return Interfaces.C.wchar_array;
function Work_Directory return String;
function Is_Error (Value : Windows_API.BOOL) return Boolean;
procedure Request_Read (Kind : Standard_Pipe);
procedure Request_Read (Kind : Spawn.Common.Standard_Pipe);
procedure Create_Pipe
(Parent_Handle : out Windows_API.HANDLE;
@@ -459,7 +460,7 @@ package body Spawn.Processes.Windows is
function Create_Pipes
(Start : access Windows_API.STARTUPINFOW) return Boolean
is
Child : constant array (Standard_Pipe) of
Child : constant array (Spawn.Common.Standard_Pipe) of
not null access Windows_API.HANDLE :=
(Stdin => Start.hStdInput'Access,
Stdout => Start.hStdOutput'Access,
@@ -467,7 +468,7 @@ package body Spawn.Processes.Windows is
Ok : Boolean := True;
begin
for J in Standard_Pipe loop
for J in Spawn.Common.Standard_Pipe loop
Self.pipe (J).Process := Self'Unchecked_Access;
Self.pipe (J).Kind := J;
Create_Pipe
@@ -508,8 +509,7 @@ package body Spawn.Processes.Windows is
for Arg of Self.Arguments loop
Ada.Strings.Wide_Unbounded.Append (Result, ' ');
Append_Escaped_String
(Result, Ada.Strings.Unbounded.To_Unbounded_String (Arg));
Append_Escaped_String (Result, Arg);
end loop;
return Interfaces.C.To_C
@@ -520,7 +520,7 @@ package body Spawn.Processes.Windows is
-- Request_Read --
------------------
procedure Request_Read (Kind : Standard_Pipe) is
procedure Request_Read (Kind : Spawn.Common.Standard_Pipe) is
begin
if Is_Error
(Read_Write_Ex.ReadFileEx
@@ -552,8 +552,7 @@ package body Spawn.Processes.Windows is
Exe : constant Interfaces.C.wchar_array :=
Interfaces.C.To_C
(Ada.Strings.UTF_Encoding.Wide_Strings.Decode
(Ada.Strings.Unbounded.To_String (Self.Program)));
(Ada.Strings.UTF_Encoding.Wide_Strings.Decode (Self.Program));
Args : Interfaces.C.wchar_array := Make_Command_Line;
@@ -664,7 +663,7 @@ package body Spawn.Processes.Windows is
(dwErrorCode : Windows_API.DWORD;
dwNumberOfBytesTransfered : Windows_API.DWORD;
lpOverlapped : access Internal.Context;
Kind : Standard_Pipe)
Kind : Spawn.Common.Standard_Pipe)
is
use type Windows_API.DWORD;
use type Windows_API.HANDLE;
@@ -805,8 +804,7 @@ package body Spawn.Processes.Windows is
Self.Exit_Code := Process_Exit_Code (Exit_Code);
Self.Status := Not_Running;
Self.Listener.Finished
(Self.Exit_Status, Self.Exit_Code);
Self.Listener.Finished (Self.Exit_Status, Self.Exit_Code);
end if;
end On_Process_Died;
@@ -836,4 +834,4 @@ package body Spawn.Processes.Windows is
(dwErrorCode, dwNumberOfBytesTransfered, lpOverlapped, Stdout);
end Standard_Output_Callback;
end Spawn.Processes.Windows;
end Spawn.Internal.Windows;

9
source/spawn/spawn-processes-windows.ads → source/spawn/spawn-internal-windows.ads
View File

@@ -1,13 +1,14 @@
--
-- Copyright (C) 2018-2021, AdaCore
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
with Spawn.Windows_API;
with Spawn.Common;
private
package Spawn.Processes.Windows is
package Spawn.Internal.Windows is
procedure Do_Start_Process
(Self : aliased in out Process'Class;
@@ -40,7 +41,7 @@ package Spawn.Processes.Windows is
(dwErrorCode : Windows_API.DWORD;
dwNumberOfBytesTransfered : Windows_API.DWORD;
lpOverlapped : access Internal.Context;
Kind : Standard_Pipe);
Kind : Spawn.Common.Standard_Pipe);
-- Implementation shared between Standard_[Output/Error]_Callback
end Spawn.Processes.Windows;
end Spawn.Internal.Windows;

53
source/spawn/spawn-internal__glib.ads
View File

@@ -1,53 +0,0 @@
--
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
with Ada.Finalization;
with Glib.Main;
with Glib.Spawn;
with Spawn.Channels;
private package Spawn.Internal is
package Environments is
function "=" (Left, Right : UTF_8_String) return Boolean;
function "<" (Left, Right : UTF_8_String) return Boolean;
end Environments;
type Pipe_Kinds is (Stdin, Stdout, Stderr);
type Process is tagged;
type Process_Reference is record
Self : access Process'Class;
end record;
-- A wrapper to pass process pointer to C binding functions
type Process is
abstract new Ada.Finalization.Limited_Controlled with record
Reference : aliased Process_Reference;
Channels : Spawn.Channels.Channels (Process'Unchecked_Access);
Event : Glib.Main.G_Source_Id := 0;
pid : aliased Glib.Spawn.GPid := 0;
end record;
procedure Emit_Stdin_Available (Self : in out Process) is abstract;
procedure Emit_Stdout_Available (Self : in out Process) is abstract;
procedure Emit_Stderr_Available (Self : in out Process) is abstract;
procedure Emit_Error_Occurred
(Self : in out Process;
Process_Error : Integer) is abstract;
procedure On_Close_Channels (Self : in out Process) is null;
-- This callback is called when last channel is closed
end Spawn.Internal;

89
source/spawn/spawn-processes-platform__glib.adb → source/spawn/spawn-internal__glib_posix.adb
View File

@@ -4,25 +4,25 @@
-- SPDX-License-Identifier: Apache-2.0
--
with Interfaces.C;
pragma Warnings (Off, "internal GNAT unit");
with System.OS_Interface;
pragma Warnings (On);
with Glib.Error;
with Glib.Main;
with Glib.Spawn;
with Gtkada.Types;
with Spawn.Channels;
with Spawn.Environments.Internal;
with Spawn.Posix;
separate (Spawn.Processes)
package body Platform is
package body Spawn.Internal is
use all type Spawn.Common.Pipe_Kinds;
procedure Do_Start_Process (Self : aliased in out Process'Class);
type Process_Access is access all Process'Class;
function Spawn_Async_With_Fds is
new Glib.Spawn.Generic_Spawn_Async_With_Fds
(User_Data => Glib.Gint);
function Child_Watch is new Glib.Main.Generic_Child_Add_Watch
(User_Data => Internal.Process_Reference);
@@ -33,17 +33,35 @@ package body Platform is
data : access Internal.Process_Reference)
with Convention => C;
type Process_Access is access all Process'Class;
function Spawn_Async_With_Fds is
new Glib.Spawn.Generic_Spawn_Async_With_Fds
(User_Data => Glib.Gint);
procedure Do_Start_Process (Self : aliased in out Process'Class);
procedure Setup_Child_Process (Fd : access Glib.Gint)
with Convention => C;
-- Setup session and controlling terminal when pseudoterminal is used
-- for interprocess communication.
package body Environments is
---------
-- "=" --
---------
function "=" (Left, Right : UTF_8_String) return Boolean is
begin
return Standard."=" (Left, Right);
end "=";
---------
-- "<" --
---------
function "<" (Left, Right : UTF_8_String) return Boolean is
begin
return Standard."<" (Left, Right);
end "<";
end Environments;
--------------------------
-- Close_Standard_Error --
--------------------------
@@ -76,7 +94,6 @@ package body Platform is
----------------------
procedure Do_Start_Process (Self : aliased in out Process'Class) is
use Ada.Strings.Unbounded;
use Glib;
use type Interfaces.C.size_t;
@@ -89,8 +106,7 @@ package body Platform is
procedure Prepare_Arguments (argv : out Gtkada.Types.Chars_Ptr_Array) is
begin
argv (0) := Gtkada.Types.New_String
(To_String (Self.Program));
argv (0) := Gtkada.Types.New_String (Self.Program);
for J in 1 .. Self.Arguments.Last_Index loop
argv (Interfaces.C.size_t (J)) := Gtkada.Types.New_String
@@ -100,10 +116,12 @@ package body Platform is
argv (argv'Last) := Gtkada.Types.Null_Ptr;
end Prepare_Arguments;
pid : aliased Glib.Spawn.GPid
with Import, Address => Self.pid'Address;
dir : Gtkada.Types.Chars_Ptr :=
(if Length (Self.Directory) = 0 then Gtkada.Types.Null_Ptr
else Gtkada.Types.New_String
(To_String (Self.Directory)));
(if Self.Working_Directory'Length = 0 then Gtkada.Types.Null_Ptr
else Gtkada.Types.New_String (Self.Working_Directory));
argv : aliased Gtkada.Types.Chars_Ptr_Array :=
(0 .. Interfaces.C.size_t (Self.Arguments.Length) + 1 => <>);
@@ -133,7 +151,7 @@ package body Platform is
Flags => Glib.Spawn.G_Spawn_Do_Not_Reap_Child,
Child_Setup => Setup_Child_Process'Access,
Data => PTY'Unchecked_Access,
Child_Pid => Self.pid'Access,
Child_Pid => pid'Access,
Stdin_Fd => Spawn.Channels.Child_Stdin (Self.Channels),
Stdout_Fd => Spawn.Channels.Child_Stdout (Self.Channels),
Stderr_Fd => Spawn.Channels.Child_Stderr (Self.Channels),
@@ -153,7 +171,7 @@ package body Platform is
end if;
Self.Event := Child_Watch
(Self.pid,
(pid,
My_Death_Callback'Access,
Self.Reference'Access);
@@ -167,22 +185,11 @@ package body Platform is
-- Finalize --
--------------
procedure Finalize
(Self : in out Process'Class;
Status : Process_Status)
is
pragma Unreferenced (Status);
use type Glib.Main.G_Source_Id;
overriding procedure Finalize (Self : in out Process) is
begin
Spawn.Channels.Shutdown_Channels (Self.Channels);
if Self.Event /= Glib.Main.No_Source_Id then
Glib.Main.Remove (Self.Event);
Self.Event := Glib.Main.No_Source_Id;
if Self.Status = Running then
raise Program_Error;
end if;
Glib.Spawn.Spawn_Close_Pid (Self.pid);
Self.pid := 0;
end Finalize;
------------------
@@ -192,9 +199,9 @@ package body Platform 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 (System.OS_Interface.SIGKILL));
Code : constant Interfaces.C.int :=
Spawn.Posix.kill
(Self.pid, Interfaces.C.int (System.OS_Interface.SIGKILL));
begin
pragma Assert (Code = 0);
end Kill_Process;
@@ -321,9 +328,9 @@ package body Platform 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 (System.OS_Interface.SIGTERM));
Code : constant Interfaces.C.int :=
Spawn.Posix.kill
(Self.pid, Interfaces.C.int (System.OS_Interface.SIGTERM));
begin
pragma Assert (Code = 0);
end Terminate_Process;
@@ -340,4 +347,4 @@ package body Platform is
Spawn.Channels.Write_Stdin (Self.Channels, Data, Last);
end Write_Standard_Input;
end Platform;
end Spawn.Internal;

80
source/spawn/spawn-internal__glib_posix.ads Normal file
View File

@@ -0,0 +1,80 @@
--
-- Copyright (C) 2018-2022, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0
--
with Ada.Streams;
with Interfaces.C;
with Glib.Main;
with Spawn.Channels;
with Spawn.Common;
private package Spawn.Internal is
package Environments is
function "=" (Left, Right : UTF_8_String) return Boolean;
function "<" (Left, Right : UTF_8_String) return Boolean;
end Environments;
type Process is tagged;
type Process_Reference is record
Self : access Process'Class;
end record;
-- A wrapper to pass process pointer to C binding functions
type Process is new Spawn.Common.Process with record
Reference : aliased Process_Reference;
Channels : Spawn.Channels.Channels (Process'Unchecked_Access);
Event : Glib.Main.G_Source_Id := 0;
pid : Interfaces.C.int := 0;
Pending_Finish : Boolean := False;
-- We have got pid closed but channels are still active.
-- In this case delay Finished callback until channels are closed.
end record;
overriding procedure Finalize (Self : in out Process);
procedure Start (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Terminate_Process (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Kill_Process (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Close_Standard_Input (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Write_Standard_Input
(Self : in out Process'Class;
Data : Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
procedure Close_Standard_Output (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Read_Standard_Output
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
procedure Close_Standard_Error (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Read_Standard_Error
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
end Spawn.Internal;

65
source/spawn/spawn-processes-platform__glib_windows.adb → source/spawn/spawn-internal__glib_windows.adb
View File

@@ -4,22 +4,53 @@
-- SPDX-License-Identifier: Apache-2.0
--
with Glib.Main;
with Glib.Spawn;
with Ada.Strings.UTF_Encoding.Wide_Strings;
with Ada.Wide_Characters.Unicode;
with Spawn.Processes.Windows;
with Spawn.Internal.Windows;
with Spawn.Windows_API;
pragma Warnings (Off);
with System.Win32;
pragma Warnings (On);
package body Spawn.Internal is
use type Ada.Streams.Stream_Element_Offset;
use all type Spawn.Common.Pipe_Kinds;
separate (Spawn.Processes)
package body Platform is
package body Environments is
subtype Context is Internal.Context;
---------
-- "=" --
---------
type Process_Access is access all Processes.Process'Class;
function "=" (Left, Right : UTF_8_String) return Boolean is
begin
return To_Key (Left) = To_Key (Right);
end "=";
---------
-- "<" --
---------
function "<" (Left, Right : UTF_8_String) return Boolean is
begin
return To_Key (Left) < To_Key (Right);
end "<";
------------
-- To_Key --
------------
function To_Key (Text : UTF_8_String) return Wide_String is
Value : Wide_String :=
Ada.Strings.UTF_Encoding.Wide_Strings.Decode (Text);
begin
for Char of Value loop
Char := Ada.Wide_Characters.Unicode.To_Upper_Case (Char);
end loop;
return Value;
end To_Key;
end Environments;
type Process_Access is access all Process'Class;
procedure Do_Start_Process (Self : aliased in out Process'Class);
@@ -27,7 +58,7 @@ package body Platform is
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
Kind : Standard_Pipe);
Kind : Spawn.Common.Standard_Pipe);
function Child_Watch is new Glib.Main.Generic_Child_Add_Watch
(User_Data => Internal.Process_Reference);
@@ -98,7 +129,7 @@ package body Platform is
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
Kind : Standard_Pipe)
Kind : Spawn.Common.Standard_Pipe)
is
procedure On_No_Data;
@@ -153,11 +184,7 @@ package body Platform is
-- Finalize --
--------------
procedure Finalize
(Self : in out Process'Class;
Status : Process_Status)
is
pragma Unreferenced (Status);
overriding procedure Finalize (Self : in out Process) is
use type Glib.Main.G_Source_Id;
begin
@@ -328,4 +355,4 @@ package body Platform is
Windows.Do_Write (Self, Data, Last, On_No_Data'Access);
end Write_Standard_Input;
end Platform;
end Spawn.Internal;

51
source/spawn/spawn-internal__glib_windows.ads
View File

@@ -6,15 +6,17 @@
with Ada.Finalization;
with Ada.Streams;
-- with Interfaces.C;
with Glib.Main;
with Glib.Spawn;
with Spawn.Windows_API;
pragma Warnings (Off);
with System.Win32;
pragma Warnings (On);
with Spawn.Common;
private package Spawn.Internal is
package Environments is
@@ -32,7 +34,7 @@ private package Spawn.Internal is
subtype Stream_Element_Buffer is
Ada.Streams.Stream_Element_Array (1 .. Buffer_Size);
type Pipe_Kinds is (Stdin, Stdout, Stderr);
subtype Pipe_Kinds is Spawn.Common.Pipe_Kinds;
type Context is record
lpOverlapped : Windows_API.OVERLAPPED;
@@ -52,24 +54,51 @@ private package Spawn.Internal is
end record;
-- A wrapper to pass process pointer to C binding functions
type Process is
abstract new Ada.Finalization.Limited_Controlled with record
type Process is new Spawn.Common.Process with record
Reference : aliased Process_Reference;
Event : Glib.Main.G_Source_Id := 0;
pid : aliased Windows_API.PROCESS_INFORMATION;
pipe : Pipe_Array;
end record;
-- Process implementation type provides the same interface as
-- Spawn.Processes.Process type.
procedure Emit_Stdin_Available (Self : in out Process) is abstract;
overriding procedure Finalize (Self : in out Process);
procedure Emit_Stdout_Available (Self : in out Process) is abstract;
procedure Start (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Emit_Stderr_Available (Self : in out Process) is abstract;
procedure Terminate_Process (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Emit_Error_Occurred
(Self : in out Process;
Process_Error : Integer) is abstract;
procedure Kill_Process (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure On_Close_Channels (Self : in out Process) is null;
procedure Close_Standard_Input (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Write_Standard_Input
(Self : in out Process'Class;
Data : Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
procedure Close_Standard_Output (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Read_Standard_Output
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
procedure Close_Standard_Error (Self : in out Process'Class);
-- See documentation in Spawn.Processes.
procedure Read_Standard_Error
(Self : in out Process'Class;
Data : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- See documentation in Spawn.Processes.
end Spawn.Internal;

Some files were not shown because too many files have changed in this diff Show More