mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 14:51:06 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-04-24  Tristan Gingold  <gingold@adacore.com>

	* s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the
	mach thread id.

2009-04-24  Emmanuel Briot  <briot@adacore.com>

	* prj-env.adb, prj-env.ads (Body_Path_Name_Of, Spec_Path_Name_Of,
	Path_Name_Of_Library_Unit_Body): rEmove unused subprograms.
	(For_All_Imported_Projects): new procedure
	(For_All_Source_Dirs, For_All_Object_Dirs): Rewritten based on the
	above rather than duplicating code.

From-SVN: r146692
This commit is contained in:
Arnaud Charlet 2009-04-24 12:22:43 +02:00
parent 5d07d0cfa8
commit b3520ca005
5 changed files with 123 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2009-04-24 Tristan Gingold <gingold@adacore.com>
* s-osinte-darwin.adb, s-osinte-darwin.ads: lwp_self now returns the
mach thread id.
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-env.adb, prj-env.ads (Body_Path_Name_Of, Spec_Path_Name_Of,
Path_Name_Of_Library_Unit_Body): rEmove unused subprograms.
(For_All_Imported_Projects): new procedure
(For_All_Source_Dirs, For_All_Object_Dirs): Rewritten based on the
above rather than duplicating code.
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb

521
gcc/ada/prj-env.adb
View File

