mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-28 21:31:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

prj-proc.adb, [...] (Project_Data.Seen): field removed.

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

	* prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb,
	clean.adb, prj-nmsc.adb, prj-env.adb, prj-env.ads (Project_Data.Seen):
	field removed. This is not a property of the
	project, just a boolean used to traverse the project tree, and storing
	it in the structure prevents doing multiple traversal in parallel.
	(Project_Data.Checked): also removed, since it was playing the same role
	as Seen when we had two nested loops, and this is no longer necessary
	(For_All_Imported_Projects): removed, since in fact there was already
	the equivalent in For_Every_Project_Imported. The latter was rewritten
	to use a local hash table instead of Project_Data.Seen
	Various loops were rewritten to use For_Every_Project_Imported, thus
	removing the need for Project_Data.Seen. This avoids a lot of code
	duplication

From-SVN: r146699
This commit is contained in:
Emmanuel Briot 2009-04-24 10:42:30 +00:00 committed by Arnaud Charlet
parent 76e776e5e8
commit 8b9890fa41
11 changed files with 476 additions and 682 deletions

16
gcc/ada/ChangeLog

@ -1,3 +1,19 @@
2009-04-24 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb,
clean.adb, prj-nmsc.adb, prj-env.adb, prj-env.ads (Project_Data.Seen):
field removed. This is not a property of the
project, just a boolean used to traverse the project tree, and storing
it in the structure prevents doing multiple traversal in parallel.
(Project_Data.Checked): also removed, since it was playing the same role
as Seen when we had two nested loops, and this is no longer necessary
(For_All_Imported_Projects): removed, since in fact there was already
the equivalent in For_Every_Project_Imported. The latter was rewritten
to use a local hash table instead of Project_Data.Seen
Various loops were rewritten to use For_Every_Project_Imported, thus
removing the need for Project_Data.Seen. This avoids a lot of code
duplication
2009-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Actuals): Do not create blocks around code

6
gcc/ada/clean.adb

@ -878,7 +878,7 @@ package body Clean is
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
if Data.Ada_Sources_Present
if Has_Ada_Sources (Data)
or else Data.Extends /= No_Project
then
for Unit in Unit_Table.First ..
@ -1028,8 +1028,8 @@ package body Clean is
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if Project_Tree.Projects.Table
(Proj).Other_Sources_Present
if Has_Foreign_Sources
(Project_Tree.Projects.Table (Proj))
then
Global_Archive := True;
exit;

197
gcc/ada/make.adb

