From 23b154cf57da8808e1a2cd0db703bd8264cdb44b Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Fri, 10 Feb 2023 18:05:47 +0200 Subject: [PATCH] Fix waiting for several processes. Add the test. SIGCHLD signal could be triggered for several exited children. So let's call waitpid untill no more children change state. Fix #30 --- Makefile | 6 +- gnat/spawn_tests.gpr | 4 +- .../spawn/spawn-internal-monitor__posix.adb | 58 +++++++++------- testsuite/spawn/wait_all.adb | 69 +++++++++++++++++++ 4 files changed, 109 insertions(+), 28 deletions(-) create mode 100644 testsuite/spawn/wait_all.adb diff --git a/Makefile b/Makefile index 4e21bb8..0185576 100644 --- a/Makefile +++ b/Makefile @@ -11,10 +11,10 @@ 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=.obj/spawn_test/spawn_test .obj/spawn_test/spawn_unexpected +SPAWN_TESTS=spawn_test spawn_unexpected wait_all ifneq ($(OS),Windows_NT) - SPAWN_TESTS += .obj/spawn_test/spawn_kill .obj/spawn_test/spawn_stty + SPAWN_TESTS += spawn_kill spawn_stty endif all: @@ -23,7 +23,7 @@ all: check: export LD_LIBRARY_PATH=.libs/spawn/relocatable; \ for TEST in ${SPAWN_TESTS}; do \ - echo $$TEST; $$TEST; \ + echo $$TEST; .obj/spawn_test/$$TEST; \ done install: diff --git a/gnat/spawn_tests.gpr b/gnat/spawn_tests.gpr index 554accc..e55c96f 100644 --- a/gnat/spawn_tests.gpr +++ b/gnat/spawn_tests.gpr @@ -8,7 +8,9 @@ with "spawn"; project Spawn_Tests is - Main := ("spawn_test.adb", "spawn_unexpected.adb", "spawn_stty.adb"); + Main := + ("spawn_test.adb", "spawn_unexpected.adb", "spawn_stty.adb", + "wait_all.adb"); case Spawn.OS_API is when "unix" | "osx" => diff --git a/source/spawn/spawn-internal-monitor__posix.adb b/source/spawn/spawn-internal-monitor__posix.adb index 5e1d42c..6a38b26 100644 --- a/source/spawn/spawn-internal-monitor__posix.adb +++ b/source/spawn/spawn-internal-monitor__posix.adb @@ -139,37 +139,47 @@ package body Spawn.Internal.Monitor is return Imported (Status) /= 0; end WIFSIGNALED; - status : aliased Interfaces.C.unsigned := 0; - pid : constant Interfaces.C.int := - Posix.waitpid (-1, status'Unchecked_Access, Posix.WNOHANG); - - Cursor : constant Process_Maps.Cursor := Map.Find (pid); + status : aliased Interfaces.C.unsigned := 0; Process : Process_Access; begin - if Process_Maps.Has_Element (Cursor) then - Process := Process_Maps.Element (Cursor); + loop + declare + pid : constant Interfaces.C.int := + Posix.waitpid (-1, status'Unchecked_Access, Posix.WNOHANG); - Process.Exit_Status := (if WIFEXITED (status) then Normal else Crash); + Cursor : constant Process_Maps.Cursor := Map.Find (pid); + begin + exit when pid <= 0; -- no more children change state - case Process.Exit_Status is - when Normal => - Process.Exit_Code := Process_Exit_Code (WEXITSTATUS (status)); + if Process_Maps.Has_Element (Cursor) then + Process := Process_Maps.Element (Cursor); - when Crash => - Process.Exit_Code := - (if WIFSIGNALED (status) - then Process_Exit_Code (WTERMSIG (status)) - else Process_Exit_Code'Last); - end case; + Process.Exit_Status := + (if WIFEXITED (status) then Normal else Crash); - if Spawn.Channels.Is_Active (Process.Channels) then - Process.Pending_Finish := True; - else - Process.Status := Not_Running; - Process.Emit_Finished (Process.Exit_Status, Process.Exit_Code); - end if; - end if; + case Process.Exit_Status is + when Normal => + Process.Exit_Code := + Process_Exit_Code (WEXITSTATUS (status)); + + when Crash => + Process.Exit_Code := + (if WIFSIGNALED (status) + then Process_Exit_Code (WTERMSIG (status)) + else Process_Exit_Code'Last); + end case; + + if Spawn.Channels.Is_Active (Process.Channels) then + Process.Pending_Finish := True; + else + Process.Status := Not_Running; + Process.Emit_Finished + (Process.Exit_Status, Process.Exit_Code); + end if; + end if; + end; + end loop; end Check_Children; ------------------- diff --git a/testsuite/spawn/wait_all.adb b/testsuite/spawn/wait_all.adb new file mode 100644 index 0000000..f9eca1e --- /dev/null +++ b/testsuite/spawn/wait_all.adb @@ -0,0 +1,69 @@ +-- +-- Copyright (C) 2023, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 +-- + +-- Spawn several subprocess and wait all of them is finished. + +with Ada.Command_Line; +with Ada.Calendar; +with Ada.Directories; + +with Spawn.String_Vectors; +with Spawn.Processes; +with Spawn.Processes.Monitor_Loop; + +procedure Wait_All 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; + end record; + end Listeners; + + Command : constant String := Ada.Directories.Full_Name + (Ada.Command_Line.Command_Name); + + Args : Spawn.String_Vectors.UTF_8_String_Vector; + List : array (1 .. 10) of aliased Listeners.Listener; + +begin + if Ada.Command_Line.Argument_Count > 0 then + -- Child process: wait next second boundary and exit + declare + Seconds : constant Duration := + Ada.Calendar.Seconds (Ada.Calendar.Clock); + + Sleep : constant Duration := + Duration (Integer (Seconds + 0.5)) - Seconds; + begin + delay Sleep; + + return; + end; + end if; + + Args.Append ("wait"); + + for Item of List loop + Item.Process.Set_Program (Command); + Item.Process.Set_Arguments (Args); + Item.Process.Set_Listener (Item'Unchecked_Access); + Item.Process.Start; + end loop; + + for J in 1 .. 6 loop + Spawn.Processes.Monitor_Loop (0.001); + delay 0.5; + + if (for all Item of List => Item.Process.Status = Not_Running) then + -- Success + return; + end if; + end loop; + + -- Some process is till running + Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); +end Wait_All;