@ -60,22 +60,20 @@ package body Prj.Env is
Default_Naming : constant Naming_Id := Naming_Table.First;
Fill_Mapping_File : Boolean := True;
package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Project_Id,
Hash => Hash,
Equal => "=");
-- A table that associates a project to a boolean. This is used to detect
-- whether a project was already processed for instance.
-----------------------
-- Local Subprograms --
-----------------------
function Body_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the body of a unit.
-- Compute it first, if necessary.
function Spec_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path name of the spec of a unit.
-- Compute it first, if necessary.
procedure Add_To_Path
(Source_Dirs : String_List_Id;
In_Tree : Project_Tree_Ref);
@ -504,69 +502,6 @@ package body Prj.Env is
end loop;
end Add_To_Source_Path;
-----------------------
-- Body_Path_Name_Of --
-----------------------
function Body_Path_Name_Of
(Unit : Unit_Index;
In_Tree : Project_Tree_Ref) return String
is
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
-- If we don't know the path name of the body of this unit,
-- we compute it, and we store it.
if Data.File_Names (Body_Part).Path = No_Path_Information then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
(Data.File_Names (Body_Part).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
-- By default, put the file name
Data.File_Names (Body_Part).Path.Name :=
Path_Name_Type (Data.File_Names (Body_Part).Name);
-- For each source directory
while Current_Source /= Nil_String loop
Path :=
Locate_Regular_File
(Namet.Get_Name_String
(Data.File_Names (Body_Part).Name),
Namet.Get_Name_String
(In_Tree.String_Elements.Table
(Current_Source).Value));
-- If the file is in this directory, then we store the path,
-- and we are done.
if Path /= null then
Name_Len := Path'Length;
Name_Buffer (1 .. Name_Len) := Path.all;
Data.File_Names (Body_Part).Path.Name := Name_Enter;
exit;
else
Current_Source :=
In_Tree.String_Elements.Table
(Current_Source).Next;
end if;
end loop;
In_Tree.Units.Table (Unit) := Data;
end;
end if;
-- Returned the stored value
return Namet.Get_Name_String (Data.File_Names (Body_Part).Path.Name);
end Body_Path_Name_Of;
------------------------
-- Contains_ALI_Files --
------------------------
@ -1527,6 +1462,53 @@ package body Prj.Env is
return "";
end File_Name_Of_Library_Unit_Body;
-------------------------------
-- For_All_Imported_Projects --
-------------------------------
procedure For_All_Imported_Projects
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recurse (Prj : Project_Id);
-- Process Prj recursively
-------------
-- Recurse --
-------------
procedure Recurse (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
List : Project_List := Data.Imported_Projects;
begin
if not Get (Seen, Prj) then
Set (Seen, Prj, True);
Action (Prj);
-- If we are extending a project, visit it
if Data.Extends /= No_Project then
Recurse (Data.Extends);
end if;
-- And visit all imported projects
while List /= Empty_Project_List loop
Recurse (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end if;
end Recurse;
begin
Recurse (Project);
Reset (Seen);
end For_All_Imported_Projects;
-------------------------
-- For_All_Object_Dirs --
-------------------------
@ -1535,96 +1517,25 @@ package body Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
Seen : Project_List := Empty_Project_List;
procedure For_Project (Prj : Project_Id);
-- Get all object directories of Prj
procedure Add (Project : Project_Id);
-- Process a project. Remember the processes visited to avoid processing
-- a project twice. Recursively process an eventual extended project,
-- and all imported projects.
---------
-- Add --
---------
procedure Add (Project : Project_Id) is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
-----------------
-- For_Project --
-----------------
procedure For_Project (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
begin
-- If the list of visited project is empty, then
-- for sure we never visited this project.
if Seen = Empty_Project_List then
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
Seen := Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
else
-- Check if the project is in the list
declare
Current : Project_List := Seen;
begin
loop
-- If it is, then there is nothing else to do
if In_Tree.Project_Lists.Table
(Current).Project = Project
then
return;
end if;
exit when
In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List;
Current :=
In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it
-- to the list.
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
-- If there is an object directory, call Action with its name
if Data.Object_Directory /= No_Path_Information then
Get_Name_String (Data.Object_Directory.Display_Name);
Action (Name_Buffer (1 .. Name_Len));
end if;
end For_Project;
-- If we are extending a project, visit it
if Data.Extends /= No_Project then
Add (Data.Extends);
end if;
-- And visit all imported projects
while List /= Empty_Project_List loop
Add (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
-- Start of processing for For_All_Object_Dirs
procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project);
begin
-- Visit this project, and its imported projects, recursively
Add (Project);
Get_Object_Dirs (Project, In_Tree);
end For_All_Object_Dirs;
-------------------------
@ -1635,110 +1546,33 @@ package body Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
Seen : Project_List := Empty_Project_List;
procedure For_Project (Prj : Project_Id);
-- Get all object directories of Prj
procedure Add (Project : Project_Id);
-- Process a project. Remember the processes visited to avoid processing
-- a project twice. Recursively process an eventual extended project,
-- and all imported projects.
---------
-- Add --
---------
procedure Add (Project : Project_Id) is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
-----------------
-- For_Project --
-----------------
procedure For_Project (Prj : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Prj);
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
begin
-- If the list of visited project is empty, then for sure we never
-- visited this project.
-- If there are Ada sources, call action with the name of every
-- source directory.
if Seen = Empty_Project_List then
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
Seen := Project_List_Table.Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
else
-- Check if the project is in the list
declare
Current : Project_List := Seen;
begin
loop
-- If it is, then there is nothing else to do
if In_Tree.Project_Lists.Table
(Current).Project = Project
then
return;
end if;
exit when
In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List;
Current :=
In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it to the list
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
if In_Tree.Projects.Table (Project).Ada_Sources_Present then
while Current /= Nil_String loop
The_String := In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
end if;
end For_Project;
declare
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
begin
-- If there are Ada sources, call action with the name of every
-- source directory.
if
In_Tree.Projects.Table (Project).Ada_Sources /= Nil_String
then
while Current /= Nil_String loop
The_String :=
In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
end if;
end;
-- If we are extending a project, visit it
if Data.Extends /= No_Project then
Add (Data.Extends);
end if;
-- And visit all imported projects
while List /= Empty_Project_List loop
Add (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end Add;
-- Start of processing for For_All_Source_Dirs
procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project);
begin
-- Visit this project, and its imported projects recursively
Add (Project);
Get_Source_Dirs (Project, In_Tree);
end For_All_Source_Dirs;
-------------------
@ -1839,139 +1673,6 @@ package body Prj.Env is
Current_Object_Path_File := No_Path;
end Initialize;
------------------------------------
-- Path_Name_Of_Library_Unit_Body --
------------------------------------
-- Could use some comments in the body here ???
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String
is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
Original_Name : String := Name;
Extended_Spec_Name : String :=
Name &
Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
Extended_Body_Name : String :=
Name &
Body_Suffix_Of (In_Tree, "ada", Data.Naming);
First : Unit_Index := Unit_Table.First;
Current : Unit_Index;
Unit : Unit_Data;
begin
Canonical_Case_File_Name (Original_Name);
Canonical_Case_File_Name (Extended_Spec_Name);
Canonical_Case_File_Name (Extended_Body_Name);
if Current_Verbosity = High then
Write_Str ("Looking for path name of """);
Write_Str (Name);
Write_Char ('"');
Write_Eol;
Write_Str (" Extended Spec Name = """);
Write_Str (Extended_Spec_Name);
Write_Char ('"');
Write_Eol;
Write_Str (" Extended Body Name = """);
Write_Str (Extended_Body_Name);
Write_Char ('"');
Write_Eol;
end if;
while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project
loop
First := First + 1;
end loop;
Current := First;
while Current <= Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Current);
if Unit.File_Names (Body_Part).Project = Project
and then Unit.File_Names (Body_Part).Name /= No_File
then
declare
Current_Name : constant String :=
Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
begin
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Current_Name);
Write_Char ('"');
Write_Eol;
end if;
if Current_Name = Original_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Body_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Body_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Body_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
Write_Line (" not good");
end if;
end if;
end;
elsif Unit.File_Names (Specification).Name /= No_File then
declare
Current_Name : constant String :=
Namet.Get_Name_String
(Unit.File_Names (Specification).Name);
begin
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Current_Name);
Write_Char ('"');
Write_Eol;
end if;
if Current_Name = Original_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Spec_Path_Name_Of (Current, In_Tree);
elsif Current_Name = Extended_Spec_Name then
if Current_Verbosity = High then
Write_Line (" OK");
end if;
return Spec_Path_Name_Of (Current, In_Tree);
else
if Current_Verbosity = High then
Write_Line (" not good");
end if;
end if;
end;
end if;
Current := Current + 1;
end loop;
return "";
end Path_Name_Of_Library_Unit_Body;
-------------------
-- Print_Sources --
-------------------
@ -2455,54 +2156,6 @@ package body Prj.Env is
end if;
end Set_Path_File_Var;
-----------------------
-- Spec_Path_Name_Of --
-----------------------
function Spec_Path_Name_Of
(Unit : Unit_Index; In_Tree : Project_Tree_Ref) return String
is
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
if Data.File_Names (Specification).Path.Name = No_Path then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
(Data.File_Names (Specification).Project).Ada_Sources;
Path : GNAT.OS_Lib.String_Access;
begin
Data.File_Names (Specification).Path.Name :=
Path_Name_Type (Data.File_Names (Specification).Name);
while Current_Source /= Nil_String loop
Path := Locate_Regular_File
(Namet.Get_Name_String
(Data.File_Names (Specification).Name),
Namet.Get_Name_String
(In_Tree.String_Elements.Table
(Current_Source).Value));
if Path /= null then
Name_Len := Path'Length;
Name_Buffer (1 .. Name_Len) := Path.all;
Data.File_Names (Specification).Path.Name := Name_Enter;
exit;
else
Current_Source :=
In_Tree.String_Elements.Table
(Current_Source).Next;
end if;
end loop;
In_Tree.Units.Table (Unit) := Data;
end;
end if;
return Namet.Get_Name_String (Data.File_Names (Specification).Path.Name);
end Spec_Path_Name_Of;
---------------------------
-- Ultimate_Extension_Of --
---------------------------

15
gcc/ada/prj-env.ads
View File

@ -118,12 +118,6 @@ package Prj.Env is
procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
-- Delete all temporary path files that have been created by Set_Ada_Paths
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String;
-- Returns the path of a library unit
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
@ -167,6 +161,8 @@ package Prj.Env is
In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including those
-- of imported or modified projects.
-- Only returns those directories that potentially contain Ada sources (ie
-- ignore projects that have no Ada sources
generic
with procedure Action (Path : String);
@ -176,4 +172,11 @@ package Prj.Env is
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
generic
with procedure Action (Project : Project_Id);
procedure For_All_Imported_Projects
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Execute Action for Project and all imported or extended projects
end Prj.Env;

12
gcc/ada/s-osinte-darwin.adb
View File

@ -149,6 +149,18 @@ package body System.OS_Interface is
return 0;
end sched_yield;
--------------
-- lwp_self --
--------------
function lwp_self return Address is
function pthread_mach_thread_np (thread : pthread_t) return Address;
pragma Import (C, pthread_mach_thread_np, "pthread_mach_thread_np");
begin
return pthread_mach_thread_np (pthread_self);
end lwp_self;
------------------
-- pthread_init --
------------------

6
gcc/ada/s-osinte-darwin.ads
View File

@ -236,10 +236,8 @@ package System.OS_Interface is
---------
function lwp_self return System.Address;
pragma Import (C, lwp_self, "pthread_self");
-- lwp_self does not exist on this thread library, revert to pthread_self
-- which is the closest approximation (with getpid). This function is
-- needed to share 7staprop.adb across POSIX-like targets.
-- Return the mach thread bound to the current thread. The value is not
-- used by the run-time library but made available to debuggers.
-------------
-- Threads --