+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
-- 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 ..
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;
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 --
-----------------------
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 --
----------------------------------
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.
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
-- 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;
- begin
- -- Nothing to do if there is no project or if the project has already
- -- been seen or if the depth is large enough.
+ procedure Recurse (Prj : Project_Id; Depth : Natural);
- 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;
+ 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;
- Project_Tree.Projects.Table (Project).Depth := Depth;
+ -- 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,...
- -- Mark project as Seen to avoid endless loop caused by limited withs
+ Set (Seen, Prj, True);
- Project_Tree.Projects.Table (Project).Seen := True;
+ Data.Depth := Depth;
- List := Project_Tree.Projects.Table (Project).Imported_Projects;
+ List := Data.Imported_Projects;
- -- Visit each imported project
+ -- 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);
- end loop;
+ 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;
- -- Visit a project being extended, if any
+ -- We again allow changing the depth of this project later on if it
+ -- is in fact imported by a lower-level project.
- Recursive_Compute_Depth
- (Project => Project_Tree.Projects.Table (Project).Extends,
- Depth => Depth + 1);
+ Set (Seen, Prj, False);
+ end Recurse;
- -- Reset the Seen flag, as we leave this project
+ begin
+ for Proj in Project_Table.First ..
+ Project_Table.Last (Project_Tree.Projects)
+ loop
+ Project_Tree.Projects.Table (Proj).Depth := 0;
+ end loop;
- Project_Tree.Projects.Table (Project).Seen := False;
+ Recurse (Project, Depth => 1);
+ Reset (Seen);
end Recursive_Compute_Depth;
-------------------------------
(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);
-
- if not Data.Seen then
- In_Tree.Projects.Table (Proj).Seen := True;
- Imported := Data.Imported_Projects;
-
- 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;
+ 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 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;
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
-- --
-- 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- --
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 --
-----------------------
-- 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
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
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
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 --
--------------------------------
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 --
-------------------------
(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;
-------------------------
(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;
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;
-------------------
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.
-
- ---------
- -- 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; Dummy : in out Boolean);
+ -- Recursive procedure to add the source/object paths of extended/
+ -- imported projects.
- procedure Recursive_Add (Project : Project_Id) is
- begin
- -- If Seen is False, then the project has not yet been visited
+ -------------------
+ -- Recursive_Add --
+ -------------------
- 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;
+ 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
+ -- ??? This is almost the equivalent of For_All_Source_Dirs
+ if Process_Source_Dirs then
- -- Call Add for each imported project, if any
+ -- Add to path all source directories of this project if
+ -- there are Ada sources.
- 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;
+ if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
+ Add_To_Source_Path (Data.Source_Dirs, In_Tree);
end if;
- end Recursive_Add;
+ end if;
- 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);
+ if Process_Object_Dirs then
+ Path := Get_Object_Directory
+ (In_Tree, Project,
+ Including_Libraries => Including_Libraries,
+ Only_If_Ada => True);
- for Index in Project_Table.First ..
- Project_Table.Last (In_Tree.Projects)
- loop
- In_Tree.Projects.Table (Index).Seen := False;
- end loop;
+ if Path /= No_Path then
+ Add_To_Object_Path (Path, In_Tree);
+ end if;
+ end if;
+ end Recursive_Add;
- Recursive_Add (Proj);
- end Add;
+ procedure For_All_Projects is
+ new For_Every_Project_Imported (Boolean, Recursive_Add);
+ Dummy : Boolean := False;
-- Start of processing for Set_Ada_Paths
-- 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
-- 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;
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;
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;
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));
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;
-- recursively for all imported projects and a extended project, if any.
-- Then process the declarative items of the project.
- procedure Recursive_Check
- (Project : Project_Id;
+ type Recursive_Check_Data is record
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 : 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;
+ Data : in out Recursive_Check_Data);
+ -- Check_Naming_Scheme for the project
+
---------
-- Add --
---------
Current_Dir : String;
When_No_Sources : Error_Warning)
is
- begin
- -- Make sure that all projects are marked as not checked
+ Dir : aliased String := Current_Dir;
- 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);
+ 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
+ Check_All_Projects (Project, In_Tree, Data, Imported_First => True);
-- Set the Other_Part field for the units
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;
-----------------------
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;
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);
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 --
-------------------
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
---------------------
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);
+
+ if not Imported_First then
+ Action (Project, With_State);
+ end if;
+
+ -- Visited all extended projects
- List := In_Tree.Projects.Table (Project).Imported_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;
--------------
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;
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.
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);
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.
-- 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
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;
OSDN Git Service
