[Ada] Avoid to close irrelevant file descriptors

[Ada] Avoid to close irrelevant file descriptors

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 589 bytes --]

'Close' subprogram of GNAT.Expect can close irrelevant file descriptors
when 'Expect' was terminated by Process_Died exception and any file open
operations was done before call to 'Close'.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-09-17  Vadim Godunko  <godunko@adacore.com>

gcc/ada/

	* libgnat/g-expect.ads, libgnat/g-expect.adb (Close_Input): New
	subprogram.
	(Get_Command_Output): Call Close_Input to close input stream.
	(Expect_Internal): Likewise.
	(Close): Likewise.
	* libgnat/g-exptty.adb (Close): Likewise.

gcc/testsuite/

	* gnat.dg/expect3.adb: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 4479 bytes --]

--- gcc/ada/libgnat/g-expect.adb
+++ gcc/ada/libgnat/g-expect.adb
@@ -222,15 +222,17 @@ package body GNAT.Expect is
       Next_Filter    : Filter_List;
 
    begin
-      if Descriptor.Input_Fd /= Invalid_FD then
-         Close (Descriptor.Input_Fd);
-      end if;
+      Close_Input (Descriptor);
 
-      if Descriptor.Error_Fd /= Descriptor.Output_Fd then
+      if Descriptor.Error_Fd /= Descriptor.Output_Fd
+        and then Descriptor.Error_Fd /= Invalid_FD
+      then
          Close (Descriptor.Error_Fd);
       end if;
 
-      Close (Descriptor.Output_Fd);
+      if Descriptor.Output_Fd /= Invalid_FD then
+         Close (Descriptor.Output_Fd);
+      end if;
 
       --  ??? Should have timeouts for different signals
 
@@ -267,6 +269,27 @@ package body GNAT.Expect is
       Close (Descriptor, Status);
    end Close;
 
+   -----------------
+   -- Close_Input --
+   -----------------
+
+   procedure Close_Input (Pid : in out Process_Descriptor) is
+   begin
+      if Pid.Input_Fd /= Invalid_FD then
+         Close (Pid.Input_Fd);
+      end if;
+
+      if Pid.Output_Fd = Pid.Input_Fd then
+         Pid.Output_Fd := Invalid_FD;
+      end if;
+
+      if Pid.Error_Fd = Pid.Input_Fd then
+         Pid.Error_Fd := Invalid_FD;
+      end if;
+
+      Pid.Input_Fd := Invalid_FD;
+   end Close_Input;
+
    ------------
    -- Expect --
    ------------
@@ -667,8 +690,7 @@ package body GNAT.Expect is
                   Result := Expect_Internal_Error;
 
                   if D /= 0 then
-                     Close (Descriptors (D).Input_Fd);
-                     Descriptors (D).Input_Fd := Invalid_FD;
+                     Close_Input (Descriptors (D).all);
                   end if;
 
                   return;
@@ -707,9 +729,9 @@ package body GNAT.Expect is
                         --  Error or End of file
 
                         if N <= 0 then
-                           Close (Descriptors (D).Input_Fd);
-                           Descriptors (D).Input_Fd := Invalid_FD;
+                           Close_Input (Descriptors (D).all);
                            Result := Expect_Process_Died;
+
                            return;
 
                         else
@@ -931,8 +953,7 @@ package body GNAT.Expect is
          Send (Process, Input);
       end if;
 
-      Close (Process.Input_Fd);
-      Process.Input_Fd := Invalid_FD;
+      Close_Input (Process);
 
       declare
          Result : Expect_Match;

--- gcc/ada/libgnat/g-expect.ads
+++ gcc/ada/libgnat/g-expect.ads
@@ -613,6 +613,10 @@ private
    --  spawns the child process (based on Cmd). On systems that support fork,
    --  this procedure is executed inside the newly created process.
 
+   procedure Close_Input (Pid : in out Process_Descriptor);
+   --  Closes input file descriptor. Set Input_Fd to Invalid_Fd as well as
+   --  Output_Fd and Error_Fd when they share same file descriptor.
+
    type Process_Descriptor is tagged record
       Pid              : aliased Process_Id := Invalid_Pid;
       Input_Fd         : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;

--- gcc/ada/libgnat/g-exptty.adb
+++ gcc/ada/libgnat/g-exptty.adb
@@ -93,9 +93,7 @@ package body GNAT.Expect.TTY is
          --  signal, so this needs to be done while the file descriptors are
          --  still open (it used to be after the closes and that was wrong).
 
-         if Descriptor.Input_Fd /= Invalid_FD then
-            Close (Descriptor.Input_Fd);
-         end if;
+         Close_Input (Descriptor);
 
          if Descriptor.Error_Fd /= Descriptor.Output_Fd
            and then Descriptor.Error_Fd /= Invalid_FD

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/expect3.adb
@@ -0,0 +1,33 @@
+--  { dg-do run }
+
+with Ada.Text_IO;
+
+with GNAT.Expect.TTY;
+with GNAT.OS_Lib;
+
+procedure Expect3 is
+   Pid    : GNAT.Expect.TTY.TTY_Process_Descriptor;
+   Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
+   Result : GNAT.Expect.Expect_Match;
+
+begin
+   Pid.Non_Blocking_Spawn ("true", Args);
+
+   begin
+      Pid.Expect (Result, ".*");
+
+      raise Program_Error;
+
+   exception
+      when GNAT.Expect.Process_Died =>
+         declare
+            File : Ada.Text_IO.File_Type;
+
+         begin
+            Ada.Text_IO.Create (File);
+            Pid.Close;
+            Ada.Text_IO.Put_Line (File, "Test of write operation");
+            Ada.Text_IO.Close (File);
+         end;
+   end;
+end Expect3;
\ No newline at end of file