From b9bfbf45419a641c0b92b1954b94b73cb3dfb935 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Tue, 17 Sep 2019 08:01:37 +0000 Subject: [PATCH] [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 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 | 9 +++++++ gcc/ada/libgnat/g-expect.adb | 43 +++++++++++++++++++++++-------- gcc/ada/libgnat/g-expect.ads | 4 +++ gcc/ada/libgnat/g-exptty.adb | 4 +-- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/expect3.adb | 33 ++++++++++++++++++++++++ 6 files changed, 83 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/expect3.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 705756d0625..c952898352f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-09-17 Vadim Godunko + + * 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 * 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 21c7913840b..b44c7a5f016 100644 --- 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 ae84f8409ea..77bb579212b 100644 --- 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 728c5c65280..4f0300fbd8d 100644 --- 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 d5b3e5a6590..caed11b9ba3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-17 Vadim Godunko + + * gnat.dg/expect3.adb: New testcase. + 2019-09-17 Ed Schonberg * 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 index 00000000000..a833ea9945b --- /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 -- 2.30.2