X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fg-expect.adb;h=fb9d296e513d8fc2163f97dfbdad7f54229fe759;hb=4961db87b110ff3c1ceb8f3b3152146c58d71e78;hp=2571a440d652cf83432ca651c53777c46cb983d2;hpb=6d9c34431eee95df76a218c14f690c5ed75b76db;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 2571a440d65..fb9d296e513 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2005 Ada Core Technologies, Inc. -- +-- Copyright (C) 2000-2007, 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- -- @@ -16,8 +16,8 @@ -- 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. -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, 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, -- @@ -31,14 +31,14 @@ -- -- ------------------------------------------------------------------------------ -with System; use System; -with Ada.Calendar; use Ada.Calendar; +with System; use System; +with Ada.Calendar; use Ada.Calendar; with GNAT.IO; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Regpat; use GNAT.Regpat; +with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Regpat; use GNAT.Regpat; -with Unchecked_Deallocation; +with Ada.Unchecked_Deallocation; package body GNAT.Expect is @@ -66,9 +66,12 @@ package body GNAT.Expect is -- Reinitialize the internal buffer. -- The buffer is deleted up to the end of the last match. - procedure Free is new Unchecked_Deallocation + procedure Free is new Ada.Unchecked_Deallocation (Pattern_Matcher, Pattern_Matcher_Access); + procedure Free is new Ada.Unchecked_Deallocation + (Filter_List_Elem, Filter_List); + procedure Call_Filters (Pid : Process_Descriptor'Class; Str : String; @@ -86,18 +89,18 @@ package body GNAT.Expect is procedure Dup2 (Old_Fd, New_Fd : File_Descriptor); pragma Import (C, Dup2); - procedure Kill (Pid : Process_Id; Sig_Num : Integer); + procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); pragma Import (C, Kill, "__gnat_kill"); + -- if Close is set to 1 all OS resources used by the Pid must be freed - function Create_Pipe (Pipe : access Pipe_Type) return Integer; + function Create_Pipe (Pipe : not null access Pipe_Type) return Integer; pragma Import (C, Create_Pipe, "__gnat_pipe"); function Poll (Fds : System.Address; Num_Fds : Integer; Timeout : Integer; - Is_Set : System.Address) - return Integer; + Is_Set : System.Address) return Integer; pragma Import (C, Poll, "__gnat_expect_poll"); -- Check whether there is any data waiting on the file descriptor -- Out_fd, and wait if there is none, at most Timeout milliseconds @@ -108,7 +111,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 --------- -- "+" -- @@ -124,8 +127,7 @@ package body GNAT.Expect is --------- function "+" - (P : GNAT.Regpat.Pattern_Matcher) - return Pattern_Matcher_Access + (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access is begin return new GNAT.Regpat.Pattern_Matcher'(P); @@ -204,6 +206,9 @@ package body GNAT.Expect is (Descriptor : in out Process_Descriptor; Status : out Integer) is + Current_Filter : Filter_List; + Next_Filter : Filter_List; + begin Close (Descriptor.Input_Fd); @@ -214,12 +219,31 @@ package body GNAT.Expect is Close (Descriptor.Output_Fd); -- ??? Should have timeouts for different signals - Kill (Descriptor.Pid, 9); + + if Descriptor.Pid > 0 then -- see comment in Send_Signal + Kill (Descriptor.Pid, Sig_Num => 9, Close => 0); + end if; GNAT.OS_Lib.Free (Descriptor.Buffer); Descriptor.Buffer_Size := 0; - Status := Waitpid (Descriptor.Pid); + Current_Filter := Descriptor.Filters; + + while Current_Filter /= null loop + Next_Filter := Current_Filter.Next; + Free (Current_Filter); + Current_Filter := Next_Filter; + end loop; + + Descriptor.Filters := null; + + -- Check process id (see comment in Send_Signal) + + if Descriptor.Pid > 0 then + Status := Waitpid (Descriptor.Pid); + else + raise Invalid_Process; + end if; end Close; procedure Close (Descriptor : in out Process_Descriptor) is @@ -323,10 +347,11 @@ package body GNAT.Expect is return; end if; - -- Calculate the timeout for the next turn. + -- Calculate the timeout for the next turn + -- Note that Timeout is, from the caller's perspective, the maximum -- time until a match, not the maximum time until some output is - -- read, and thus can not be reused as is for Expect_Internal. + -- read, and thus cannot be reused as is for Expect_Internal. if Timeout /= -1 then Timeout_Tmp := Integer (Try_Until - Clock) * 1000; @@ -656,7 +681,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,16 +779,98 @@ 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 : not null 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. Note here that we add + -- S'Length to ensure that S will fit in the new buffer size. + + if Last + S'Length > Output'Last then + NOutput := new String (1 .. 2 * Output'Last + S'Length); + 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 -- ------------------ function Get_Error_Fd - (Descriptor : Process_Descriptor) - return GNAT.OS_Lib.File_Descriptor + (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is begin return Descriptor.Error_Fd; @@ -774,8 +881,7 @@ package body GNAT.Expect is ------------------ function Get_Input_Fd - (Descriptor : Process_Descriptor) - return GNAT.OS_Lib.File_Descriptor + (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is begin return Descriptor.Input_Fd; @@ -786,8 +892,7 @@ package body GNAT.Expect is ------------------- function Get_Output_Fd - (Descriptor : Process_Descriptor) - return GNAT.OS_Lib.File_Descriptor + (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is begin return Descriptor.Output_Fd; @@ -798,8 +903,7 @@ package body GNAT.Expect is ------------- function Get_Pid - (Descriptor : Process_Descriptor) - return Process_Id + (Descriptor : Process_Descriptor) return Process_Id is begin return Descriptor.Pid; @@ -811,7 +915,6 @@ package body GNAT.Expect is procedure Interrupt (Descriptor : in out Process_Descriptor) is SIGINT : constant := 2; - begin Send_Signal (Descriptor, SIGINT); end Interrupt; @@ -847,7 +950,7 @@ package body GNAT.Expect is Arg : String_Access; Arg_List : String_List (1 .. Args'Length + 2); - C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address; + C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address; Command_With_Path : String_Access; @@ -880,9 +983,9 @@ package body GNAT.Expect is for J in Args'Range loop Arg := new String (1 .. Args (J)'Length + 1); - Arg (1 .. Args (J)'Length) := Args (J).all; - Arg (Arg'Last) := ASCII.NUL; - Arg_List (J + 2 - Args'First) := Arg.all'Access; + Arg (1 .. Args (J)'Length) := Args (J).all; + Arg (Arg'Last) := ASCII.NUL; + Arg_List (J + 2 - Args'First) := Arg.all'Access; end loop; Arg_List (Arg_List'Last) := null; @@ -927,6 +1030,10 @@ package body GNAT.Expect is if Buffer_Size /= 0 then Descriptor.Buffer := new String (1 .. Positive (Buffer_Size)); end if; + + -- Initialize the filters + + Descriptor.Filters := null; end Non_Blocking_Spawn; ------------------------- @@ -1004,26 +1111,25 @@ package body GNAT.Expect is ---------- procedure Send - (Descriptor : in out Process_Descriptor; - Str : String; - Add_LF : Boolean := True; + (Descriptor : in out Process_Descriptor; + Str : String; + Add_LF : Boolean := True; Empty_Buffer : Boolean := False) is - Full_Str : constant String := Str & ASCII.LF; - Last : Natural; + Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF); Result : Expect_Match; Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access); - Dummy : Natural; - pragma Unreferenced (Dummy); + Discard : Natural; + pragma Warnings (Off, Discard); 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); + Expect_Internal + (Descriptors, Result, Timeout => 0, Full_Buffer => False); Descriptor.Last_Match_End := Descriptor.Buffer_Index; -- Empty the buffer @@ -1031,18 +1137,15 @@ package body GNAT.Expect is Reinitialize_Buffer (Descriptor); end if; + Call_Filters (Descriptor, Str, Input); + Discard := + Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1); + if Add_LF then - Last := Full_Str'Last; - else - Last := Full_Str'Last - 1; + Call_Filters (Descriptor, Line_Feed, Input); + Discard := + Write (Descriptor.Input_Fd, Line_Feed'Address, 1); end if; - - Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input); - - Dummy := - Write (Descriptor.Input_Fd, - Full_Str'Address, - Last - Full_Str'First + 1); end Send; ----------------- @@ -1054,8 +1157,19 @@ package body GNAT.Expect is Signal : Integer) is begin - Kill (Descriptor.Pid, Signal); - -- ??? Need to check process status here. + -- A nonpositive process id passed to kill has special meanings. For + -- example, -1 means kill all processes in sight, including self, in + -- POSIX and Windows (and something slightly different in Linux). See + -- man pages for details. In any case, we don't want to do that. Note + -- that Descriptor.Pid will be -1 if the process was not successfully + -- started; we don't want to kill ourself in that case. + + if Descriptor.Pid > 0 then + Kill (Descriptor.Pid, Signal, Close => 1); + -- ??? Need to check process status here + else + raise Invalid_Process; + end if; end Send_Signal; --------------------------------- @@ -1067,8 +1181,8 @@ package body GNAT.Expect is Pipe1 : in out Pipe_Type; Pipe2 : in out Pipe_Type; Pipe3 : in out Pipe_Type; - Cmd : in String; - Args : in System.Address) + Cmd : String; + Args : System.Address) is pragma Warnings (Off, Pid); @@ -1119,9 +1233,9 @@ package body GNAT.Expect is 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) + Pipe1 : not null access Pipe_Type; + Pipe2 : not null access Pipe_Type; + Pipe3 : not null access Pipe_Type) is Status : Boolean; @@ -1161,8 +1275,7 @@ package body GNAT.Expect is end if; end if; - -- As above, we record the proper fd for the child's - -- standard error stream. + -- As above, record the proper fd for the child's standard error stream Pid.Error_Fd := Pipe3.Input; Set_Close_On_Exec (Pipe3.Input, True, Status); @@ -1179,7 +1292,6 @@ package body GNAT.Expect is Pipe3 : in out Pipe_Type) is pragma Warnings (Off, Pid); - begin Close (Pipe1.Input); Close (Pipe2.Output); @@ -1197,7 +1309,6 @@ package body GNAT.Expect is is pragma Warnings (Off, Descriptor); pragma Warnings (Off, User_Data); - begin GNAT.IO.Put (Str); end Trace_Filter;