When GNAT.Expect reaches the end of its input, it does not properly
closes the input file descriptor, thus resulting in a memory leak.
This was properly handles when calling Get_Process_Output, but not
when writing the loop manually
---
-- The following program had errors reported by valgrind (fd leaks)
with Ada.Directories;
with GNAT.Expect;
with GNAT.OS_Lib;
procedure GNAT_Expect is
File : constant String := "/tmp/data.expect";
Count : constant := 2048;
Args : GNAT.OS_Lib.Argument_List (1 .. 4);
Pd : GNAT.Expect.Process_Descriptor;
Match : GNAT.Expect.Expect_Match;
Cmd : constant String := "echo testdata > " & File;
Res : Integer := 1;
begin
Args (1) := new String'("-o");
Args (2) := new String'("pipefail");
Args (3) := new String'("-c");
Args (4) := new String'(Cmd);
for I in 1 .. Count loop
GNAT.Expect.Non_Blocking_Spawn
(Descriptor => Pd,
Command => "/bin/bash",
Args => Args,
Buffer_Size => 0);
begin
GNAT.Expect.Expect
(Descriptor => Pd,
Result => Match,
Regexp => "",
Timeout => -1);
exception
when GNAT.Expect.Process_Died =>
GNAT.Expect.Close (Descriptor => Pd,
Status => Res);
end;
end loop;
end GNAT_Expect;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-04-02 Emmanuel Briot <br...@adacore.com>
* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.
Index: g-expect.adb
===================================================================
--- g-expect.adb (revision 186067)
+++ g-expect.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2011, AdaCore --
+-- Copyright (C) 2000-2012, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -33,7 +33,7 @@
with System.OS_Constants; use System.OS_Constants;
with Ada.Calendar; use Ada.Calendar;
-with GNAT.IO;
+with GNAT.IO; use GNAT.IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Regpat; use GNAT.Regpat;
@@ -678,6 +678,7 @@
-- ??? Note that ddd tries again up to three times
-- in that case. See LiterateA.C:174
+ Close (Descriptors (D).Input_Fd);
Descriptors (D).Input_Fd := Invalid_FD;
Result := Expect_Process_Died;
return;
@@ -893,7 +894,8 @@
begin
Non_Blocking_Spawn
- (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+ (Process, Command, Arguments, Err_To_Out => Err_To_Out,
+ Buffer_Size => 0);
if Input'Length > 0 then
Send (Process, Input);
@@ -1055,17 +1057,18 @@
Command_With_Path : String_Access;
begin
- -- Create the rest of the pipes
-
- Set_Up_Communications
- (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
-
Command_With_Path := Locate_Exec_On_Path (Command);
if Command_With_Path = null then
raise Invalid_Process;
end if;
+ -- Create the rest of the pipes once we know we will be able to
+ -- execute the process.
+
+ Set_Up_Communications
+ (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
+
-- Fork a new process
Descriptor.Pid := Fork;
@@ -1365,6 +1368,8 @@
end if;
if Create_Pipe (Pipe2) /= 0 then
+ Close (Pipe1.Input);
+ Close (Pipe1.Output);
return;
end if;
@@ -1389,7 +1394,7 @@
-- Create a separate pipe for standard error
if Create_Pipe (Pipe3) /= 0 then
- return;
+ Pipe3.all := Pipe2.all;
end if;
end if;
