[multiple changes]

2010-06-21  Robert Dewar  <dewar@adacore.com>

	* g-expect.ads, g-expect.adb: Minor reformatting.

2010-06-21  Emmanuel Briot  <briot@adacore.com>

	* s-regpat.adb (Next_Pointer_Bytes): New named constant. Code clean up.

From-SVN: r161083
This commit is contained in:
Arnaud Charlet 2010-06-21 16:23:35 +02:00
parent 04617fd269
commit f27e042c9e
4 changed files with 83 additions and 66 deletions

View File

@ -1,3 +1,11 @@
2010-06-21 Robert Dewar <dewar@adacore.com>
* g-expect.ads, g-expect.adb: Minor reformatting.
2010-06-21 Emmanuel Briot <briot@adacore.com>
* s-regpat.adb (Next_Pointer_Bytes): New named constant. Code clean up.
2010-06-21 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies.

View File

@ -539,6 +539,7 @@ package body GNAT.Expect is
for J in Descriptors'Range loop
Descriptors (J) := Regexps (J).Descriptor;
if Descriptors (J) /= null then
Reinitialize_Buffer (Regexps (J).Descriptor.all);
end if;

View File

@ -180,16 +180,16 @@ package GNAT.Expect is
-- 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.
-- 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.
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.
-- 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;
@ -247,8 +247,8 @@ package GNAT.Expect is
(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.
-- Function called every time new characters are read from or written to
-- the process.
--
-- Str is a string of all these characters.
--
@ -301,9 +301,9 @@ package GNAT.Expect is
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.
-- 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
@ -330,8 +330,8 @@ package GNAT.Expect is
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.
-- 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
@ -402,15 +402,13 @@ package GNAT.Expect is
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;
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.
(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;
@ -441,6 +439,7 @@ package GNAT.Expect is
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
@ -453,9 +452,8 @@ package GNAT.Expect is
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.
-- 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) --
@ -465,8 +463,9 @@ package GNAT.Expect is
Descriptor : Process_Descriptor_Access;
Regexp : Pattern_Matcher_Access;
end record;
type Multiprocess_Regexp_Array is array (Positive range <>)
of Multiprocess_Regexp;
type Multiprocess_Regexp_Array is
array (Positive range <>) of Multiprocess_Regexp;
procedure Free (Regexp : in out Multiprocess_Regexp);
-- Free the memory occupied by Regexp
@ -478,10 +477,9 @@ package GNAT.Expect is
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.
-- 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;
@ -493,6 +491,7 @@ package GNAT.Expect is
-- 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 (...) := ...;
@ -517,8 +516,8 @@ package GNAT.Expect is
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.
-- Same as the previous one, but for multiple processes. This procedure
-- finds the first regexp that match the associated process.
------------------------
-- Getting the output --
@ -530,8 +529,8 @@ package GNAT.Expect is
-- 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.
-- 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.
@ -539,13 +538,13 @@ package GNAT.Expect is
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.
-- 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".
-- 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.
@ -609,10 +608,9 @@ private
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.
-- 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;
@ -640,7 +638,7 @@ private
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. Args must be an array of string
-- 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.

View File

@ -182,6 +182,12 @@ package body System.Regpat is
-- Using two bytes for the "next" pointer is vast overkill for most
-- things, but allows patterns to get big without disasters.
Next_Pointer_Bytes : constant := 3;
-- Points after the "next pointer" data. An instruction is therefore:
-- 1 byte: instruction opcode
-- 2 bytes: pointer to next instruction
-- * bytes: optional data for the instruction
-----------------------
-- Character classes --
-----------------------
@ -347,7 +353,7 @@ package body System.Regpat is
(Program_Data, Character_Class);
begin
Op (0 .. 31) := Convert (Program (P + 3 .. P + 34));
Op (0 .. 31) := Convert (Program (P + Next_Pointer_Bytes .. P + 34));
end Bitmap_Operand;
-------------
@ -582,7 +588,7 @@ package body System.Regpat is
Program (Emit_Ptr + 2) := ASCII.NUL;
end if;
Emit_Ptr := Emit_Ptr + 3;
Emit_Ptr := Emit_Ptr + Next_Pointer_Bytes;
return Result;
end Emit_Node;
@ -660,8 +666,8 @@ package body System.Regpat is
Old : Pointer;
begin
Old := Insert_Operator_Before (Op, Operand, Greedy, Opsize => 7);
Emit_Natural (Old + 3, Min);
Emit_Natural (Old + 5, Max);
Emit_Natural (Old + Next_Pointer_Bytes, Min);
Emit_Natural (Old + Next_Pointer_Bytes + 2, Max);
end Insert_Curly_Operator;
----------------------------
@ -682,7 +688,7 @@ package body System.Regpat is
-- If not greedy, we have to emit another opcode first
if not Greedy then
Size := Size + 3;
Size := Size + Next_Pointer_Bytes;
end if;
-- Move the operand in the byte-compilation, so that we can insert
@ -700,7 +706,7 @@ package body System.Regpat is
if not Greedy then
Old := Emit_Node (MINMOD);
Link_Tail (Old, Old + 3);
Link_Tail (Old, Old + Next_Pointer_Bytes);
end if;
Old := Emit_Node (Op);
@ -720,7 +726,8 @@ package body System.Regpat is
Discard : Pointer;
pragma Warnings (Off, Discard);
begin
Discard := Insert_Operator_Before (Op, Operand, Greedy, Opsize => 3);
Discard := Insert_Operator_Before
(Op, Operand, Greedy, Opsize => Next_Pointer_Bytes);
end Insert_Operator;
-----------------------
@ -803,10 +810,10 @@ package body System.Regpat is
begin
-- Find last node (the size of the pattern matcher might be too
-- small, so don't try to read past its end)
-- small, so don't try to read past its end).
Scan := P;
while Scan + 3 <= PM.Size loop
while Scan + Next_Pointer_Bytes <= PM.Size loop
Temp := Get_Next (Program, Scan);
exit when Temp = Scan;
Scan := Temp;
@ -1618,7 +1625,7 @@ package body System.Regpat is
-- is an initial string to emit, do it now.
if Has_Special_Operator
and then Emit_Ptr >= Length_Ptr + 3
and then Emit_Ptr >= Length_Ptr + Next_Pointer_Bytes
then
Emit_Ptr := Emit_Ptr - 1;
Parse_Pos := Start_Pos;
@ -2105,7 +2112,8 @@ package body System.Regpat is
if Op = OPEN or else Op = CLOSE or else Op = REFF then
Put (Image (Natural'Image
(Character'Pos (Program (Index + 3)))));
(Character'Pos
(Program (Index + Next_Pointer_Bytes)))));
end if;
if Next = Index then
@ -2165,7 +2173,7 @@ package body System.Regpat is
Put_Line ("]");
end if;
Index := Index + 3 + Bitmap'Length;
Index := Index + Next_Pointer_Bytes + Bitmap'Length;
end;
when EXACT | EXACTF =>
@ -2188,7 +2196,7 @@ package body System.Regpat is
New_Line;
end if;
Index := Index + 3;
Index := Index + Next_Pointer_Bytes;
Dump_Until (Program, Index, Pointer'Min (Next, Till),
Local_Indent + 1, Do_Print);
@ -2196,7 +2204,8 @@ package body System.Regpat is
if Do_Print then
Put_Line
(" {"
& Image (Natural'Image (Read_Natural (Program, Index + 3)))
& Image (Natural'Image
(Read_Natural (Program, Index + Next_Pointer_Bytes)))
& ","
& Image (Natural'Image (Read_Natural (Program, Index + 5)))
& "}");
@ -2226,7 +2235,7 @@ package body System.Regpat is
end if;
when others =>
Index := Index + 3;
Index := Index + Next_Pointer_Bytes;
if Do_Print then
New_Line;
@ -2794,9 +2803,10 @@ package body System.Regpat is
declare
Min : constant Natural :=
Read_Natural (Program, Scan + 3);
Read_Natural (Program, Scan + Next_Pointer_Bytes);
Max : constant Natural :=
Read_Natural (Program, Scan + 5);
Read_Natural
(Program, Scan + Next_Pointer_Bytes + 2);
Cc : aliased Current_Curly_Record;
Has_Match : Boolean;
@ -2814,7 +2824,7 @@ package body System.Regpat is
Greedy := True;
Current_Curly := Cc'Unchecked_Access;
Has_Match := Match (Next - 3);
Has_Match := Match (Next - Next_Pointer_Bytes);
-- Start on the WHILEM
@ -2896,8 +2906,8 @@ package body System.Regpat is
Operand_Code := Operand (Scan);
when others =>
Min := Read_Natural (Program, Scan + 3);
Max := Read_Natural (Program, Scan + 5);
Min := Read_Natural (Program, Scan + Next_Pointer_Bytes);
Max := Read_Natural (Program, Scan + Next_Pointer_Bytes + 2);
Operand_Code := Scan + 7;
end case;
@ -3573,7 +3583,7 @@ package body System.Regpat is
function Operand (P : Pointer) return Pointer is
begin
return P + 3;
return P + Next_Pointer_Bytes;
end Operand;
--------------
@ -3690,7 +3700,7 @@ package body System.Regpat is
is
begin
pragma Assert (Program (P) = EXACT or else Program (P) = EXACTF);
return Character'Pos (Program (P + 3));
return Character'Pos (Program (P + Next_Pointer_Bytes));
end String_Length;
--------------------