@ -587,15 +587,9 @@ package body Make is
procedure Debug_Msg (S : String; N : Unit_Name_Type);
-- If Debug.Debug_Flag_W is set outputs string S followed by name N
procedure Recursive_Compute_Depth
(Project : Project_Id;
Depth : Natural);
procedure Recursive_Compute_Depth (Project : Project_Id);
-- Compute depth of Project and of the projects it depends on
procedure Compute_All_Imported_Projects (Project : Project_Id);
-- Compute, the list of the projects imported directly or indirectly by
-- project Project.
-----------------------
-- Gnatmake Routines --
-----------------------
@ -3717,95 +3711,6 @@ package body Make is
end if;
end Compile_Sources;
-----------------------------------
-- Compute_All_Imported_Projects --
-----------------------------------
procedure Compute_All_Imported_Projects (Project : Project_Id) is
procedure Add_To_List (Prj : Project_Id);
-- Add a project to the list All_Imported_Projects of project Project
procedure Recursive_Add_Imported (Project : Project_Id);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
-----------------
-- Add_To_List --
-----------------
procedure Add_To_List (Prj : Project_Id) is
Element : constant Project_Element :=
(Prj, Project_Tree.Projects.Table (Project).All_Imported_Projects);
List : Project_List;
begin
Project_List_Table.Increment_Last (Project_Tree.Project_Lists);
List := Project_List_Table.Last (Project_Tree.Project_Lists);
Project_Tree.Project_Lists.Table (List) := Element;
Project_Tree.Projects.Table (Project).All_Imported_Projects := List;
end Add_To_List;
----------------------------
-- Recursive_Add_Imported --
----------------------------
procedure Recursive_Add_Imported (Project : Project_Id) is
List : Project_List;
Element : Project_Element;
Prj : Project_Id;
begin
if Project /= No_Project then
-- For all the imported projects
List := Project_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop
Element := Project_Tree.Project_Lists.Table (List);
Prj := Element.Project;
-- Get the ultimate extending project
while
Project_Tree.Projects.Table (Prj).Extended_By /= No_Project
loop
Prj := Project_Tree.Projects.Table (Prj).Extended_By;
end loop;
-- If project has not yet been visited, add to list and recurse
if not Project_Tree.Projects.Table (Prj).Seen then
Project_Tree.Projects.Table (Prj).Seen := True;
Add_To_List (Prj);
Recursive_Add_Imported (Prj);
end if;
List := Element.Next;
end loop;
-- Recurse on projects being imported, if any
Recursive_Add_Imported
(Project_Tree.Projects.Table (Project).Extends);
end if;
end Recursive_Add_Imported;
begin
-- Reset the Seen flag for all projects
for Index in 1 .. Project_Table.Last (Project_Tree.Projects) loop
Project_Tree.Projects.Table (Index).Seen := False;
end loop;
-- Make sure the list is empty
Project_Tree.Projects.Table (Project).All_Imported_Projects :=
Empty_Project_List;
-- Add to the list all projects imported directly or indirectly
Recursive_Add_Imported (Project);
end Compute_All_Imported_Projects;
----------------------------------
-- Configuration_Pragmas_Switch --
----------------------------------
@ -7065,16 +6970,7 @@ package body Make is
Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project, Project_Tree);
-- Compute depth of each project
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (Proj).Seen := False;
Project_Tree.Projects.Table (Proj).Depth := 0;
end loop;
Recursive_Compute_Depth (Main_Project, Depth => 1);
Recursive_Compute_Depth (Main_Project);
-- For each project compute the list of the projects it imports
-- directly or indirectly.
@ -7082,7 +6978,7 @@ package body Make is
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Compute_All_Imported_Projects (Proj);
Compute_All_Imported_Projects (Proj, Project_Tree);
end loop;
else
@ -7632,51 +7528,56 @@ package body Make is
-- Recursive_Compute_Depth --
-----------------------------
procedure Recursive_Compute_Depth
(Project : Project_Id;
Depth : Natural)
is
List : Project_List;
Proj : Project_Id;
procedure Recursive_Compute_Depth (Project : Project_Id) is
use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recurse (Prj : Project_Id; Depth : Natural);
procedure Recurse (Prj : Project_Id; Depth : Natural) is
Data : Project_Data renames Project_Tree.Projects.Table (Prj);
List : Project_List;
Proj : Project_Id;
begin
if Data.Depth >= Depth
or Get (Seen, Prj)
then
return;
end if;
-- We need a test to avoid infinite recursions with limited withs:
-- If we have A -> B -> A, then when set level of A to n, we try and
-- set level of B to n+1, and then level of A to n + 2,...
Set (Seen, Prj, True);
Data.Depth := Depth;
List := Data.Imported_Projects;
-- Visit each imported project
while List /= Empty_Project_List loop
Proj := Project_Tree.Project_Lists.Table (List).Project;
List := Project_Tree.Project_Lists.Table (List).Next;
Recurse (Prj => Proj, Depth => Depth + 1);
end loop;
-- We again allow changing the depth of this project later on if it
-- is in fact imported by a lower-level project.
Set (Seen, Prj, False);
end Recurse;
begin
-- Nothing to do if there is no project or if the project has already
-- been seen or if the depth is large enough.
if Project = No_Project
or else Project_Tree.Projects.Table (Project).Seen
or else Project_Tree.Projects.Table (Project).Depth >= Depth
then
return;
end if;
Project_Tree.Projects.Table (Project).Depth := Depth;
-- Mark project as Seen to avoid endless loop caused by limited withs
Project_Tree.Projects.Table (Project).Seen := True;
List := Project_Tree.Projects.Table (Project).Imported_Projects;
-- Visit each imported project
while List /= Empty_Project_List loop
Proj := Project_Tree.Project_Lists.Table (List).Project;
List := Project_Tree.Project_Lists.Table (List).Next;
Recursive_Compute_Depth
(Project => Proj,
Depth => Depth + 1);
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (Proj).Depth := 0;
end loop;
-- Visit a project being extended, if any
Recursive_Compute_Depth
(Project => Project_Tree.Projects.Table (Project).Extends,
Depth => Depth + 1);
-- Reset the Seen flag, as we leave this project
Project_Tree.Projects.Table (Project).Seen := False;
Recurse (Project, Depth => 1);
Reset (Seen);
end Recursive_Compute_Depth;
-------------------------------

86
gcc/ada/makeutl.adb

