[Ada] Avoid to close irrelevant file descriptors

'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'.

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.

From-SVN: r275781

gcc/ada/ChangeLog

+2019-09-17  Vadim Godunko  <godunko@adacore.com>
+
+	* 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.
+
 2019-09-17  Piotr Trojanek  <trojanek@adacore.com>
 
 	* sem_util.ads, sem_util.adb (Is_Attribute_Old): New utility

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

@@ -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

@@ -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

gcc/testsuite/ChangeLog

+2019-09-17  Vadim Godunko  <godunko@adacore.com>
+
+	* gnat.dg/expect3.adb: New testcase.
+
 2019-09-17  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/predicate13.adb, gnat.dg/predicate13.ads: New

gcc/testsuite/gnat.dg/expect3.adb

+--  { 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