Skip to content

R
riscv-gcc-1
Commit f8398dc6 by Arnaud Charlet
Options

[multiple changes] 

2010-06-21  Thomas Quinot  <quinot@adacore.com>

	* bindgen.ads: Update comments.

2010-06-21  Vincent Celier  <celier@adacore.com>

	* gnatbind.adb: Suppress dupicates when listing the sources in the
	closure (switch -R).

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

	* s-regpat.adb (Link_Tail): Fix error when size of the pattern matcher
	is too small.

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

	* g-expect.adb, g-expect.ads (First_Dead_Process, Free, Has_Process):
	New subprograms.
	(Expect_Internal): No longer raises an exception, so that it can set
	out parameters as well. When a process has died, reset its Input_Fd
	to Invalid_Fd, so that when using multiple processes we can find out
	which process has died.

From-SVN: r161081
parent fe4e525c
Showing with 320 additions and 116 deletions
gcc/ada/ChangeLog
2010-06-21 Thomas Quinot <quinot@adacore.com>
* bindgen.ads: Update comments.
2010-06-21 Vincent Celier <celier@adacore.com>
* gnatbind.adb: Suppress dupicates when listing the sources in the
closure (switch -R).
2010-06-21 Emmanuel Briot <briot@adacore.com>
* s-regpat.adb (Link_Tail): Fix error when size of the pattern matcher
is too small.
2010-06-21 Emmanuel Briot <briot@adacore.com>
* g-expect.adb, g-expect.ads (First_Dead_Process, Free, Has_Process):
New subprograms.
(Expect_Internal): No longer raises an exception, so that it can set
out parameters as well. When a process has died, reset its Input_Fd
to Invalid_Fd, so that when using multiple processes we can find out
which process has died.
2010-06-21 Robert Dewar <dewar@adacore.com>
* s-regpat.adb, s-tpoben.adb, sem_attr.adb, sem_util.adb, sem_util.ads,
......
gcc/ada/bindgen.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, 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- --
......@@ -24,7 +24,7 @@
------------------------------------------------------------------------------
-- This package contains the routines to output the binder file. This is
-- a C program which contains the following:
-- an Ada or C program which contains the following:
-- initialization for main program case
-- sequence of calls to elaboration routines in appropriate order
......
gcc/ada/g-expect.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2009, AdaCore --
-- Copyright (C) 2000-2010, 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- --
......@@ -45,6 +45,11 @@ package body GNAT.Expect is
type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;
Expect_Process_Died : constant Expect_Match := -100;
Expect_Internal_Error : constant Expect_Match := -101;
-- Additional possible outputs of Expect_Internal. These are not visible in
-- the spec because the user will never see them.
procedure Expect_Internal
(Descriptors : in out Array_Of_Pd;
Result : out Expect_Match;
......@@ -52,11 +57,14 @@ package body GNAT.Expect is
Full_Buffer : Boolean);
-- Internal function used to read from the process Descriptor.
--
-- Three outputs are possible:
-- Several outputs are possible:
-- Result=Expect_Timeout, if no output was available before the timeout
-- expired.
-- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
-- had to be discarded from the internal buffer of Descriptor.
-- Result=Express_Process_Died if one of the processes was terminated.
-- That process's Input_Fd is set to Invalid_FD
-- Result=Express_Internal_Error
-- Result=<integer>, indicates how many characters were added to the
-- internal buffer. These characters are from indexes
-- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
......@@ -211,7 +219,9 @@ package body GNAT.Expect is
Next_Filter : Filter_List;
begin
Close (Descriptor.Input_Fd);
if Descriptor.Input_Fd /= Invalid_FD then
Close (Descriptor.Input_Fd);
end if;
if Descriptor.Error_Fd /= Descriptor.Output_Fd then
Close (Descriptor.Error_Fd);
......@@ -344,10 +354,17 @@ package body GNAT.Expect is
Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then
Result := N;
return;
end if;
case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N;
return;
when others =>
null; -- See below
end case;
-- Calculate the timeout for the next turn
......@@ -493,10 +510,17 @@ package body GNAT.Expect is
Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then
Result := N;
return;
end if;
case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N;
return;
when others =>
null; -- Continue
end case;
end loop;
end Expect;
......@@ -515,7 +539,9 @@ package body GNAT.Expect is
for J in Descriptors'Range loop
Descriptors (J) := Regexps (J).Descriptor;
Reinitialize_Buffer (Regexps (J).Descriptor.all);
if Descriptors (J) /= null then
Reinitialize_Buffer (Regexps (J).Descriptor.all);
end if;
end loop;
loop
......@@ -526,25 +552,36 @@ package body GNAT.Expect is
-- checking the regexps).
for J in Regexps'Range loop
Match (Regexps (J).Regexp.all,
Regexps (J).Descriptor.Buffer
(1 .. Regexps (J).Descriptor.Buffer_Index),
Matched);
if Matched (0) /= No_Match then
Result := Expect_Match (J);
Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
return;
if Regexps (J).Regexp /= null
and then Regexps (J).Descriptor /= null
then
Match (Regexps (J).Regexp.all,
Regexps (J).Descriptor.Buffer
(1 .. Regexps (J).Descriptor.Buffer_Index),
Matched);
if Matched (0) /= No_Match then
Result := Expect_Match (J);
Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
return;
end if;
end if;
end loop;
Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then
Result := N;
return;
end if;
case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N;
return;
when others =>
null; -- Continue
end case;
end loop;
end Expect;
......@@ -564,21 +601,30 @@ package body GNAT.Expect is
N : Integer;
type File_Descriptor_Array is
array (Descriptors'Range) of File_Descriptor;
array (0 .. Descriptors'Length - 1) of File_Descriptor;
Fds : aliased File_Descriptor_Array;
Fds_Count : Natural := 0;
Fds_To_Descriptor : array (Fds'Range) of Integer;
-- Maps file descriptor entries from Fds to entries in Descriptors.
-- They do not have the same index when entries in Descriptors are null.
type Integer_Array is array (Descriptors'Range) of Integer;
type Integer_Array is array (Fds'Range) of Integer;
Is_Set : aliased Integer_Array;
begin
for J in Descriptors'Range loop
Fds (J) := Descriptors (J).Output_Fd;
if Descriptors (J) /= null then
Fds (Fds'First + Fds_Count) := Descriptors (J).Output_Fd;
Fds_To_Descriptor (Fds'First + Fds_Count) := J;
Fds_Count := Fds_Count + 1;
if Descriptors (J).Buffer_Size = 0 then
Buffer_Size := Integer'Max (Buffer_Size, 4096);
else
Buffer_Size :=
Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
if Descriptors (J).Buffer_Size = 0 then
Buffer_Size := Integer'Max (Buffer_Size, 4096);
else
Buffer_Size :=
Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
end if;
end if;
end loop;
......@@ -587,19 +633,23 @@ package body GNAT.Expect is
-- Buffer used for input. This is allocated only once, not for
-- every iteration of the loop
D : Integer;
-- Index in Descriptors
begin
-- Loop until we match or we have a timeout
loop
Num_Descriptors :=
Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address);
case Num_Descriptors is
-- Error?
when -1 =>
raise Process_Died;
Result := Expect_Internal_Error;
return;
-- Timeout?
......@@ -610,15 +660,17 @@ package body GNAT.Expect is
-- Some input
when others =>
for J in Descriptors'Range loop
if Is_Set (J) = 1 then
Buffer_Size := Descriptors (J).Buffer_Size;
for F in Fds'Range loop
if Is_Set (F) = 1 then
D := Fds_To_Descriptor (F);
Buffer_Size := Descriptors (D).Buffer_Size;
if Buffer_Size = 0 then
Buffer_Size := 4096;
end if;
N := Read (Descriptors (J).Output_Fd, Buffer'Address,
N := Read (Descriptors (D).Output_Fd, Buffer'Address,
Buffer_Size);
-- Error or End of file
......@@ -626,43 +678,46 @@ package body GNAT.Expect is
if N <= 0 then
-- ??? Note that ddd tries again up to three times
-- in that case. See LiterateA.C:174
raise Process_Died;
Descriptors (D).Input_Fd := Invalid_FD;
Result := Expect_Process_Died;
return;
else
-- If there is no limit to the buffer size
if Descriptors (J).Buffer_Size = 0 then
if Descriptors (D).Buffer_Size = 0 then
declare
Tmp : String_Access := Descriptors (J).Buffer;
Tmp : String_Access := Descriptors (D).Buffer;
begin
if Tmp /= null then
Descriptors (J).Buffer :=
Descriptors (D).Buffer :=
new String (1 .. Tmp'Length + N);
Descriptors (J).Buffer (1 .. Tmp'Length) :=
Descriptors (D).Buffer (1 .. Tmp'Length) :=
Tmp.all;
Descriptors (J).Buffer
Descriptors (D).Buffer
(Tmp'Length + 1 .. Tmp'Length + N) :=
Buffer (1 .. N);
Free (Tmp);
Descriptors (J).Buffer_Index :=
Descriptors (J).Buffer'Last;
Descriptors (D).Buffer_Index :=
Descriptors (D).Buffer'Last;
else
Descriptors (J).Buffer :=
Descriptors (D).Buffer :=
new String (1 .. N);
Descriptors (J).Buffer.all :=
Descriptors (D).Buffer.all :=
Buffer (1 .. N);
Descriptors (J).Buffer_Index := N;
Descriptors (D).Buffer_Index := N;
end if;
end;
else
-- Add what we read to the buffer
if Descriptors (J).Buffer_Index + N >
Descriptors (J).Buffer_Size
if Descriptors (D).Buffer_Index + N >
Descriptors (D).Buffer_Size
then
-- If the user wants to know when we have
-- read more than the buffer can contain.
......@@ -675,33 +730,33 @@ package body GNAT.Expect is
-- Keep as much as possible from the buffer,
-- and forget old characters.
Descriptors (J).Buffer
(1 .. Descriptors (J).Buffer_Size - N) :=
Descriptors (J).Buffer
(N - Descriptors (J).Buffer_Size +
Descriptors (J).Buffer_Index + 1 ..
Descriptors (J).Buffer_Index);
Descriptors (J).Buffer_Index :=
Descriptors (J).Buffer_Size - N;
Descriptors (D).Buffer
(1 .. Descriptors (D).Buffer_Size - N) :=
Descriptors (D).Buffer
(N - Descriptors (D).Buffer_Size +
Descriptors (D).Buffer_Index + 1 ..
Descriptors (D).Buffer_Index);
Descriptors (D).Buffer_Index :=
Descriptors (D).Buffer_Size - N;
end if;
-- Keep what we read in the buffer
Descriptors (J).Buffer
(Descriptors (J).Buffer_Index + 1 ..
Descriptors (J).Buffer_Index + N) :=
Descriptors (D).Buffer
(Descriptors (D).Buffer_Index + 1 ..
Descriptors (D).Buffer_Index + N) :=
Buffer (1 .. N);
Descriptors (J).Buffer_Index :=
Descriptors (J).Buffer_Index + N;
Descriptors (D).Buffer_Index :=
Descriptors (D).Buffer_Index + N;
end if;
-- Call each of the output filter with what we
-- read.
Call_Filters
(Descriptors (J).all, Buffer (1 .. N), Output);
(Descriptors (D).all, Buffer (1 .. N), Output);
Result := Expect_Match (N);
Result := Expect_Match (D);
return;
end if;
end if;
......@@ -730,6 +785,24 @@ package body GNAT.Expect is
(Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
end Expect_Out_Match;
------------------------
-- First_Dead_Process --
------------------------
function First_Dead_Process
(Regexp : Multiprocess_Regexp_Array) return Natural is
begin
for R in Regexp'Range loop
if Regexp (R).Descriptor /= null
and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD
then
return R;
end if;
end loop;
return 0;
end First_Dead_Process;
-----------
-- Flush --
-----------
......@@ -785,6 +858,18 @@ package body GNAT.Expect is
end loop;
end Flush;
----------
-- Free --
----------
procedure Free (Regexp : in out Multiprocess_Regexp) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Process_Descriptor'Class, Process_Descriptor_Access);
begin
Unchecked_Free (Regexp.Descriptor);
Free (Regexp.Regexp);
end Free;
------------------------
-- Get_Command_Output --
------------------------
......@@ -915,6 +1000,15 @@ package body GNAT.Expect is
return Descriptor.Pid;
end Get_Pid;
-----------------
-- Has_Process --
-----------------
function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is
begin
return Regexp /= (Regexp'Range => (null, null));
end Has_Process;
---------------
-- Interrupt --
---------------
......@@ -1136,6 +1230,13 @@ package body GNAT.Expect is
Expect_Internal
(Descriptors, Result, Timeout => 0, Full_Buffer => False);
if Result = Expect_Internal_Error
or else Result = Expect_Process_Died
then
raise Process_Died;
end if;
Descriptor.Last_Match_End := Descriptor.Buffer_Index;
-- Empty the buffer
......
gcc/ada/g-expect.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2009, AdaCore --
-- Copyright (C) 2000-2010, 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- --
......@@ -466,7 +466,22 @@ package GNAT.Expect is
Regexp : Pattern_Matcher_Access;
end record;
type Multiprocess_Regexp_Array is array (Positive range <>)
of Multiprocess_Regexp;
of Multiprocess_Regexp;
procedure Free (Regexp : in out Multiprocess_Regexp);
-- Free the memory occupied by Regexp
function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean;
-- Return True if at least one entry in Regexp is non-null, ie there is
-- still at least one process to monitor
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.
procedure Expect
(Result : out Expect_Match;
......@@ -474,7 +489,28 @@ package GNAT.Expect is
Matched : out GNAT.Regpat.Match_Array;
Timeout : Integer := 10_000;
Full_Buffer : Boolean := False);
-- Same as above, but for multi processes
-- Same as above, but for multi processes. Any of the entries in
-- 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 (...) := ...;
-- R : Natural;
--
-- while Has_Process (Processes) loop
-- begin
-- Expect (Result, Processes, Timeout => -1);
-- ... process output of process Result (output, full buffer,...)
--
-- exception
-- when Process_Died =>
-- -- Free memory
-- R := First_Dead_Process (Processes);
-- Close (Processes (R).Descriptor.all, Status);
-- Free (Processes (R));
-- end;
-- end loop;
procedure Expect
(Result : out Expect_Match;
......
gcc/ada/gnatbind.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, 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- --
......@@ -45,6 +45,7 @@ with Rident; use Rident;
with Snames;
with Switch; use Switch;
with Switch.B; use Switch.B;
with Table;
with Targparm; use Targparm;
with Types; use Types;
......@@ -815,55 +816,97 @@ begin
-- sources) if -R was used.
if List_Closure then
if not Zero_Formatting then
Write_Eol;
Write_Str ("REFERENCED SOURCES");
Write_Eol;
end if;
for J in reverse Elab_Order.First .. Elab_Order.Last loop
-- Do not include the sources of the runtime
declare
package Sources is new Table.Table
(Table_Component_Type => File_Name_Type,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Gnatbind.Sources");
-- Table to record the sources in the closure, to avoid
-- dupications.
Source : File_Name_Type;
function Put_In_Sources (S : File_Name_Type) return Boolean;
-- Check if S is already in table Sources and put in Sources
-- if it is not. Return False if the source is already in
-- Sources, and True if it is added.
--------------------
-- Put_In_Sources --
--------------------
function Put_In_Sources (S : File_Name_Type)
return Boolean
is
begin
for J in 1 .. Sources.Last loop
if Sources.Table (J) = S then
return False;
end if;
end loop;
if not Is_Internal_File_Name
(Units.Table (Elab_Order.Table (J)).Sfile)
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Sources.Append (S);
return True;
end Put_In_Sources;
Write_Str
(Get_Name_String
(Units.Table (Elab_Order.Table (J)).Sfile));
begin
if not Zero_Formatting then
Write_Eol;
Write_Str ("REFERENCED SOURCES");
Write_Eol;
end if;
end loop;
-- Subunits do not appear in the elaboration table because they
-- are subsumed by their parent units, but we need to list them
-- for other tools. For now they are listed after other files,
-- rather than right after their parent, since there is no easy
-- link between the elaboration table and the ALIs table ???
-- Note also that subunits may appear repeatedly in the list,
-- if the parent unit appears in the context of several units
-- in the closure.
for J in Sdep.First .. Sdep.Last loop
if Sdep.Table (J).Subunit_Name /= No_Name
and then not Is_Internal_File_Name (Sdep.Table (J).Sfile)
then
if not Zero_Formatting then
Write_Str (" ");
for J in reverse Elab_Order.First .. Elab_Order.Last loop
Source := Units.Table (Elab_Order.Table (J)).Sfile;
-- Do not include the sources of the runtime and do not
-- include the same source several times.
if Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Str (Get_Name_String (Source));
Write_Eol;
end if;
end loop;
-- Subunits do not appear in the elaboration table because
-- they are subsumed by their parent units, but we need to
-- list them for other tools. For now they are listed after
-- other files, rather than right after their parent, since
-- there is no easy link between the elaboration table and
-- the ALIs table ??? As subunits may appear repeatedly in
-- the list, if the parent unit appears in the context of
-- several units in the closure, duplicates are suppressed.
for J in Sdep.First .. Sdep.Last loop
Source := Sdep.Table (J).Sfile;
if Sdep.Table (J).Subunit_Name /= No_Name
and then Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then
if not Zero_Formatting then
Write_Str (" ");
end if;
Write_Str (Get_Name_String (Source));
Write_Eol;
end if;
end loop;
Write_Str (Get_Name_String (Sdep.Table (J).Sfile));
if not Zero_Formatting then
Write_Eol;
end if;
end loop;
if not Zero_Formatting then
Write_Eol;
end if;
end;
end if;
end if;
end if;
......
gcc/ada/s-regpat.adb
......@@ -802,10 +802,11 @@ package body System.Regpat is
Offset : Pointer;
begin
-- Find last node
-- Find last node (the size of the pattern matcher might be too
-- small, so don't try to read past its end)
Scan := P;
while Scan <= PM.Size loop
while Scan + 3 <= PM.Size loop
Temp := Get_Next (Program, Scan);
exit when Temp = Scan;
Scan := Temp;
......
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