@ -364,74 +364,53 @@ package body Makeutl is
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add_Linker_Options (Proj : Project_Id);
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean);
-- The recursive routine used to add linker options
----------------------------------
-- Recursive_Add_Linker_Options --
----------------------------------
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add_Linker_Options (Proj : Project_Id) is
Data : Project_Data;
procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
Data : Project_Data renames In_Tree.Projects.Table (Proj);
Linker_Package : Package_Id;
Options : Variable_Value;
Imported : Project_List;
begin
if Proj /= No_Project then
Data := In_Tree.Projects.Table (Proj);
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages,
In_Tree => In_Tree);
Options :=
Prj.Util.Value_Of
(Name => Name_Ada,
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package,
In_Tree => In_Tree);
if not Data.Seen then
In_Tree.Projects.Table (Proj).Seen := True;
Imported := Data.Imported_Projects;
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
while Imported /= Empty_Project_List loop
Recursive_Add_Linker_Options
(In_Tree.Project_Lists.Table
(Imported).Project);
Imported := In_Tree.Project_Lists.Table
(Imported).Next;
end loop;
if Proj /= Project then
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages,
In_Tree => In_Tree);
Options :=
Prj.Util.Value_Of
(Name => Name_Ada,
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package,
In_Tree => In_Tree);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
if Options /= Nil_Variable_Value then
Linker_Opts.Increment_Last;
Linker_Opts.Table (Linker_Opts.Last) :=
(Project => Proj, Options => Options.Values);
end if;
end if;
end if;
if Options /= Nil_Variable_Value then
Linker_Opts.Increment_Last;
Linker_Opts.Table (Linker_Opts.Last) :=
(Project => Proj, Options => Options.Values);
end if;
end Recursive_Add_Linker_Options;
end Recursive_Add;
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Recursive_Add);
Dummy : Boolean := False;
-- Start of processing for Linker_Options_Switches
begin
Linker_Opts.Init;
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
Recursive_Add_Linker_Options (Project);
For_All_Projects (Project, In_Tree, Dummy);
Last_Linker_Option := 0;
@ -449,8 +428,7 @@ package body Makeutl is
In_Tree.Projects.Table (Proj).Dir_Path :=
new String'
(Get_Name_String
(In_Tree.Projects.Table
(Proj).Directory.Name));
(In_Tree.Projects.Table (Proj).Directory.Name));
end if;
while Options /= Nil_String loop

2
gcc/ada/mlib-prj.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2008, AdaCore --
-- Copyright (C) 2001-2009, 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- --

459
gcc/ada/prj-env.adb

