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 272 additions and 68 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> 2010-06-21 Robert Dewar <dewar@adacore.com>
* s-regpat.adb, s-tpoben.adb, sem_attr.adb, sem_util.adb, sem_util.ads, * s-regpat.adb, s-tpoben.adb, sem_attr.adb, sem_util.adb, sem_util.ads,
......
gcc/ada/bindgen.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package contains the routines to output the binder file. This is -- 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 -- initialization for main program case
-- sequence of calls to elaboration routines in appropriate order -- sequence of calls to elaboration routines in appropriate order
......
gcc/ada/g-expect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,6 +45,11 @@ package body GNAT.Expect is ...@@ -45,6 +45,11 @@ package body GNAT.Expect is
type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access; 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 procedure Expect_Internal
(Descriptors : in out Array_Of_Pd; (Descriptors : in out Array_Of_Pd;
Result : out Expect_Match; Result : out Expect_Match;
...@@ -52,11 +57,14 @@ package body GNAT.Expect is ...@@ -52,11 +57,14 @@ package body GNAT.Expect is
Full_Buffer : Boolean); Full_Buffer : Boolean);
-- Internal function used to read from the process Descriptor. -- 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 -- Result=Expect_Timeout, if no output was available before the timeout
-- expired. -- expired.
-- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
-- had to be discarded from the internal buffer of Descriptor. -- 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 -- Result=<integer>, indicates how many characters were added to the
-- internal buffer. These characters are from indexes -- internal buffer. These characters are from indexes
-- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
...@@ -211,7 +219,9 @@ package body GNAT.Expect is ...@@ -211,7 +219,9 @@ package body GNAT.Expect is
Next_Filter : Filter_List; Next_Filter : Filter_List;
begin begin
if Descriptor.Input_Fd /= Invalid_FD then
Close (Descriptor.Input_Fd); Close (Descriptor.Input_Fd);
end if;
if Descriptor.Error_Fd /= Descriptor.Output_Fd then if Descriptor.Error_Fd /= Descriptor.Output_Fd then
Close (Descriptor.Error_Fd); Close (Descriptor.Error_Fd);
...@@ -344,10 +354,17 @@ package body GNAT.Expect is ...@@ -344,10 +354,17 @@ package body GNAT.Expect is
Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer); Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N; Result := N;
return; return;
end if;
when others =>
null; -- See below
end case;
-- Calculate the timeout for the next turn -- Calculate the timeout for the next turn
...@@ -493,10 +510,17 @@ package body GNAT.Expect is ...@@ -493,10 +510,17 @@ package body GNAT.Expect is
Expect_Internal (Descriptors, N, Timeout, Full_Buffer); Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N; Result := N;
return; return;
end if;
when others =>
null; -- Continue
end case;
end loop; end loop;
end Expect; end Expect;
...@@ -515,7 +539,9 @@ package body GNAT.Expect is ...@@ -515,7 +539,9 @@ 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
Reinitialize_Buffer (Regexps (J).Descriptor.all); Reinitialize_Buffer (Regexps (J).Descriptor.all);
end if;
end loop; end loop;
loop loop
...@@ -526,6 +552,9 @@ package body GNAT.Expect is ...@@ -526,6 +552,9 @@ package body GNAT.Expect is
-- checking the regexps). -- checking the regexps).
for J in Regexps'Range loop for J in Regexps'Range loop
if Regexps (J).Regexp /= null
and then Regexps (J).Descriptor /= null
then
Match (Regexps (J).Regexp.all, Match (Regexps (J).Regexp.all,
Regexps (J).Descriptor.Buffer Regexps (J).Descriptor.Buffer
(1 .. Regexps (J).Descriptor.Buffer_Index), (1 .. Regexps (J).Descriptor.Buffer_Index),
...@@ -537,14 +566,22 @@ package body GNAT.Expect is ...@@ -537,14 +566,22 @@ package body GNAT.Expect is
Regexps (J).Descriptor.Last_Match_End := Matched (0).Last; Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
return; return;
end if; end if;
end if;
end loop; end loop;
Expect_Internal (Descriptors, N, Timeout, Full_Buffer); Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
if N = Expect_Timeout or else N = Expect_Full_Buffer then case N is
when Expect_Internal_Error | Expect_Process_Died =>
raise Process_Died;
when Expect_Timeout | Expect_Full_Buffer =>
Result := N; Result := N;
return; return;
end if;
when others =>
null; -- Continue
end case;
end loop; end loop;
end Expect; end Expect;
...@@ -564,15 +601,23 @@ package body GNAT.Expect is ...@@ -564,15 +601,23 @@ package body GNAT.Expect is
N : Integer; N : Integer;
type File_Descriptor_Array is 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 : 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; Is_Set : aliased Integer_Array;
begin begin
for J in Descriptors'Range loop 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 if Descriptors (J).Buffer_Size = 0 then
Buffer_Size := Integer'Max (Buffer_Size, 4096); Buffer_Size := Integer'Max (Buffer_Size, 4096);
...@@ -580,6 +625,7 @@ package body GNAT.Expect is ...@@ -580,6 +625,7 @@ package body GNAT.Expect is
Buffer_Size := Buffer_Size :=
Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size); Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
end if; end if;
end if;
end loop; end loop;
declare declare
...@@ -587,19 +633,23 @@ package body GNAT.Expect is ...@@ -587,19 +633,23 @@ package body GNAT.Expect is
-- Buffer used for input. This is allocated only once, not for -- Buffer used for input. This is allocated only once, not for
-- every iteration of the loop -- every iteration of the loop
D : Integer;
-- Index in Descriptors
begin begin
-- Loop until we match or we have a timeout -- Loop until we match or we have a timeout
loop loop
Num_Descriptors := Num_Descriptors :=
Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address); Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address);
case Num_Descriptors is case Num_Descriptors is
-- Error? -- Error?
when -1 => when -1 =>
raise Process_Died; Result := Expect_Internal_Error;
return;
-- Timeout? -- Timeout?
...@@ -610,15 +660,17 @@ package body GNAT.Expect is ...@@ -610,15 +660,17 @@ package body GNAT.Expect is
-- Some input -- Some input
when others => when others =>
for J in Descriptors'Range loop for F in Fds'Range loop
if Is_Set (J) = 1 then if Is_Set (F) = 1 then
Buffer_Size := Descriptors (J).Buffer_Size; D := Fds_To_Descriptor (F);
Buffer_Size := Descriptors (D).Buffer_Size;
if Buffer_Size = 0 then if Buffer_Size = 0 then
Buffer_Size := 4096; Buffer_Size := 4096;
end if; end if;
N := Read (Descriptors (J).Output_Fd, Buffer'Address, N := Read (Descriptors (D).Output_Fd, Buffer'Address,
Buffer_Size); Buffer_Size);
-- Error or End of file -- Error or End of file
...@@ -626,43 +678,46 @@ package body GNAT.Expect is ...@@ -626,43 +678,46 @@ package body GNAT.Expect is
if N <= 0 then if N <= 0 then
-- ??? Note that ddd tries again up to three times -- ??? Note that ddd tries again up to three times
-- in that case. See LiterateA.C:174 -- in that case. See LiterateA.C:174
raise Process_Died;
Descriptors (D).Input_Fd := Invalid_FD;
Result := Expect_Process_Died;
return;
else else
-- If there is no limit to the buffer size -- If there is no limit to the buffer size
if Descriptors (J).Buffer_Size = 0 then if Descriptors (D).Buffer_Size = 0 then
declare declare
Tmp : String_Access := Descriptors (J).Buffer; Tmp : String_Access := Descriptors (D).Buffer;
begin begin
if Tmp /= null then if Tmp /= null then
Descriptors (J).Buffer := Descriptors (D).Buffer :=
new String (1 .. Tmp'Length + N); new String (1 .. Tmp'Length + N);
Descriptors (J).Buffer (1 .. Tmp'Length) := Descriptors (D).Buffer (1 .. Tmp'Length) :=
Tmp.all; Tmp.all;
Descriptors (J).Buffer Descriptors (D).Buffer
(Tmp'Length + 1 .. Tmp'Length + N) := (Tmp'Length + 1 .. Tmp'Length + N) :=
Buffer (1 .. N); Buffer (1 .. N);
Free (Tmp); Free (Tmp);
Descriptors (J).Buffer_Index := Descriptors (D).Buffer_Index :=
Descriptors (J).Buffer'Last; Descriptors (D).Buffer'Last;
else else
Descriptors (J).Buffer := Descriptors (D).Buffer :=
new String (1 .. N); new String (1 .. N);
Descriptors (J).Buffer.all := Descriptors (D).Buffer.all :=
Buffer (1 .. N); Buffer (1 .. N);
Descriptors (J).Buffer_Index := N; Descriptors (D).Buffer_Index := N;
end if; end if;
end; end;
else else
-- Add what we read to the buffer -- Add what we read to the buffer
if Descriptors (J).Buffer_Index + N > if Descriptors (D).Buffer_Index + N >
Descriptors (J).Buffer_Size Descriptors (D).Buffer_Size
then then
-- If the user wants to know when we have -- If the user wants to know when we have
-- read more than the buffer can contain. -- read more than the buffer can contain.
...@@ -675,33 +730,33 @@ package body GNAT.Expect is ...@@ -675,33 +730,33 @@ package body GNAT.Expect is
-- Keep as much as possible from the buffer, -- Keep as much as possible from the buffer,
-- and forget old characters. -- and forget old characters.
Descriptors (J).Buffer Descriptors (D).Buffer
(1 .. Descriptors (J).Buffer_Size - N) := (1 .. Descriptors (D).Buffer_Size - N) :=
Descriptors (J).Buffer Descriptors (D).Buffer
(N - Descriptors (J).Buffer_Size + (N - Descriptors (D).Buffer_Size +
Descriptors (J).Buffer_Index + 1 .. Descriptors (D).Buffer_Index + 1 ..
Descriptors (J).Buffer_Index); Descriptors (D).Buffer_Index);
Descriptors (J).Buffer_Index := Descriptors (D).Buffer_Index :=
Descriptors (J).Buffer_Size - N; Descriptors (D).Buffer_Size - N;
end if; end if;
-- Keep what we read in the buffer -- Keep what we read in the buffer
Descriptors (J).Buffer Descriptors (D).Buffer
(Descriptors (J).Buffer_Index + 1 .. (Descriptors (D).Buffer_Index + 1 ..
Descriptors (J).Buffer_Index + N) := Descriptors (D).Buffer_Index + N) :=
Buffer (1 .. N); Buffer (1 .. N);
Descriptors (J).Buffer_Index := Descriptors (D).Buffer_Index :=
Descriptors (J).Buffer_Index + N; Descriptors (D).Buffer_Index + N;
end if; end if;
-- Call each of the output filter with what we -- Call each of the output filter with what we
-- read. -- read.
Call_Filters 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; return;
end if; end if;
end if; end if;
...@@ -730,6 +785,24 @@ package body GNAT.Expect is ...@@ -730,6 +785,24 @@ package body GNAT.Expect is
(Descriptor.Last_Match_Start .. Descriptor.Last_Match_End); (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
end Expect_Out_Match; 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 -- -- Flush --
----------- -----------
...@@ -785,6 +858,18 @@ package body GNAT.Expect is ...@@ -785,6 +858,18 @@ package body GNAT.Expect is
end loop; end loop;
end Flush; 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 -- -- Get_Command_Output --
------------------------ ------------------------
...@@ -915,6 +1000,15 @@ package body GNAT.Expect is ...@@ -915,6 +1000,15 @@ package body GNAT.Expect is
return Descriptor.Pid; return Descriptor.Pid;
end Get_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 -- -- Interrupt --
--------------- ---------------
...@@ -1136,6 +1230,13 @@ package body GNAT.Expect is ...@@ -1136,6 +1230,13 @@ package body GNAT.Expect is
Expect_Internal Expect_Internal
(Descriptors, Result, Timeout => 0, Full_Buffer => False); (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; Descriptor.Last_Match_End := Descriptor.Buffer_Index;
-- Empty the buffer -- Empty the buffer
......
gcc/ada/g-expect.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -468,13 +468,49 @@ package GNAT.Expect is ...@@ -468,13 +468,49 @@ package GNAT.Expect is
type Multiprocess_Regexp_Array is array (Positive range <>) 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 procedure Expect
(Result : out Expect_Match; (Result : out Expect_Match;
Regexps : Multiprocess_Regexp_Array; Regexps : Multiprocess_Regexp_Array;
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 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 procedure Expect
(Result : out Expect_Match; (Result : out Expect_Match;
......
gcc/ada/gnatbind.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -45,6 +45,7 @@ with Rident; use Rident; ...@@ -45,6 +45,7 @@ with Rident; use Rident;
with Snames; with Snames;
with Switch; use Switch; with Switch; use Switch;
with Switch.B; use Switch.B; with Switch.B; use Switch.B;
with Table;
with Targparm; use Targparm; with Targparm; use Targparm;
with Types; use Types; with Types; use Types;
...@@ -815,6 +816,43 @@ begin ...@@ -815,6 +816,43 @@ begin
-- sources) if -R was used. -- sources) if -R was used.
if List_Closure then if List_Closure then
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;
Sources.Append (S);
return True;
end Put_In_Sources;
begin
if not Zero_Formatting then if not Zero_Formatting then
Write_Eol; Write_Eol;
Write_Str ("REFERENCED SOURCES"); Write_Str ("REFERENCED SOURCES");
...@@ -823,40 +861,44 @@ begin ...@@ -823,40 +861,44 @@ begin
for J in reverse Elab_Order.First .. Elab_Order.Last loop for J in reverse Elab_Order.First .. Elab_Order.Last loop
-- Do not include the sources of the runtime Source := Units.Table (Elab_Order.Table (J)).Sfile;
if not Is_Internal_File_Name -- Do not include the sources of the runtime and do not
(Units.Table (Elab_Order.Table (J)).Sfile) -- include the same source several times.
if Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then then
if not Zero_Formatting then if not Zero_Formatting then
Write_Str (" "); Write_Str (" ");
end if; end if;
Write_Str Write_Str (Get_Name_String (Source));
(Get_Name_String
(Units.Table (Elab_Order.Table (J)).Sfile));
Write_Eol; Write_Eol;
end if; end if;
end loop; end loop;
-- Subunits do not appear in the elaboration table because they -- Subunits do not appear in the elaboration table because
-- are subsumed by their parent units, but we need to list them -- they are subsumed by their parent units, but we need to
-- for other tools. For now they are listed after other files, -- list them for other tools. For now they are listed after
-- rather than right after their parent, since there is no easy -- other files, rather than right after their parent, since
-- link between the elaboration table and the ALIs table ??? -- there is no easy link between the elaboration table and
-- Note also that subunits may appear repeatedly in the list, -- the ALIs table ??? As subunits may appear repeatedly in
-- if the parent unit appears in the context of several units -- the list, if the parent unit appears in the context of
-- in the closure. -- several units in the closure, duplicates are suppressed.
for J in Sdep.First .. Sdep.Last loop for J in Sdep.First .. Sdep.Last loop
Source := Sdep.Table (J).Sfile;
if Sdep.Table (J).Subunit_Name /= No_Name if Sdep.Table (J).Subunit_Name /= No_Name
and then not Is_Internal_File_Name (Sdep.Table (J).Sfile) and then Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then then
if not Zero_Formatting then if not Zero_Formatting then
Write_Str (" "); Write_Str (" ");
end if; end if;
Write_Str (Get_Name_String (Sdep.Table (J).Sfile)); Write_Str (Get_Name_String (Source));
Write_Eol; Write_Eol;
end if; end if;
end loop; end loop;
...@@ -864,6 +906,7 @@ begin ...@@ -864,6 +906,7 @@ begin
if not Zero_Formatting then if not Zero_Formatting then
Write_Eol; Write_Eol;
end if; end if;
end;
end if; end if;
end if; end if;
end if; end if;
......
gcc/ada/s-regpat.adb
...@@ -802,10 +802,11 @@ package body System.Regpat is ...@@ -802,10 +802,11 @@ package body System.Regpat is
Offset : Pointer; Offset : Pointer;
begin 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; Scan := P;
while Scan <= PM.Size loop while Scan + 3 <= 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;
......
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