2005-07-04 Thomas Quinot <quinot@adacore.com>

* g-expect-vms.adb, g-expect.ads, g-expect.adb
	(Get_Command_Output): New subprogram to launch a process and get its
	standard output as a string.

From-SVN: r101571

gcc/ada/g-expect-vms.adb

@@ -761,6 +761,89 @@ package body GNAT.Expect is
 
    end Flush;
 
+   ------------------------
+   -- Get_Command_Output --
+   ------------------------
+
+   function Get_Command_Output
+     (Command    : String;
+      Arguments  : GNAT.OS_Lib.Argument_List;
+      Input      : String;
+      Status     : access Integer;
+      Err_To_Out : Boolean := False) return String
+   is
+      use GNAT.Expect;
+
+      Process : Process_Descriptor;
+
+      Output : String_Access := new String (1 .. 1024);
+      --  Buffer used to accumulate standard output from the launched
+      --  command, expanded as necessary during execution.
+
+      Last : Integer := 0;
+      --  Index of the last used character within Output
+
+   begin
+      Non_Blocking_Spawn
+        (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+
+      if Input'Length > 0 then
+         Send (Process, Input);
+      end if;
+
+      GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+
+      declare
+         Result : Expect_Match;
+
+      begin
+         --  This loop runs until the call to Expect raises Process_Died
+
+         loop
+            Expect (Process, Result, ".+");
+
+            declare
+               NOutput : String_Access;
+               S       : constant String := Expect_Out (Process);
+               pragma Assert (S'Length > 0);
+
+            begin
+               --  Expand buffer if we need more space
+
+               if Last + S'Length > Output'Last then
+                  NOutput := new String (1 .. 2 * Output'Last);
+                  NOutput (Output'Range) := Output.all;
+                  Free (Output);
+
+                  --  Here if current buffer size is OK
+
+               else
+                  NOutput := Output;
+               end if;
+
+               NOutput (Last + 1 .. Last + S'Length) := S;
+               Last := Last + S'Length;
+               Output := NOutput;
+            end;
+         end loop;
+
+      exception
+         when Process_Died =>
+            Close (Process, Status.all);
+      end;
+
+      if Last = 0 then
+         return "";
+      end if;
+
+      declare
+         S : constant String := Output (1 .. Last);
+      begin
+         Free (Output);
+         return S;
+      end;
+   end Get_Command_Output;
+
    ------------------
    -- Get_Error_Fd --
    ------------------

gcc/ada/g-expect.adb

@@ -108,7 +108,7 @@ package body GNAT.Expect is
 
    function Waitpid (Pid : Process_Id) return Integer;
    pragma Import (C, Waitpid, "__gnat_waitpid");
-   --  Wait for a specific process id, and return its exit code.
+   --  Wait for a specific process id, and return its exit code
 
    ---------
    -- "+" --
@@ -656,7 +656,7 @@ package body GNAT.Expect is
                                    Descriptors (J).Buffer_Size - N;
                               end if;
 
-                              --  Keep what we read in the buffer.
+                              --  Keep what we read in the buffer
 
                               Descriptors (J).Buffer
                                 (Descriptors (J).Buffer_Index + 1 ..
@@ -754,9 +754,91 @@ package body GNAT.Expect is
                end if;
          end case;
       end loop;
-
    end Flush;
 
+   ------------------------
+   -- Get_Command_Output --
+   ------------------------
+
+   function Get_Command_Output
+     (Command    : String;
+      Arguments  : GNAT.OS_Lib.Argument_List;
+      Input      : String;
+      Status     : access Integer;
+      Err_To_Out : Boolean := False) return String
+   is
+      use GNAT.Expect;
+
+      Process : Process_Descriptor;
+
+      Output : String_Access := new String (1 .. 1024);
+      --  Buffer used to accumulate standard output from the launched
+      --  command, expanded as necessary during execution.
+
+      Last : Integer := 0;
+      --  Index of the last used character within Output
+
+   begin
+      Non_Blocking_Spawn
+        (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+
+      if Input'Length > 0 then
+         Send (Process, Input);
+      end if;
+
+      GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+
+      declare
+         Result : Expect_Match;
+
+      begin
+         --  This loop runs until the call to Expect raises Process_Died
+
+         loop
+            Expect (Process, Result, ".+");
+
+            declare
+               NOutput : String_Access;
+               S       : constant String := Expect_Out (Process);
+               pragma Assert (S'Length > 0);
+
+            begin
+               --  Expand buffer if we need more space
+
+               if Last + S'Length > Output'Last then
+                  NOutput := new String (1 .. 2 * Output'Last);
+                  NOutput (Output'Range) := Output.all;
+                  Free (Output);
+
+                  --  Here if current buffer size is OK
+
+               else
+                  NOutput := Output;
+               end if;
+
+               NOutput (Last + 1 .. Last + S'Length) := S;
+               Last := Last + S'Length;
+               Output := NOutput;
+            end;
+         end loop;
+
+      exception
+         when Process_Died =>
+            Close (Process, Status.all);
+      end;
+
+      if Last = 0 then
+         return "";
+      end if;
+
+      declare
+         S : constant String := Output (1 .. Last);
+      begin
+         Free (Output);
+         return S;
+      end;
+   end Get_Command_Output;
+
    ------------------
    -- Get_Error_Fd --
    ------------------
@@ -1012,7 +1094,7 @@ package body GNAT.Expect is
    begin
       if Empty_Buffer then
 
-         --  Force a read on the process if there is anything waiting.
+         --  Force a read on the process if there is anything waiting
 
          Expect_Internal (Descriptors, Result,
                           Timeout => 0, Full_Buffer => False);
@@ -1047,7 +1129,7 @@ package body GNAT.Expect is
    is
    begin
       Kill (Descriptor.Pid, Signal);
-      --  ??? Need to check process status here.
+      --  ??? Need to check process status here
    end Send_Signal;
 
    ---------------------------------

gcc/ada/g-expect.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---           Copyright (C) 2000-2004 Ada Core Technologies, Inc.            --
+--           Copyright (C) 2000-2005 Ada Core Technologies, Inc.            --
 --                                                                          --
 -- 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- --
@@ -35,8 +35,9 @@
 --  for VMS. It is not yet implemented for any of the cross-ports (e.g. it
 --  is not available for VxWorks or LynxOS).
 
---  Usage
+--  -----------
---  =====
+--  -- Usage --
+--  -----------
 
 --  This package provides a set of subprograms similar to what is available
 --  with the standard Tcl Expect tool.
@@ -111,11 +112,14 @@
 --      Send (Fd, "command");
 --      Expect (Fd, Result, ".."); -- match only on the output of command
 
---  Task Safety
+--  -----------------
---  ===========
+--  -- Task Safety --
+--  -----------------
 
 --  This package is not task-safe: there should be not concurrent calls to
---  the functions defined in this package.
+--  the functions defined in this package. In other words, separate tasks
+--  may not access the facilities of this package without synchronization
+--  that serializes access.
 
 with System;
 with GNAT.OS_Lib;
@@ -195,7 +199,7 @@ package GNAT.Expect is
    procedure Send_Signal
      (Descriptor : Process_Descriptor;
       Signal     : Integer);
-   --  Send a given signal to the process.
+   --  Send a given signal to the process
 
    procedure Interrupt (Descriptor : in out Process_Descriptor);
    --  Interrupt the process (the equivalent of Ctrl-C on unix and windows)
@@ -204,22 +208,33 @@ package GNAT.Expect is
    function Get_Input_Fd
      (Descriptor : Process_Descriptor)
       return       GNAT.OS_Lib.File_Descriptor;
-   --  Return the input file descriptor associated with Descriptor.
+   --  Return the input file descriptor associated with Descriptor
 
    function Get_Output_Fd
      (Descriptor : Process_Descriptor)
       return       GNAT.OS_Lib.File_Descriptor;
-   --  Return the output file descriptor associated with Descriptor.
+   --  Return the output file descriptor associated with Descriptor
 
    function Get_Error_Fd
      (Descriptor : Process_Descriptor)
       return       GNAT.OS_Lib.File_Descriptor;
-   --  Return the error output file descriptor associated with Descriptor.
+   --  Return the error output file descriptor associated with Descriptor
 
    function Get_Pid
      (Descriptor : Process_Descriptor)
       return       Process_Id;
-   --  Return the process id assocated with a given process descriptor.
+   --  Return the process id assocated with a given process descriptor
+
+   function Get_Command_Output
+     (Command    : String;
+      Arguments  : GNAT.OS_Lib.Argument_List;
+      Input      : String;
+      Status     : access Integer;
+      Err_To_Out : Boolean := False) return String;
+   --  Execute Command with the specified Arguments and Input, and return the
+   --  generated standard output data as a single string. If Err_To_Out is
+   --  True, generated standard error output is included as well. On return,
+   --  Status is set to the command's exit status.
 
    --------------------
    -- Adding filters --
@@ -302,10 +317,10 @@ package GNAT.Expect is
 
    type Expect_Match is new Integer;
    Expect_Full_Buffer : constant Expect_Match := -1;
-   --  If the buffer was full and some characters were discarded.
+   --  If the buffer was full and some characters were discarded
 
    Expect_Timeout : constant Expect_Match := -2;
-   --  If not output matching the regexps was found before the timeout.
+   --  If not output matching the regexps was found before the timeout
 
    function "+" (S : String) return GNAT.OS_Lib.String_Access;
    --  Allocate some memory for the string. This is merely a convenience
@@ -380,7 +395,7 @@ package GNAT.Expect is
       Matched     : out GNAT.Regpat.Match_Array;
       Timeout     : Integer := 10000;
       Full_Buffer : Boolean := False);
-   --  Same as above, but with a precompiled regular expression.
+   --  Same as above, but with a precompiled regular expression
 
    -------------------------------------------------------------
    -- Working on the output (single process, multiple regexp) --
@@ -461,7 +476,7 @@ package GNAT.Expect is
       Matched     : out GNAT.Regpat.Match_Array;
       Timeout     : Integer := 10000;
       Full_Buffer : Boolean := False);
-   --  Same as above, but for multi processes.
+   --  Same as above, but for multi processes
 
    procedure Expect
      (Result      : out Expect_Match;
@@ -535,7 +550,7 @@ private
    type Pipe_Type is record
       Input, Output : GNAT.OS_Lib.File_Descriptor;
    end record;
-   --  This type represents a pipe, used to communicate between two processes.
+   --  This type represents a pipe, used to communicate between two processes
 
    procedure Set_Up_Communications
      (Pid        : in out Process_Descriptor;