diff options
| -rw-r--r-- | gcc/ada/g-expect-vms.adb | 83 | ||||
| -rw-r--r-- | gcc/ada/g-expect.adb | 92 | ||||
| -rw-r--r-- | gcc/ada/g-expect.ads | 47 |
3 files changed, 201 insertions, 21 deletions
diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb index ff09173..cbf8c72 100644 --- a/gcc/ada/g-expect-vms.adb +++ b/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 -- ------------------ diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 9c148cc..6f0f7cf 100644 --- a/gcc/ada/g-expect.adb +++ b/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; --------------------------------- diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads index c5de0f9..2a82e4d 100644 --- a/gcc/ada/g-expect.ads +++ b/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; |