URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-dev/] [fsf-gcc-snapshot-1-mar-12/] [or1k-gcc/] [gcc/] [ada/] [g-expect.ads] - Rev 783
Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT LIBRARY COMPONENTS -- -- -- -- G N A T . E X P E C T -- -- -- -- S p e c -- -- -- -- Copyright (C) 2000-2010, 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- -- -- ware Foundation; either version 3, 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. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- <http://www.gnu.org/licenses/>. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- 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", -- (1 => new String' ("machine@domain"))); -- Timeout := 10_000; -- 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 this: -- 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 : Match_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'Class; -- Str : String; -- User_Data : System.Address) -- is -- begin -- Put_Line (Str); -- end; -- Non_Blocking_Spawn -- (Fd, "tail", -- (new String' ("-f"), new String' ("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: there should not be concurrent calls to the -- functions defined in this package. In other words, separate tasks must not -- access the facilities of this package without synchronization that -- serializes access. 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 change -- in the child. One can connect to any of these signals 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 the argument. -- -- Note that output is generated only 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 the argument. -- Note that input is generated only 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 the output not 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 (i.e. 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 to also match on output on standard error. -- -- Invalid_Process is raised if the process could not be spawned. -- -- For information about spawning processes from tasking programs, see the -- "NOTE: Spawn in tasking programs" in System.OS_Lib (s-os_lib.ads). 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. Raise Invalid_Process if the -- process id is invalid. procedure Close (Descriptor : in out Process_Descriptor; Status : out Integer); -- Same as above, but also returns the exit status of the process, as set -- for example by the procedure GNAT.OS_Lib.OS_Exit. procedure Send_Signal (Descriptor : Process_Descriptor; Signal : Integer); -- Send a given signal to the process. Raise Invalid_Process if the process -- id is invalid. 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 associated with a given process descriptor function Get_Command_Output (Command : String; Arguments : GNAT.OS_Lib.Argument_List; Input : String; Status : not null 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 -- -------------------- -- 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 user specific data that will be passed to -- the filter. Note that no checks are done on this parameter, so it should -- be used with caution. 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 types. 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 as 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 no 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 -- 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 := 10_000; 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 := 10_000; 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 := 10_000; 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 := 10_000; 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 all 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 expressions. procedure Expect (Descriptor : in out Process_Descriptor; Result : out Expect_Match; Regexps : Regexp_Array; Timeout : Integer := 10_000; 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 := 10_000; 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 := 10_000; 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 := 10_000; 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 Free (Regexp : in out Multiprocess_Regexp); -- Free the memory occupied by Regexp function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean; -- Return True if at least one entry in Regexp is non-null, ie there is -- still at least one process to monitor function First_Dead_Process (Regexp : Multiprocess_Regexp_Array) return Natural; -- Find the first entry in Regexp that corresponds to a dead process that -- wasn't Free-d yet. This function is called in general when Expect -- (below) raises the exception Process_Died. This returns 0 if no process -- has died yet. procedure Expect (Result : out Expect_Match; Regexps : Multiprocess_Regexp_Array; Matched : out GNAT.Regpat.Match_Array; Timeout : Integer := 10_000; Full_Buffer : Boolean := False); -- Same as above, but for multi processes. Any of the entries in -- Regexps can have a null Descriptor or Regexp. Such entries will -- simply be ignored. Therefore when a process terminates, you can -- simply reset its entry. -- -- The expect loop would therefore look like: -- -- Processes : Multiprocess_Regexp_Array (...) := ...; -- R : Natural; -- -- while Has_Process (Processes) loop -- begin -- Expect (Result, Processes, Timeout => -1); -- ... process output of process Result (output, full buffer,...) -- -- exception -- when Process_Died => -- -- Free memory -- R := First_Dead_Process (Processes); -- Close (Processes (R).Descriptor.all, Status); -- Free (Processes (R)); -- end; -- end loop; procedure Expect (Result : out Expect_Match; Regexps : Multiprocess_Regexp_Array; Timeout : Integer := 10_000; 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. 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 : not null access Pipe_Type; Pipe2 : not null access Pipe_Type; Pipe3 : not null 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 : aliased 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; -- The following subprogram is provided for use in the body, and also -- possibly in future child units providing extensions to this package. procedure Portable_Execvp (Pid : not null access Process_Id; Cmd : String; Args : System.Address); pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp"); -- Executes, in a portable way, the command Cmd (full path must be -- specified), with the given Args, which must be an array of string -- pointers. Note that the first element in Args must be the executable -- name, and the last element must be a null pointer. The returned value -- in Pid is the process ID, or zero if not supported on the platform. end GNAT.Expect;