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 126 additions and 23 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.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