diff --git a/Makefile b/Makefile index 1395a04..bdf4793 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ GPRINSTALL_FLAGS = --prefix=$(PREFIX) --sources-subdir=$(INSTALL_INCLUDE_DIR)\ --lib-subdir=$(INSTALL_ALI_DIR) --project-subdir=$(INSTALL_PROJECT_DIR)\ --link-lib-subdir=$(INSTALL_LIBRARY_DIR) -SPAWN_TESTS=spawn_test spawn_unexpected wait_all spawn_bad_exe check_cmd +SPAWN_TESTS=spawn_test spawn_unexpected wait_all spawn_bad_exe check_cmd check_die ifneq ($(OS),Windows_NT) SPAWN_TESTS += spawn_kill spawn_stty diff --git a/gnat/tests/spawn_tests.gpr b/gnat/tests/spawn_tests.gpr index 9d667ee..fe9bd8e 100644 --- a/gnat/tests/spawn_tests.gpr +++ b/gnat/tests/spawn_tests.gpr @@ -10,7 +10,7 @@ project Spawn_Tests is Main := ("spawn_test.adb", "spawn_unexpected.adb", "spawn_stty.adb", - "wait_all.adb", "spawn_bad_exe.adb", "check_cmd"); + "wait_all.adb", "spawn_bad_exe.adb", "check_cmd", "check_die"); case Spawn.OS_API is when "unix" | "osx" => diff --git a/source/spawn/spawn-internal-windows.adb b/source/spawn/spawn-internal-windows.adb index c06c295..2e3da40 100644 --- a/source/spawn/spawn-internal-windows.adb +++ b/source/spawn/spawn-internal-windows.adb @@ -14,6 +14,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C.Strings; pragma Warnings (Off); +with Spawn.Process_Listeners; with System.OS_Interface; with System.Win32; pragma Warnings (On); @@ -810,8 +811,15 @@ package body Spawn.Internal.Windows is Exit_Code : aliased Windows_API.DWORD := 0; begin - -- Close stdio pipes + Self.On_Die := True; + -- Last chance to load data from pipes. We will close the pipes below + -- and (at least on Windows) we can't get the last portion of data + -- after this. + Self.Emit_Stdout_Available; + Self.Emit_Stderr_Available; + + -- Close stdio pipes for J in Self.pipe'Range loop Do_Close_Pipe (Self, J); end loop; @@ -873,6 +881,7 @@ package body Spawn.Internal.Windows is then Self.Status := Not_Running; Self.Emit_Finished (Self.Exit_Status, Self.Exit_Code); + else Self.Pending_Finish := True; end if; diff --git a/source/spawn/spawn-internal__glib_windows.adb b/source/spawn/spawn-internal__glib_windows.adb index decb60b..ae9c59f 100644 --- a/source/spawn/spawn-internal__glib_windows.adb +++ b/source/spawn/spawn-internal__glib_windows.adb @@ -259,7 +259,9 @@ package body Spawn.Internal is lpOverlapped => Pipe'Access, lpCompletionRoutine => Callback (Kind)); - if Ok = System.Win32.FALSE then + if not Self.On_Die + and then Ok = System.Win32.FALSE + then case Kind is when Stderr => Self.Emit_Standard_Error_Stream_Error diff --git a/source/spawn/spawn-internal__glib_windows.ads b/source/spawn/spawn-internal__glib_windows.ads index 31bd572..f5440f7 100644 --- a/source/spawn/spawn-internal__glib_windows.ads +++ b/source/spawn/spawn-internal__glib_windows.ads @@ -61,6 +61,7 @@ private package Spawn.Internal is Event : Glib.Main.G_Source_Id := 0; pid : aliased Windows_API.PROCESS_INFORMATION; pipe : Pipe_Array; + On_Die : Boolean := False; end record; -- Process implementation type provides the same interface as -- Spawn.Processes.Process type. diff --git a/source/spawn/spawn-internal__windows.ads b/source/spawn/spawn-internal__windows.ads index fbaa347..068da92 100644 --- a/source/spawn/spawn-internal__windows.ads +++ b/source/spawn/spawn-internal__windows.ads @@ -53,16 +53,16 @@ private package Spawn.Internal is -- For Stdin, when Last > Buffer'Last that means write operation in -- progress (for Buffer (1 .. Last-Buffer'Length)) and we should send a -- notification on complete. - end record; type Pipe_Array is array (Pipe_Kinds) of aliased Context; -- Context for each pipe kind type Process is new Spawn.Common.Process with record - pid : aliased Windows_API.PROCESS_INFORMATION; - pipe : Pipe_Array; - Index : Natural := 0; + pid : aliased Windows_API.PROCESS_INFORMATION; + pipe : Pipe_Array; + Index : Natural := 0; + On_Die : Boolean := False; end record; -- Process implementation type provides the same interface as -- Spawn.Processes.Process type. diff --git a/testsuite/spawn/check_cmd.adb b/testsuite/spawn/check_cmd.adb index 041482f..e5561fa 100644 --- a/testsuite/spawn/check_cmd.adb +++ b/testsuite/spawn/check_cmd.adb @@ -57,13 +57,13 @@ begin for J in 1 .. 6 loop Spawn.Processes.Monitor_Loop (0.001); delay 0.5; - - if Listener.Process.Status = Not_Running then - -- Success - return; - end if; + exit when Listener.Process.Status = Not_Running; end loop; + if Listener.Process.Status /= Not_Running then + raise Program_Error; + end if; + -- Some process is till running Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Exit_Status (Listener.Process.Exit_Code)); diff --git a/testsuite/spawn/check_die.adb b/testsuite/spawn/check_die.adb new file mode 100644 index 0000000..93949dc --- /dev/null +++ b/testsuite/spawn/check_die.adb @@ -0,0 +1,88 @@ +-- +-- Copyright (C) 2023, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Spawn self executable and check that we have all output when process die + +with Ada.Command_Line; +with Ada.Directories; + +with Ada.Streams; +with Ada.Strings; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Text_IO; +with Spawn.String_Vectors; +with Spawn.Processes; +with Spawn.Processes.Monitor_Loop; + +procedure Check_Die is + use all type Spawn.Process_Status; + + package Listeners is + type Listener is limited new Spawn.Processes.Process_Listener with record + Process : Spawn.Processes.Process; + Output : Unbounded_String; + end record; + + overriding procedure Standard_Output_Available (Self : in out Listener); + end Listeners; + + Command : constant String := Ada.Directories.Full_Name + (Ada.Command_Line.Command_Name); + + Args : Spawn.String_Vectors.UTF_8_String_Vector; + + --------------- + -- Listeners -- + --------------- + + package body Listeners is + + ------------------------------- + -- Standard_Output_Available -- + ------------------------------- + + overriding procedure Standard_Output_Available + (Self : in out Listener) + is + Data : Ada.Streams.Stream_Element_Array (1 .. 4096); + Last : Ada.Streams.Stream_Element_Count; + Ok : Boolean := True; + + begin + Self.Process.Read_Standard_Output (Data, Last, Ok); + + for X of Data (1 .. Last) loop + Append (Self.Output, Character'Val (X)); + end loop; + end Standard_Output_Available; + + end Listeners; + + Listener : aliased Listeners.Listener; + +begin + if Ada.Command_Line.Argument_Count > 0 then + Ada.Text_IO.Put ("help"); + return; + end if; + + Args.Append ("second"); + Listener.Process.Set_Program (Command); + Listener.Process.Set_Arguments (Args); + Listener.Process.Set_Listener (Listener'Unchecked_Access); + Listener.Process.Start; + + for J in 1 .. 6 loop + Spawn.Processes.Monitor_Loop (0.001); + delay 0.5; + + exit when Listener.Process.Status = Not_Running; + end loop; + + if Listener.Output /= "help" then + raise Program_Error; + end if; +end Check_Die;