Skip to content

R
riscv-gcc-1
Commit 1a79be3c by Thomas Quinot Committed by Arnaud Charlet
Options

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
parent fc64d83c
Showing with 201 additions and 21 deletions
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment