New Language: Ada

From-SVN: r45955

1 files changed, 589 insertions, 0 deletions

diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads
new file mode 100644
index 00000000000..5df3e73d43b
--- /dev/null
+++ b/gcc/ada/g-expect.ads
@@ -0,0 +1,589 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                          G N A T . E X P E C T                           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.8 $
+--                                                                          --
+--           Copyright (C) 2000-2001 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- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Currently this package is implemented on all native GNAT ports except
+--  for VMS. It is not yet implemented for any of the cross-ports (e.g. it
+--  is not available for VxWorks or LynxOS).
+--
+--  Usage
+--  =====
+--
+--  This package provides a set of subprograms similar to what is available
+--  with the standard Tcl Expect tool.
+
+--  It allows you to easily spawn and communicate with an external process.
+--  You can send commands or inputs to the process, and compare the output
+--  with some expected regular expression.
+--
+--  Usage example:
+--
+--      Non_Blocking_Spawn (Fd, "ftp machine@domaine");
+--      Timeout := 10000;  --  10 seconds
+--      Expect (Fd, Result, Regexp_Array'(+"\(user\)", +"\(passwd\)"),
+--              Timeout);
+--      case Result is
+--         when 1 => Send (Fd, "my_name");   --  matched "user"
+--         when 2 => Send (Fd, "my_passwd"); --  matched "passwd"
+--         when Expect_Timeout => null;      --  timeout
+--         when others => null;
+--      end case;
+--      Close (Fd);
+--
+--  You can also combine multiple regular expressions together, and get the
+--  specific string matching a parenthesis pair by doing something like. If you
+--  expect either "lang=optional ada" or "lang=ada" from the external process,
+--  you can group the two together, which is more efficient, and simply get the
+--  name of the language by doing:
+--
+--      declare
+--         Matched : Regexp_Array (0 .. 2);
+--      begin
+--         Expect (Fd, Result, "lang=(optional)? ([a-z]+)", Matched);
+--         Put_Line ("Seen: " &
+--                   Expect_Out (Fd) (Matched (2).First .. Matched (2).Last));
+--      end;
+--
+--  Alternatively, you might choose to use a lower-level interface to the
+--  processes, where you can give your own input and output filters every
+--  time characters are read from or written to the process.
+--
+--      procedure My_Filter (Descriptor : Process_Descriptor; Str : String) is
+--      begin
+--         Put_Line (Str);
+--      end;
+--
+--      Fd := Non_Blocking_Spawn ("tail -f a_file");
+--      Add_Filter (Fd, My_Filter'Access, Output);
+--      Expect (Fd, Result, "", 0);  --  wait forever
+--
+--  The above example should probably be run in a separate task, since it is
+--  blocking on the call to Expect.
+--
+--  Both examples can be combined, for instance to systematically print the
+--  output seen by expect, even though you still want to let Expect do the
+--  filtering. You can use the Trace_Filter subprogram for such a filter.
+--
+--  If you want to get the output of a simple command, and ignore any previous
+--  existing output, it is recommended to do something like:
+--
+--      Expect (Fd, Result, ".*", Timeout => 0);
+--            -- empty the buffer, by matching everything (after checking
+--            -- if there was any input).
+--      Send (Fd, "command");
+--      Expect (Fd, Result, ".."); -- match only on the output of command
+--
+--  Task Safety
+--  ===========
+--
+--  This package is not task-safe. However, you can easily make is task safe
+--  by encapsulating the type Process_Descriptor in a protected record.
+--  There should not be concurrent calls to Expect.
+
+with System;
+with GNAT.OS_Lib;
+with GNAT.Regpat;
+
+package GNAT.Expect is
+
+   type Process_Id is new Integer;
+   Invalid_Pid : constant Process_Id := -1;
+   Null_Pid    : constant Process_Id := 0;
+
+   type Filter_Type is (Output, Input, Died);
+   --  The signals that are emitted by the Process_Descriptor upon state
+   --  changed in the child. One can connect to any of this signal through
+   --  the Add_Filter subprograms.
+   --
+   --     Output => Every time new characters are read from the process
+   --               associated with Descriptor, the filter is called with
+   --               these new characters in argument.
+   --
+   --               Note that output is only generated when the program is
+   --               blocked in a call to Expect.
+   --
+   --     Input  => Every time new characters are written to the process
+   --               associated with Descriptor, the filter is called with
+   --               these new characters in argument.
+   --               Note that input is only generated by calls to Send.
+   --
+   --     Died   => The child process has died, or was explicitly killed
+
+   type Process_Descriptor is tagged private;
+   --  Contains all the components needed to describe a process handled
+   --  in this package, including a process identifier, file descriptors
+   --  associated with the standard input, output and error, and the buffer
+   --  needed to handle the expect calls.
+
+   type Process_Descriptor_Access is access Process_Descriptor'Class;
+
+   ------------------------
+   -- Spawning a process --
+   ------------------------
+
+   procedure Non_Blocking_Spawn
+     (Descriptor  : out Process_Descriptor'Class;
+      Command     : String;
+      Args        : GNAT.OS_Lib.Argument_List;
+      Buffer_Size : Natural := 4096;
+      Err_To_Out  : Boolean := False);
+   --  This call spawns a new process and allows sending commands to
+   --  the process and/or automatic parsing of the output.
+   --
+   --  The expect buffer associated with that process can contain at most
+   --  Buffer_Size characters. Older characters are simply discarded when
+   --  this buffer is full. Beware that if the buffer is too big, this could
+   --  slow down the Expect calls if not output is matched, since Expect has
+   --  to match all the regexp against all the characters in the buffer.
+   --  If Buffer_Size is 0, there is no limit (ie all the characters are kept
+   --  till Expect matches), but this is slower.
+   --
+   --  If Err_To_Out is True, then the standard error of the spawned process is
+   --  connected to the standard output. This is the only way to get the
+   --  Except subprograms also match on output on standard error.
+   --
+   --  Invalid_Process is raised if the process could not be spawned.
+
+   procedure Close (Descriptor : in out Process_Descriptor);
+   --  Terminate the process and close the pipes to it. It implicitly
+   --  does the 'wait' command required to clean up the process table.
+   --  This also frees the buffer associated with the process id.
+
+   procedure Send_Signal
+     (Descriptor : Process_Descriptor;
+      Signal     : Integer);
+   --  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)
+   --  and call close if the process dies.
+
+   function Get_Input_Fd
+     (Descriptor : Process_Descriptor)
+      return       GNAT.OS_Lib.File_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.
+
+   function Get_Error_Fd
+     (Descriptor : Process_Descriptor)
+      return       GNAT.OS_Lib.File_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.
+
+   --------------------
+   -- Adding filters --
+   --------------------
+
+   --  This is a rather low-level interface to subprocesses, since basically
+   --  the filtering is left entirely to the user. See the Expect subprograms
+   --  below for higher level functions.
+
+   type Filter_Function is access
+     procedure
+       (Descriptor : Process_Descriptor'Class;
+        Str        : String;
+        User_Data  : System.Address := System.Null_Address);
+   --  Function called every time new characters are read from or written
+   --  to the process.
+   --
+   --  Str is a string of all these characters.
+   --
+   --  User_Data, if specified, is a user specific data that will be passed to
+   --  the filter. Note that no checks are done on this parameter that should
+   --  be used with cautiousness.
+
+   procedure Add_Filter
+     (Descriptor : in out Process_Descriptor;
+      Filter     : Filter_Function;
+      Filter_On  : Filter_Type := Output;
+      User_Data  : System.Address := System.Null_Address;
+      After      : Boolean := False);
+   --  Add a new filter for one of the filter type. This filter will be
+   --  run before all the existing filters, unless After is set True,
+   --  in which case it will be run after existing filters. User_Data
+   --  is passed as is to the filter procedure.
+
+   procedure Remove_Filter
+     (Descriptor : in out Process_Descriptor;
+      Filter     : Filter_Function);
+   --  Remove a filter from the list of filters (whatever the type of the
+   --  filter).
+
+   procedure Trace_Filter
+     (Descriptor : Process_Descriptor'Class;
+      Str        : String;
+      User_Data  : System.Address := System.Null_Address);
+   --  Function that can be used a filter and that simply outputs Str on
+   --  Standard_Output. This is mainly used for debugging purposes.
+   --  User_Data is ignored.
+
+   procedure Lock_Filters (Descriptor : in out Process_Descriptor);
+   --  Temporarily disables all output and input filters. They will be
+   --  reactivated only when Unlock_Filters has been called as many times as
+   --  Lock_Filters;
+
+   procedure Unlock_Filters (Descriptor : in out Process_Descriptor);
+   --  Unlocks the filters. They are reactivated only if Unlock_Filters
+   --  has been called as many times as Lock_Filters.
+
+   ------------------
+   -- Sending data --
+   ------------------
+
+   procedure Send
+     (Descriptor   : in out Process_Descriptor;
+      Str          : String;
+      Add_LF       : Boolean := True;
+      Empty_Buffer : Boolean := False);
+   --  Send a string to the file descriptor.
+   --
+   --  The string is not formatted in any way, except if Add_LF is True,
+   --  in which case an ASCII.LF is added at the end, so that Str is
+   --  recognized as a command by the external process.
+   --
+   --  If Empty_Buffer is True, any input waiting from the process (or in the
+   --  buffer) is first discarded before the command is sent. The output
+   --  filters are of course called as usual.
+
+   -----------------------------------------------------------
+   -- Working on the output (single process, simple regexp) --
+   -----------------------------------------------------------
+
+   type Expect_Match is new Integer;
+   Expect_Full_Buffer : constant Expect_Match := -1;
+   --  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.
+
+   function "+" (S : String) return GNAT.OS_Lib.String_Access;
+   --  Allocate some memory for the string. This is merely a convenience
+   --  convenience function to help create the array of regexps in the
+   --  call to Expect.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexp      : String;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Wait till a string matching Fd can be read from Fd, and return 1
+   --  if a match was found.
+   --
+   --  It consumes all the characters read from Fd until a match found, and
+   --  then sets the return values for the subprograms Expect_Out and
+   --  Expect_Out_Match.
+   --
+   --  The empty string "" will never match, and can be used if you only want
+   --  to match after a specific timeout. Beware that if Timeout is -1 at the
+   --  time, the current task will be blocked forever.
+   --
+   --  This command times out after Timeout milliseconds (or never if Timeout
+   --  is -1). In that case, Expect_Timeout is returned. The value returned by
+   --  Expect_Out and Expect_Out_Match are meaningless in that case.
+   --
+   --  Note that using a timeout of 0ms leads to unpredictable behavior, since
+   --  the result depends on whether the process has already sent some output
+   --  the first time Expect checks, and this depends on the operating system.
+   --
+   --  The regular expression must obey the syntax described in GNAT.Regpat.
+   --
+   --  If Full_Buffer is True, then Expect will match if the buffer was too
+   --  small and some characters were about to be discarded. In that case,
+   --  Expect_Full_Buffer is returned.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexp      : GNAT.Regpat.Pattern_Matcher;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as the previous one, but with a precompiled regular expression.
+   --  This is more efficient however, especially if you are using this
+   --  expression multiple times, since this package won't need to recompile
+   --  the regexp every time.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexp      : String;
+      Matched     : out GNAT.Regpat.Match_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as above, but it is now possible to get the indexes of the
+   --  substrings for the parentheses in the regexp (see the example at the
+   --  top of this package, as well as the documentation in the package
+   --  GNAT.Regpat).
+   --
+   --  Matched'First should be 0, and this index will contain the indexes for
+   --  the whole string that was matched. The index 1 will contain the indexes
+   --  for the first parentheses-pair, and so on.
+
+   ------------
+   -- Expect --
+   ------------
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexp      : GNAT.Regpat.Pattern_Matcher;
+      Matched     : out GNAT.Regpat.Match_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as above, but with a precompiled regular expression.
+
+   -------------------------------------------------------------
+   -- Working on the output (single process, multiple regexp) --
+   -------------------------------------------------------------
+
+   type Regexp_Array is array (Positive range <>) of GNAT.OS_Lib.String_Access;
+
+   type Pattern_Matcher_Access is access GNAT.Regpat.Pattern_Matcher;
+   type Compiled_Regexp_Array is array (Positive range <>)
+     of Pattern_Matcher_Access;
+
+   function "+"
+     (P    : GNAT.Regpat.Pattern_Matcher)
+      return Pattern_Matcher_Access;
+   --  Allocate some memory for the pattern matcher.
+   --  This is only a convenience function to help create the array of
+   --  compiled regular expressoins.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexps     : Regexp_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Wait till a string matching one of the regular expressions in Regexps
+   --  is found. This function returns the index of the regexp that matched.
+   --  This command is blocking, but will timeout after Timeout milliseconds.
+   --  In that case, Timeout is returned.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexps     : Compiled_Regexp_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as the previous one, but with precompiled regular expressions.
+   --  This can be much faster if you are using them multiple times.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexps     : Regexp_Array;
+      Matched     : out GNAT.Regpat.Match_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as above, except that you can also access the parenthesis
+   --  groups inside the matching regular expression.
+   --  The first index in Matched must be 0, or Constraint_Error will be
+   --  raised. The index 0 contains the indexes for the whole string that was
+   --  matched, the index 1 contains the indexes for the first parentheses
+   --  pair, and so on.
+
+   procedure Expect
+     (Descriptor  : in out Process_Descriptor;
+      Result      : out Expect_Match;
+      Regexps     : Compiled_Regexp_Array;
+      Matched     : out GNAT.Regpat.Match_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as above, but with precompiled regular expressions.
+   --  The first index in Matched must be 0, or Constraint_Error will be
+   --  raised.
+
+   -------------------------------------------
+   -- Working on the output (multi-process) --
+   -------------------------------------------
+
+   type Multiprocess_Regexp is record
+      Descriptor : Process_Descriptor_Access;
+      Regexp     : Pattern_Matcher_Access;
+   end record;
+   type Multiprocess_Regexp_Array is array (Positive range <>)
+     of Multiprocess_Regexp;
+
+   procedure Expect
+     (Result      : out Expect_Match;
+      Regexps     : Multiprocess_Regexp_Array;
+      Matched     : out GNAT.Regpat.Match_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as above, but for multi processes.
+
+   procedure Expect
+     (Result      : out Expect_Match;
+      Regexps     : Multiprocess_Regexp_Array;
+      Timeout     : Integer := 10000;
+      Full_Buffer : Boolean := False);
+   --  Same as the previous one, but for multiple processes.
+   --  This procedure finds the first regexp that match the associated process.
+
+   ------------------------
+   -- Getting the output --
+   ------------------------
+
+   procedure Flush
+     (Descriptor : in out Process_Descriptor;
+      Timeout    : Integer := 0);
+   --  Discard all output waiting from the process.
+   --
+   --  This output is simply discarded, and no filter is called. This output
+   --  will also not be visible by the next call to Expect, nor will any
+   --  output currently buffered.
+   --
+   --  Timeout is the delay for which we wait for output to be available from
+   --  the process. If 0, we only get what is immediately available.
+
+   function Expect_Out (Descriptor : Process_Descriptor) return String;
+   --  Return the string matched by the last Expect call.
+   --
+   --  The returned string is in fact the concatenation of all the strings
+   --  read from the file descriptor up to, and including, the characters
+   --  that matched the regular expression.
+   --
+   --  For instance, with an input "philosophic", and a regular expression
+   --  "hi" in the call to expect, the strings returned the first and second
+   --  time would be respectively "phi" and "losophi".
+
+   function Expect_Out_Match (Descriptor : Process_Descriptor) return String;
+   --  Return the string matched by the last Expect call.
+   --
+   --  The returned string includes only the character that matched the
+   --  specific regular expression. All the characters that came before are
+   --  simply discarded.
+   --
+   --  For instance, with an input "philosophic", and a regular expression
+   --  "hi" in the call to expect, the strings returned the first and second
+   --  time would both be "hi".
+
+   ----------------
+   -- Exceptions --
+   ----------------
+
+   Invalid_Process : exception;
+   --  Raised by most subprograms above when the parameter Descriptor is not a
+   --  valid process or is a closed process.
+
+   Process_Died : exception;
+   --  Raised by all the expect subprograms if Descriptor was originally a
+   --  valid process that died while Expect was executing. It is also raised
+   --  when Expect receives an end-of-file.
+
+   ------------------------
+   -- Internal functions --
+   ------------------------
+
+   --  The following subprograms are provided so that it is easy to write
+   --  extensions to this package. However, clients should not use these
+   --  routines directly.
+
+   procedure Portable_Execvp (Cmd : String; Args : System.Address);
+   --  Executes, in a portable way, the command Cmd (full path must be
+   --  specified), with the given Args. Note that the first element in Args
+   --  must be the executable name, and the last element must be a null
+   --  pointer
+
+private
+   type Filter_List_Elem;
+   type Filter_List is access Filter_List_Elem;
+   type Filter_List_Elem is record
+      Filter    : Filter_Function;
+      User_Data : System.Address;
+      Filter_On : Filter_Type;
+      Next      : Filter_List;
+   end record;
+
+   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.
+
+   procedure Set_Up_Communications
+     (Pid        : in out Process_Descriptor;
+      Err_To_Out : Boolean;
+      Pipe1      : access Pipe_Type;
+      Pipe2      : access Pipe_Type;
+      Pipe3      : access Pipe_Type);
+   --  Set up all the communication pipes and file descriptors prior to
+   --  spawning the child process.
+
+   procedure Set_Up_Parent_Communications
+     (Pid   : in out Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type);
+   --  Finish the set up of the pipes while in the parent process
+
+   procedure Set_Up_Child_Communications
+     (Pid   : in out Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type;
+      Cmd   : String;
+      Args  : System.Address);
+   --  Finish the set up of the pipes while in the child process
+   --  This also spawns the child process (based on Cmd).
+   --  On systems that support fork, this procedure is executed inside the
+   --  newly created process.
+
+   type Process_Descriptor is tagged record
+      Pid              : Process_Id := Invalid_Pid;
+      Input_Fd         : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
+      Output_Fd        : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
+      Error_Fd         : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
+      Filters_Lock     : Integer := 0;
+
+      Filters          : Filter_List := null;
+
+      Buffer           : GNAT.OS_Lib.String_Access := null;
+      Buffer_Size      : Natural := 0;
+      Buffer_Index     : Natural := 0;
+
+      Last_Match_Start : Natural := 0;
+      Last_Match_End   : Natural := 0;
+   end record;
+
+   pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp");
+
+end GNAT.Expect;