OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
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> 2010-06-21 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.

1
gcc/ada/g-expect.adb
View File

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

86
gcc/ada/g-expect.ads
View File

@ -180,16 +180,16 @@ package GNAT.Expect is
-- till Expect matches), but this is slower. -- till Expect matches), but this is slower.
-- --
-- If Err_To_Out is True, then the standard error of the spawned process is -- 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 -- connected to the standard output. This is the only way to get the Except
-- Except subprograms to also match on output on standard error. -- subprograms to also match on output on standard error.
-- --
-- Invalid_Process is raised if the process could not be spawned. -- Invalid_Process is raised if the process could not be spawned.
procedure Close (Descriptor : in out Process_Descriptor); procedure Close (Descriptor : in out Process_Descriptor);
-- Terminate the process and close the pipes to it. It implicitly -- Terminate the process and close the pipes to it. It implicitly does the
-- does the 'wait' command required to clean up the process table. -- 'wait' command required to clean up the process table. This also frees
-- This also frees the buffer associated with the process id. Raise -- the buffer associated with the process id. Raise Invalid_Process if the
-- Invalid_Process if the process id is invalid. -- process id is invalid.
procedure Close procedure Close
(Descriptor : in out Process_Descriptor; (Descriptor : in out Process_Descriptor;
@ -247,8 +247,8 @@ package GNAT.Expect is
(Descriptor : Process_Descriptor'Class; (Descriptor : Process_Descriptor'Class;
Str : String; Str : String;
User_Data : System.Address := System.Null_Address); User_Data : System.Address := System.Null_Address);
-- Function called every time new characters are read from or written -- Function called every time new characters are read from or written to
-- to the process. -- the process.
-- --
-- Str is a string of all these characters. -- Str is a string of all these characters.
-- --
@ -301,9 +301,9 @@ package GNAT.Expect is
Empty_Buffer : Boolean := False); Empty_Buffer : Boolean := False);
-- Send a string to the file descriptor. -- Send a string to the file descriptor.
-- --
-- The string is not formatted in any way, except if Add_LF is True, -- The string is not formatted in any way, except if Add_LF is True, in
-- in which case an ASCII.LF is added at the end, so that Str is -- which case an ASCII.LF is added at the end, so that Str is recognized
-- recognized as a command by the external process. -- as a command by the external process.
-- --
-- If Empty_Buffer is True, any input waiting from the process (or in the -- 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 -- buffer) is first discarded before the command is sent. The output
@ -330,8 +330,8 @@ package GNAT.Expect is
Regexp : String; Regexp : String;
Timeout : Integer := 10_000; Timeout : Integer := 10_000;
Full_Buffer : Boolean := False); Full_Buffer : Boolean := False);
-- Wait till a string matching Fd can be read from Fd, and return 1 -- Wait till a string matching Fd can be read from Fd, and return 1 if a
-- if a match was found. -- match was found.
-- --
-- It consumes all the characters read from Fd until a match found, and -- It consumes all the characters read from Fd until a match found, and
-- then sets the return values for the subprograms Expect_Out 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 Regexp_Array is array (Positive range <>) of GNAT.OS_Lib.String_Access;
type Pattern_Matcher_Access is access all GNAT.Regpat.Pattern_Matcher; type Pattern_Matcher_Access is access all GNAT.Regpat.Pattern_Matcher;
type Compiled_Regexp_Array is array (Positive range <>) type Compiled_Regexp_Array is
of Pattern_Matcher_Access; array (Positive range <>) of Pattern_Matcher_Access;
function "+" function "+"
(P : GNAT.Regpat.Pattern_Matcher) (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access;
return Pattern_Matcher_Access; -- Allocate some memory for the pattern matcher. This is only a convenience
-- Allocate some memory for the pattern matcher. -- function to help create the array of compiled regular expressions.
-- This is only a convenience function to help create the array of
-- compiled regular expressions.
procedure Expect procedure Expect
(Descriptor : in out Process_Descriptor; (Descriptor : in out Process_Descriptor;
@ -441,6 +439,7 @@ package GNAT.Expect is
Full_Buffer : Boolean := False); Full_Buffer : Boolean := False);
-- Same as above, except that you can also access the parenthesis -- Same as above, except that you can also access the parenthesis
-- groups inside the matching regular expression. -- groups inside the matching regular expression.
--
-- The first index in Matched must be 0, or Constraint_Error will be -- 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 -- raised. The index 0 contains the indexes for the whole string that was
-- matched, the index 1 contains the indexes for the first parentheses -- 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; Matched : out GNAT.Regpat.Match_Array;
Timeout : Integer := 10_000; Timeout : Integer := 10_000;
Full_Buffer : Boolean := False); Full_Buffer : Boolean := False);
-- Same as above, but with precompiled regular expressions. -- Same as above, but with precompiled regular expressions. The first index
-- The first index in Matched must be 0, or Constraint_Error will be -- in Matched must be 0, or Constraint_Error will be raised.
-- raised.
------------------------------------------- -------------------------------------------
-- Working on the output (multi-process) -- -- Working on the output (multi-process) --
@ -465,8 +463,9 @@ package GNAT.Expect is
Descriptor : Process_Descriptor_Access; Descriptor : Process_Descriptor_Access;
Regexp : Pattern_Matcher_Access; Regexp : Pattern_Matcher_Access;
end record; 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); procedure Free (Regexp : in out Multiprocess_Regexp);
-- Free the memory occupied by Regexp -- Free the memory occupied by Regexp
@ -478,10 +477,9 @@ package GNAT.Expect is
function First_Dead_Process function First_Dead_Process
(Regexp : Multiprocess_Regexp_Array) return Natural; (Regexp : Multiprocess_Regexp_Array) return Natural;
-- Find the first entry in Regexp that corresponds to a dead process that -- Find the first entry in Regexp that corresponds to a dead process that
-- wasn't Free-d yet. -- wasn't Free-d yet. This function is called in general when Expect
-- This function is called in general when Expect (below) raises the -- (below) raises the exception Process_Died. This returns 0 if no process
-- exception Process_Died. -- has died yet.
-- This returns 0 if no process has died yet.
procedure Expect procedure Expect
(Result : out Expect_Match; (Result : out Expect_Match;
@ -493,6 +491,7 @@ package GNAT.Expect is
-- Regexps can have a null Descriptor or Regexp. Such entries will -- Regexps can have a null Descriptor or Regexp. Such entries will
-- simply be ignored. Therefore when a process terminates, you can -- simply be ignored. Therefore when a process terminates, you can
-- simply reset its entry. -- simply reset its entry.
--
-- The expect loop would therefore look like: -- The expect loop would therefore look like:
-- --
-- Processes : Multiprocess_Regexp_Array (...) := ...; -- Processes : Multiprocess_Regexp_Array (...) := ...;
@ -517,8 +516,8 @@ package GNAT.Expect is
Regexps : Multiprocess_Regexp_Array; Regexps : Multiprocess_Regexp_Array;
Timeout : Integer := 10_000; Timeout : Integer := 10_000;
Full_Buffer : Boolean := False); Full_Buffer : Boolean := False);
-- Same as the previous one, but for multiple processes. -- Same as the previous one, but for multiple processes. This procedure
-- This procedure finds the first regexp that match the associated process. -- finds the first regexp that match the associated process.
------------------------ ------------------------
-- Getting the output -- -- Getting the output --
@ -530,8 +529,8 @@ package GNAT.Expect is
-- Discard all output waiting from the process. -- Discard all output waiting from the process.
-- --
-- This output is simply discarded, and no filter is called. This output -- 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 -- will also not be visible by the next call to Expect, nor will any output
-- output currently buffered. -- currently buffered.
-- --
-- Timeout is the delay for which we wait for output to be available from -- 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. -- 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; function Expect_Out (Descriptor : Process_Descriptor) return String;
-- Return the string matched by the last Expect call. -- Return the string matched by the last Expect call.
-- --
-- The returned string is in fact the concatenation of all the strings -- The returned string is in fact the concatenation of all the strings read
-- read from the file descriptor up to, and including, the characters -- from the file descriptor up to, and including, the characters that
-- that matched the regular expression. -- matched the regular expression.
-- --
-- For instance, with an input "philosophic", and a regular expression -- For instance, with an input "philosophic", and a regular expression "hi"
-- "hi" in the call to expect, the strings returned the first and second -- in the call to expect, the strings returned the first and second time
-- time would be respectively "phi" and "losophi". -- would be respectively "phi" and "losophi".
function Expect_Out_Match (Descriptor : Process_Descriptor) return String; function Expect_Out_Match (Descriptor : Process_Descriptor) return String;
-- Return the string matched by the last Expect call. -- Return the string matched by the last Expect call.
@ -609,10 +608,9 @@ private
Pipe3 : in out Pipe_Type; Pipe3 : in out Pipe_Type;
Cmd : String; Cmd : String;
Args : System.Address); Args : System.Address);
-- Finish the set up of the pipes while in the child process -- Finish the set up of the pipes while in the child process This also
-- This also spawns the child process (based on Cmd). -- spawns the child process (based on Cmd). On systems that support fork,
-- On systems that support fork, this procedure is executed inside the -- this procedure is executed inside the newly created process.
-- newly created process.
type Process_Descriptor is tagged record type Process_Descriptor is tagged record
Pid : aliased Process_Id := Invalid_Pid; Pid : aliased Process_Id := Invalid_Pid;
@ -640,7 +638,7 @@ private
Args : System.Address); Args : System.Address);
pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp"); pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp");
-- Executes, in a portable way, the command Cmd (full path must be -- 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 -- 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 -- 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. -- in Pid is the process ID, or zero if not supported on the platform.

54
gcc/ada/s-regpat.adb
View File

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