@ -30,22 +30,10 @@ with Output; use Output;
with Prj.Com; use Prj.Com;
with Tempdir;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is
Default_Naming : constant Naming_Id := Naming_Table.First;
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 --
-----------------------
@ -73,9 +61,6 @@ package body Prj.Env is
-- Add Object_Dir to object path table. Make sure it is not duplicate
-- and it is the last one in the current table.
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
-- Return True if there is at least one ALI file in the directory Dir
procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec
@ -91,70 +76,35 @@ package body Prj.Env is
function Ada_Include_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_Access is
procedure Add (Project : Project_Id);
-- Add all the source directories of a project to the path only if
-- this project has not been visited. Calls itself recursively for
-- projects being extended, and imported projects. Adds the project
-- to the list Seen if this is the call to Add for this project.
In_Tree : Project_Tree_Ref) return String_Access
is
procedure Add (Project : Project_Id; Dummy : in out Boolean);
-- Add source dirs of Project to the path
---------
-- Add --
---------
procedure Add (Project : Project_Id) is
procedure Add (Project : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
begin
-- If Seen is empty, then the project cannot have been visited
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
declare
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- Add to path all source directories of this project
Add_To_Path (Data.Source_Dirs, In_Tree);
-- Call Add to the project being extended, if any
if Data.Extends /= No_Project then
Add (Data.Extends);
end if;
-- Call Add for each imported project, if any
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;
end if;
Add_To_Path (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
end Add;
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Add);
Dummy : Boolean := False;
-- Start of processing for Ada_Include_Path
begin
-- If it is the first time we call this function for
-- this project, compute the source path
if
In_Tree.Projects.Table (Project).Ada_Include_Path = null
then
if In_Tree.Projects.Table (Project).Ada_Include_Path = null then
In_Tree.Private_Part.Ada_Path_Length := 0;
For_All_Projects (Project, In_Tree, Dummy);
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
Add (Project);
In_Tree.Projects.Table (Project).Ada_Include_Path :=
new String'
(In_Tree.Private_Part.Ada_Path_Buffer
@ -195,102 +145,40 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access
is
procedure Add (Project : Project_Id);
-- Add all the object directories of a project to the path only if
-- this project has not been visited. Calls itself recursively for
-- projects being extended, and imported projects. Adds the project
-- to the list Seen if this is the first call to Add for this project.
procedure Add (Project : Project_Id; Dummy : in out Boolean);
-- Add all the object directories of a project to the path
---------
-- Add --
---------
procedure Add (Project : Project_Id) is
procedure Add (Project : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
Path : constant Path_Name_Type :=
Get_Object_Directory
(In_Tree, Project,
Including_Libraries => Including_Libraries,
Only_If_Ada => False);
begin
-- If this project has not been seen yet
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
declare
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
-- Add to path the object directory of this project
-- except if we don't include library project and
-- this is a library project.
if (Data.Library and then Including_Libraries)
or else
(Data.Object_Directory /= No_Path_Information
and then
(not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library directory,
-- if there is no object directory or if it contains ALI
-- files; otherwise add the object directory.
if Data.Library then
if Data.Object_Directory = No_Path_Information
or else
Contains_ALI_Files (Data.Library_ALI_Dir.Name)
then
Add_To_Path
(Get_Name_String (Data.Library_ALI_Dir.Name),
In_Tree);
else
Add_To_Path
(Get_Name_String (Data.Object_Directory.Name),
In_Tree);
end if;
else
-- For a non library project, add the object directory
Add_To_Path
(Get_Name_String (Data.Object_Directory.Name),
In_Tree);
end if;
end if;
-- Call Add to the project being extended, if any
if Data.Extends /= No_Project then
Add (Data.Extends);
end if;
-- Call Add for each imported project, if any
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;
if Path /= No_Path then
Add_To_Path (Get_Name_String (Path), In_Tree);
end if;
end Add;
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Add);
Dummy : Boolean := False;
-- Start of processing for Ada_Objects_Path
begin
-- If it is the first time we call this function for
-- this project, compute the objects path
if
In_Tree.Projects.Table (Project).Ada_Objects_Path = null
then
if In_Tree.Projects.Table (Project).Ada_Objects_Path = null then
In_Tree.Private_Part.Ada_Path_Length := 0;
For_All_Projects (Project, In_Tree, Dummy);
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
Add (Project);
In_Tree.Projects.Table (Project).Ada_Objects_Path :=
new String'
(In_Tree.Private_Part.Ada_Path_Buffer
@ -495,45 +383,6 @@ package body Prj.Env is
end loop;
end Add_To_Source_Path;
------------------------
-- Contains_ALI_Files --
------------------------
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type;
Name : String (1 .. 1_000);
Last : Natural;
Result : Boolean := False;
begin
Open (Direct, Dir_Name);
-- For each file in the directory, check if it is an ALI file
loop
Read (Direct, Name, Last);
exit when Last = 0;
Canonical_Case_File_Name (Name (1 .. Last));
Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
exit when Result;
end loop;
Close (Direct);
return Result;
exception
-- If there is any problem, close the directory if open and return
-- True; the library directory will be added to the path.
when others =>
if Is_Open (Direct) then
Close (Direct);
end if;
return True;
end Contains_ALI_Files;
--------------------------------
-- Create_Config_Pragmas_File --
--------------------------------
@ -1457,56 +1306,6 @@ 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;
-- Start of processing for For_All_Imported_Projects
begin
Recurse (Project);
Reset (Seen);
end For_All_Imported_Projects;
-------------------------
-- For_All_Object_Dirs --
-------------------------
@ -1515,28 +1314,34 @@ package body Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
procedure For_Project (Prj : Project_Id);
procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
-- For_Project --
-----------------
procedure For_Project (Prj : Project_Id) is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
pragma Unreferenced (Dummy);
Data : Project_Data renames In_Tree.Projects.Table (Prj);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ?
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;
procedure Get_Object_Dirs is new For_All_Imported_Projects (For_Project);
procedure Get_Object_Dirs is
new For_Every_Project_Imported (Integer, For_Project);
Dummy : Integer := 1;
-- Start of processing for For_All_Object_Dirs
begin
Get_Object_Dirs (Project, In_Tree);
Get_Object_Dirs (Project, In_Tree, Dummy);
end For_All_Object_Dirs;
-------------------------
@ -1547,14 +1352,15 @@ package body Prj.Env is
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
procedure For_Project (Prj : Project_Id);
procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
-- For_Project --
-----------------
procedure For_Project (Prj : Project_Id) is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
pragma Unreferenced (Dummy);
Data : Project_Data renames In_Tree.Projects.Table (Prj);
Current : String_List_Id := Data.Source_Dirs;
The_String : String_Element;
@ -1572,12 +1378,14 @@ package body Prj.Env is
end if;
end For_Project;
procedure Get_Source_Dirs is new For_All_Imported_Projects (For_Project);
procedure Get_Source_Dirs is
new For_Every_Project_Imported (Integer, For_Project);
Dummy : Integer := 1;
-- Start of processing for For_All_Source_Dirs
begin
Get_Source_Dirs (Project, In_Tree);
Get_Source_Dirs (Project, In_Tree, Dummy);
end For_All_Source_Dirs;
-------------------
@ -1860,146 +1668,45 @@ package body Prj.Env is
Len : Natural;
procedure Add (Proj : Project_Id);
-- Add all the source/object directories of a project to the path only
-- if this project has not been visited. Calls an internal procedure
-- recursively for projects being extended, and imported projects.
procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/
-- imported projects.
---------
-- Add --
---------
procedure Add (Proj : Project_Id) is
procedure Recursive_Add (Project : Project_Id);
-- Recursive procedure to add the source/object paths of extended/
-- imported projects.
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add (Project : Project_Id) is
begin
-- If Seen is False, then the project has not yet been visited
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
declare
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
if Process_Source_Dirs then
-- Add to path all source directories of this project if
-- there are Ada sources.
if In_Tree.Projects.Table (Project).Ada_Sources /=
Nil_String
then
Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
end if;
if Process_Object_Dirs then
-- Add to path the object directory of this project
-- except if we don't include library project and this
-- is a library project.
if (Data.Library and Including_Libraries)
or else
(Data.Object_Directory /= No_Path_Information
and then
(not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library ALI
-- directory if there is no object directory or
-- if the library ALI directory contains ALI files;
-- otherwise add the object directory.
if Data.Library then
if Data.Object_Directory = No_Path_Information
or else Contains_ALI_Files
(Data.Library_ALI_Dir.Name)
then
Add_To_Object_Path
(Data.Library_ALI_Dir.Name, In_Tree);
else
Add_To_Object_Path
(Data.Object_Directory.Name, In_Tree);
end if;
-- For a non-library project, add object directory if
-- it is not a virtual project, and if there are Ada
-- sources in the project or one of the projects it
-- extends. If there are no Ada sources, adding the
-- object directory could disrupt the order of the
-- object dirs in the path.
elsif not Data.Virtual then
declare
Add_Object_Dir : Boolean := False;
Prj : Project_Id := Project;
begin
while not Add_Object_Dir
and then Prj /= No_Project
loop
if In_Tree.Projects.Table
(Prj).Ada_Sources /= Nil_String
then
Add_Object_Dir := True;
else
Prj :=
In_Tree.Projects.Table (Prj).Extends;
end if;
end loop;
if Add_Object_Dir then
Add_To_Object_Path
(Data.Object_Directory.Name, In_Tree);
end if;
end;
end if;
end if;
end if;
-- Call Add to the project being extended, if any
if Data.Extends /= No_Project then
Recursive_Add (Data.Extends);
end if;
-- Call Add for each imported project, if any
while List /= Empty_Project_List loop
Recursive_Add
(In_Tree.Project_Lists.Table
(List).Project);
List :=
In_Tree.Project_Lists.Table (List).Next;
end loop;
end;
end if;
end Recursive_Add;
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
Data : constant Project_Data := In_Tree.Projects.Table (Project);
Path : Path_Name_Type;
begin
Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0);
Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0);
-- ??? This is almost the equivalent of For_All_Source_Dirs
if Process_Source_Dirs then
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
-- Add to path all source directories of this project if
-- there are Ada sources.
Recursive_Add (Proj);
end Add;
if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
end if;
if Process_Object_Dirs then
Path := Get_Object_Directory
(In_Tree, Project,
Including_Libraries => Including_Libraries,
Only_If_Ada => True);
if Path /= No_Path then
Add_To_Object_Path (Path, In_Tree);
end if;
end if;
end Recursive_Add;
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Recursive_Add);
Dummy : Boolean := False;
-- Start of processing for Set_Ada_Paths
@ -2042,7 +1749,9 @@ package body Prj.Env is
-- then call the recursive procedure Add for Project.
if Process_Source_Dirs or Process_Object_Dirs then
Add (Project);
Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0);
Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0);
For_All_Projects (Project, In_Tree, Dummy);
end if;
-- Write and close any file that has been created

7
gcc/ada/prj-env.ads

@ -172,11 +172,4 @@ 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/prj-nmsc.adb

@ -5445,7 +5445,7 @@ package body Prj.Nmsc is
Read (Dir, Name_Buffer, Name_Len);
if Current_Verbosity = High then
Write_Str (" Checking ");
Write_Str (" Checking ");
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
@ -6450,7 +6450,7 @@ package body Prj.Nmsc is
if Last = Filename'Last then
if Current_Verbosity = High then
Write_Line (" No matching suffix");
Write_Line (" No matching suffix");
end if;
return;
end if;
@ -6602,9 +6602,9 @@ package body Prj.Nmsc is
and then Current_Verbosity = High
then
case Kind is
when Spec => Write_Str (" spec of ");
when Impl => Write_Str (" body of ");
when Sep => Write_Str (" sep of ");
when Spec => Write_Str (" spec of ");
when Impl => Write_Str (" body of ");
when Sep => Write_Str (" sep of ");
end case;
Write_Line (Get_Name_String (Unit));
@ -8456,7 +8456,7 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Write_Str ("Putting ");
Write_Str (" Putting ");
Write_Str (Get_Name_String (Unit_Name));
Write_Line (" in the unit list.");
end if;

89
gcc/ada/prj-proc.adb

@ -141,15 +141,18 @@ package body Prj.Proc is
-- recursively for all imported projects and a extended project, if any.
-- Then process the declarative items of the project.
type Recursive_Check_Data is record
In_Tree : Project_Tree_Ref;
Current_Dir : String_Access;
When_No_Sources : Error_Warning;
end record;
-- Data passed to Recursive_Check
-- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Current_Dir : String;
When_No_Sources : Error_Warning);
-- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
Data : in out Recursive_Check_Data);
-- Check_Naming_Scheme for the project
---------
-- Add --
@ -274,16 +277,14 @@ package body Prj.Proc is
Current_Dir : String;
When_No_Sources : Error_Warning)
is
Dir : aliased String := Current_Dir;
procedure Check_All_Projects is new
For_Every_Project_Imported (Recursive_Check_Data, Recursive_Check);
Data : Recursive_Check_Data :=
(In_Tree, Dir'Unchecked_Access, When_No_Sources);
begin
-- Make sure that all projects are marked as not checked
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Checked := False;
end loop;
Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources);
Check_All_Projects (Project, In_Tree, Data, Imported_First => True);
-- Set the Other_Part field for the units
@ -2461,55 +2462,19 @@ package body Prj.Proc is
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Current_Dir : String;
When_No_Sources : Error_Warning)
Data : in out Recursive_Check_Data)
is
Data : Project_Data;
Imported_Project_List : Project_List := Empty_Project_List;
begin
-- Do nothing if Project is No_Project, or Project has already
-- been marked as checked.
if Project /= No_Project
and then not In_Tree.Projects.Table (Project).Checked
then
-- Mark project as checked, to avoid infinite recursion in
-- ill-formed trees, where a project imports itself.
In_Tree.Projects.Table (Project).Checked := True;
Data := In_Tree.Projects.Table (Project);
-- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens).
Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
-- Call itself for all imported projects
Imported_Project_List := Data.Imported_Projects;
while Imported_Project_List /= Empty_Project_List loop
Recursive_Check
(In_Tree.Project_Lists.Table
(Imported_Project_List).Project,
In_Tree, Current_Dir, When_No_Sources);
Imported_Project_List :=
In_Tree.Project_Lists.Table
(Imported_Project_List).Next;
end loop;
if Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str (Get_Name_String (Data.Name));
Write_Line ("""");
end if;
Prj.Nmsc.Check
(Project, In_Tree, Error_Report, When_No_Sources,
Current_Dir);
if Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str
(Get_Name_String (Data.In_Tree.Projects.Table (Project).Name));
Write_Line ("""");
end if;
Prj.Nmsc.Check
(Project, Data.In_Tree, Error_Report, Data.When_No_Sources,
Data.Current_Dir.all);
end Recursive_Check;
-----------------------

229
gcc/ada/prj.adb

@ -34,6 +34,8 @@ with Snames; use Snames;
with Table;
with Uintp; use Uintp;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.Case_Util; use System.Case_Util;
with System.HTable;
@ -130,8 +132,6 @@ package body Prj is
Config_File_Name => No_Path,
Config_File_Temp => False,
Config_Checked => False,
Checked => False,
Seen => False,
Need_To_Build_Lib => False,
Depth => 0,
Unkept_Comments => False);
@ -157,6 +157,9 @@ package body Prj is
procedure Project_Changed (Iter : in out Source_Iterator);
-- Called when a new project or language was selected for this iterator.
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
-- Return True if there is at least one ALI file in the directory Dir
-------------------
-- Add_To_Buffer --
-------------------
@ -497,8 +500,11 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State)
With_State : in out State;
Imported_First : Boolean := False)
is
use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check (Project : Project_Id);
-- Check if a project has already been seen. If not seen, mark it as
@ -509,30 +515,41 @@ package body Prj is
---------------------
procedure Recursive_Check (Project : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Project);
List : Project_List;
begin
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State);
if not Get (Seen, Project) then
Set (Seen, Project, True);
List := In_Tree.Projects.Table (Project).Imported_Projects;
if not Imported_First then
Action (Project, With_State);
end if;
-- Visited all extended projects
if Data.Extends /= No_Project then
Recursive_Check (Data.Extends);
end if;
-- Visited all imported projects
List := Data.Imported_Projects;
while List /= Empty_Project_List loop
Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
if Imported_First then
Action (Project, With_State);
end if;
end if;
end Recursive_Check;
-- Start of processing for For_Every_Project_Imported
begin
for Project in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Project).Seen := False;
end loop;
Recursive_Check (Project => By);
Reset (Seen);
end For_Every_Project_Imported;
--------------
@ -1189,6 +1206,10 @@ package body Prj is
function Has_Ada_Sources (Data : Project_Data) return Boolean is
Lang : Language_Ptr := Data.Languages;
begin
if Data.Ada_Sources /= Nil_String then
return True;
end if;
while Lang /= No_Language_Index loop
if Lang.Name = Name_Ada then
return Lang.First_Source /= No_Source;
@ -1218,6 +1239,188 @@ package body Prj is
return False;
end Has_Foreign_Sources;
------------------------
-- Contains_ALI_Files --
------------------------
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type;
Name : String (1 .. 1_000);
Last : Natural;
Result : Boolean := False;
begin
Open (Direct, Dir_Name);
-- For each file in the directory, check if it is an ALI file
loop
Read (Direct, Name, Last);
exit when Last = 0;
Canonical_Case_File_Name (Name (1 .. Last));
Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
exit when Result;
end loop;
Close (Direct);
return Result;
exception
-- If there is any problem, close the directory if open and return
-- True; the library directory will be added to the path.
when others =>
if Is_Open (Direct) then
Close (Direct);
end if;
return True;
end Contains_ALI_Files;
--------------------------
-- Get_Object_Directory --
--------------------------
function Get_Object_Directory
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Including_Libraries : Boolean;
Only_If_Ada : Boolean := False) return Path_Name_Type
is
Data : Project_Data renames In_Tree.Projects.Table (Project);
begin
if (Data.Library and Including_Libraries)
or else
(Data.Object_Directory /= No_Path_Information
and then (not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library ALI directory if there is
-- no object directory or if the library ALI directory contains ALI
-- files; otherwise add the object directory.
if Data.Library then
if Data.Object_Directory = No_Path_Information
or else Contains_ALI_Files (Data.Library_ALI_Dir.Name)
then
return Data.Library_ALI_Dir.Name;
else
return Data.Object_Directory.Name;
end if;
-- For a non-library project, add object directory if it is not a
-- virtual project, and if there are Ada sources in the project or
-- one of the projects it extends. If there are no Ada sources,
-- adding the object directory could disrupt the order of the
-- object dirs in the path.
elsif not Data.Virtual then
declare
Add_Object_Dir : Boolean := not Only_If_Ada;
Prj : Project_Id := Project;
begin
while not Add_Object_Dir and then Prj /= No_Project loop
if Has_Ada_Sources (In_Tree.Projects.Table (Prj)) then
Add_Object_Dir := True;
else
Prj := In_Tree.Projects.Table (Prj).Extends;
end if;
end loop;
if Add_Object_Dir then
return Data.Object_Directory.Name;
end if;
end;
end if;
end if;
return No_Path;
end Get_Object_Directory;
-----------------------------------
-- Ultimate_Extending_Project_Of --
-----------------------------------
function Ultimate_Extending_Project_Of
(Proj : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id
is
Prj : Project_Id := Proj;
begin
while In_Tree.Projects.Table (Prj).Extended_By /= No_Project loop
Prj := In_Tree.Projects.Table (Prj).Extended_By;
end loop;
return Prj;
end Ultimate_Extending_Project_Of;
-----------------------------------
-- Compute_All_Imported_Projects --
-----------------------------------
procedure Compute_All_Imported_Projects
(Project : Project_Id; In_Tree : Project_Tree_Ref)
is
procedure Add_To_List (Prj : Project_Id);
-- Add a project to the list All_Imported_Projects of project Project
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
-----------------
-- Add_To_List --
-----------------
procedure Add_To_List (Prj : Project_Id) is
Element : constant Project_Element :=
(Prj, In_Tree.Projects.Table (Project).All_Imported_Projects);
List : Project_List;
begin
-- Check that the project is not already in the list. We know the one
-- passed to Recursive_Add have never been visited before, but the
-- one passed it are the extended projects.
List := In_Tree.Projects.Table (Project).All_Imported_Projects;
while List /= Empty_Project_List loop
if In_Tree.Project_Lists.Table (List).Project = Prj then
return;
end if;
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
-- Add it to the list
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
List := Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (List) := Element;
In_Tree.Projects.Table (Project).All_Imported_Projects := List;
end Add_To_List;
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
Prj2 : Project_Id;
begin
-- A project is not importing itself
if Project /= Prj then
Prj2 := Ultimate_Extending_Project_Of (Prj, In_Tree);
Add_To_List (Prj2);
end if;
end Recursive_Add;
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Recursive_Add);
Dummy : Boolean := False;
begin
In_Tree.Projects.Table (Project).All_Imported_Projects :=
Empty_Project_List;
For_All_Projects (Project, In_Tree, Dummy);
end Compute_All_Imported_Projects;
begin
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.

55
gcc/ada/prj.ads

@ -906,6 +906,29 @@ package Prj is
Naming : in out Naming_Data;
Suffix : File_Name_Type);
function Get_Object_Directory
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Including_Libraries : Boolean;
Only_If_Ada : Boolean := False) return Path_Name_Type;
-- Return the object directory to use for the project. This depends on
-- whether we have a library project or a standard project. This function
-- might return No_Name when no directory applies.
-- If we have a a library project file and Including_Libraries is True then
-- the library dir is returned instead of the object dir.
-- If Only_If_Ada is True, then No_Name will be returned when the project
-- doesn't Ada sources.
procedure Compute_All_Imported_Projects
(Project : Project_Id; In_Tree : Project_Tree_Ref);
-- Compute, the list of the projects imported directly or indirectly by
-- project Project. The result is stored in Project.All_Imported_Projects
function Ultimate_Extending_Project_Of
(Proj : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id;
-- Returns the ultimate extending project of project Proj. If project Proj
-- is not extended, returns Proj.
function Standard_Naming_Data
(Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
pragma Inline (Standard_Naming_Data);
@ -1310,14 +1333,6 @@ package Prj is
Config_Checked : Boolean := False;
-- A flag to avoid checking repetitively the configuration pragmas file
Checked : Boolean := False;
-- A flag to avoid checking repetitively the naming scheme of this
-- project file.
Seen : Boolean := False;
-- A flag to mark a project as "visited" to avoid processing the same
-- project several time.
Depth : Natural := 0;
-- The maximum depth of a project in the project graph. Depth of main
-- project is 0.
@ -1496,6 +1511,16 @@ package Prj is
-- Otherwise, this information will be automatically added to Naming_Data
-- when a project is processed, in the lists Spec_Suffix and Body_Suffix.
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.
generic
type State is limited private;
with procedure Action
@ -1504,15 +1529,19 @@ package Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State);
With_State : in out State;
Imported_First : Boolean := False);
-- Call Action for each project imported directly or indirectly by project
-- By. Action is called according to the order of importation: if A
-- By, as well as extended projects.
-- The order of processing depends on Imported_First:
-- If False, Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. If two projects import each other directly or
-- indirectly (using at least one "limited with"), it is not specified
-- for which of these two projects Action will be called first. Projects
-- that are extended by other projects are not considered. With_State may
-- be used by Action to choose a behavior or to report some global result.
-- for which of these two projects Action will be called first.
-- The order is reversed if Imported_First is True.
-- With_State may be used by Action to choose a behavior or to report some
-- global result.
function Extend_Name
(File : File_Name_Type;