[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 705756d06254be8ddc995a1467d6b10585280088..c952898352fac1bd2a13d97b197d18bdab307470 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/ada/libgnat/g-expect.adb b/gcc/ada/libgnat/g-expect.adb
index 21c7913840b693760146bda851a5c39e8e0ab622..b44c7a5f016691ec1250655cc0815c8bc7cc8ccb 100644 (file)
--- a/gcc/ada/libgnat/g-expect.adb
+++ b/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;

diff --git a/gcc/ada/libgnat/g-expect.ads b/gcc/ada/libgnat/g-expect.ads
index ae84f8409eae425155e62c620b01de63fd0a1297..77bb579212bf8396fdb8475c2da7efb9b427743b 100644 (file)
--- a/gcc/ada/libgnat/g-expect.ads
+++ b/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;

diff --git a/gcc/ada/libgnat/g-exptty.adb b/gcc/ada/libgnat/g-exptty.adb
index 728c5c6528092d076b77be08609640ef30138358..4f0300fbd8d63206bf5ed14ae0f681f8ff44e26f 100644 (file)
--- a/gcc/ada/libgnat/g-exptty.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d5b3e5a659042475935e0f4d1c696cde265ae04f..caed11b9ba3919c9c06bb65228e3ad573fda035c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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

diff --git a/gcc/testsuite/gnat.dg/expect3.adb b/gcc/testsuite/gnat.dg/expect3.adb
new file mode 100644 (file)
index 0000000..a833ea9
--- /dev/null
+++ b/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