Load stdout when a process died

On Windows we have an issue when not all data is loaded from
 the output pipe when a process terminates.

For eng/ide/gnatstudio#482

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

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" =>

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;

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

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.

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.

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));

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;