procedure Add_To_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access;
Buffer_Last : in out Natural);
-- Add to Ada_Path_Buffer all the source directories in string list
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance);
-- Add to Ada_Path_B all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
Buffer : String_Access;
Buffer_Last : Natural := 0;
- procedure Add (Project : Project_Id; Dummy : in out Boolean);
+ procedure Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean);
-- Add source dirs of Project to the path
---------
-- Add --
---------
- procedure Add (Project : Project_Id; Dummy : in out Boolean) is
+ procedure Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean)
+ is
pragma Unreferenced (Dummy);
begin
- Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last);
+ Add_To_Path
+ (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
end Add;
procedure For_All_Projects is
if Project.Ada_Include_Path = null then
Buffer := new String (1 .. 4096);
- For_All_Projects (Project, Dummy);
+ For_All_Projects
+ (Project, In_Tree, Dummy, Include_Aggregated => True);
Project.Ada_Include_Path := new String'(Buffer (1 .. Buffer_Last));
Free (Buffer);
end if;
else
Buffer := new String (1 .. 4096);
- Add_To_Path (Project.Source_Dirs, In_Tree, Buffer, Buffer_Last);
+ Add_To_Path
+ (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
declare
Result : constant String := Buffer (1 .. Buffer_Last);
function Ada_Objects_Path
(Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access
is
Buffer : String_Access;
Buffer_Last : Natural := 0;
- procedure Add (Project : Project_Id; Dummy : in out Boolean);
+ procedure Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean);
-- Add all the object directories of a project to the path
---------
-- Add --
---------
- procedure Add (Project : Project_Id; Dummy : in out Boolean) is
- pragma Unreferenced (Dummy);
+ procedure Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean)
+ is
+ pragma Unreferenced (Dummy, In_Tree);
+
Path : constant Path_Name_Type :=
Get_Object_Directory
(Project,
if Project.Ada_Objects_Path = null then
Buffer := new String (1 .. 4096);
- For_All_Projects (Project, Dummy);
+ For_All_Projects (Project, In_Tree, Dummy);
Project.Ada_Objects_Path := new String'(Buffer (1 .. Buffer_Last));
Free (Buffer);
procedure Add_To_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Buffer : in out String_Access;
Buffer_Last : in out Natural)
is
Source_Dir : String_Element;
begin
while Current /= Nil_String loop
- Source_Dir := In_Tree.String_Elements.Table (Current);
+ Source_Dir := Shared.String_Elements.Table (Current);
Add_To_Path (Get_Name_String (Source_Dir.Display_Value),
Buffer, Buffer_Last);
Current := Source_Dir.Next;
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id;
- In_Tree : Project_Tree_Ref;
+ Shared : Shared_Project_Tree_Data_Access;
Source_Paths : in out Source_Path_Table.Instance)
is
Current : String_List_Id := Source_Dirs;
-- Add each source directory
while Current /= Nil_String loop
- Source_Dir := In_Tree.String_Elements.Table (Current);
+ Source_Dir := Shared.String_Elements.Table (Current);
Add_It := True;
-- Check if the source directory is already in the table
File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
- Current_Naming : Naming_Id;
- Iter : Source_Iterator;
- Source : Source_Id;
+ Current_Naming : Naming_Id;
- procedure Check (Project : Project_Id; State : in out Integer);
+ procedure Check
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ State : in out Integer);
-- Recursive procedure that put in the config pragmas file any non
-- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project.
-- Check --
-----------
- procedure Check (Project : Project_Id; State : in out Integer) is
+ procedure Check
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ State : in out Integer)
+ is
pragma Unreferenced (State);
+
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data;
+ Iter : Source_Iterator;
+ Source : Source_Id;
begin
if Current_Verbosity = High then
- Write_Str ("Checking project file """);
- Write_Str (Namet.Get_Name_String (Project.Name));
- Write_Str (""".");
- Write_Eol;
+ Debug_Output ("Checking project file:", Project.Name);
end if;
if Lang = null then
if Current_Verbosity = High then
- Write_Line (" Languages does not contain Ada, nothing to do");
+ Debug_Output ("Languages does not contain Ada, nothing to do");
end if;
return;
end if;
+ -- Visit all the files and process those that need an SFN pragma
+
+ Iter := For_Each_Source (In_Tree, Project);
+ while Element (Iter) /= No_Source loop
+ Source := Element (Iter);
+
+ if Source.Index >= 1
+ and then not Source.Locally_Removed
+ and then Source.Unit /= null
+ then
+ Put (Source);
+ end if;
+
+ Next (Iter);
+ end loop;
+
Naming := Lang.Config.Naming_Data;
-- Is the naming scheme of this project one that we know?
-- Check the naming schemes
- Check_Imported_Projects (For_Project, Dummy, Imported_First => False);
-
- -- Visit all the files and process those that need an SFN pragma
-
- Iter := For_Each_Source (In_Tree, For_Project);
- while Element (Iter) /= No_Source loop
- Source := Element (Iter);
-
- if Source.Index >= 1
- and then not Source.Locally_Removed
- and then Source.Unit /= null
- then
- Put (Source);
- end if;
-
- Next (Iter);
- end loop;
+ Check_Imported_Projects
+ (For_Project, In_Tree, Dummy, Imported_First => False);
-- If there are no non standard naming scheme, issue the GNAT
-- standard naming scheme. This will tell the compiler that
procedure Put_Name_Buffer;
-- Put the line contained in the Name_Buffer in the global buffer
- procedure Process (Project : Project_Id; State : in out Integer);
+ procedure Process
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ State : in out Integer);
-- Generate the mapping file for Project (not recursively)
---------------------
-- Process --
-------------
- procedure Process (Project : Project_Id; State : in out Integer) is
+ procedure Process
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ State : in out Integer)
+ is
pragma Unreferenced (State);
+
Source : Source_Id;
Suffix : File_Name_Type;
Iter : Source_Iterator;
begin
+ Debug_Output ("Add mapping for project", Project.Name);
Iter := For_Each_Source (In_Tree, Project, Language => Language);
loop
-- Start of processing for Create_Mapping_File
begin
- Create_Temp_File (In_Tree, File, Name, "mapping");
+ if Current_Verbosity = High then
+ Debug_Output ("Create mapping file for", Debug_Name (In_Tree));
+ end if;
+
+ Create_Temp_File (In_Tree.Shared, File, Name, "mapping");
if Current_Verbosity = High then
Debug_Increase_Indent ("Create mapping file ", Name_Id (Name));
end if;
- For_Every_Imported_Project (Project, Dummy);
+ For_Every_Imported_Project
+ (Project, In_Tree, Dummy, Include_Aggregated => False);
declare
Last : Natural;
----------------------
procedure Create_Temp_File
- (In_Tree : Project_Tree_Ref;
+ (Shared : Shared_Project_Tree_Data_Access;
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type;
File_Use : String)
& Get_Name_String (Path_Name));
end if;
- Record_Temp_File (In_Tree, Path_Name);
+ Record_Temp_File (Shared, Path_Name);
else
Prj.Com.Fail
--------------------------
procedure Create_New_Path_File
- (In_Tree : Project_Tree_Ref;
+ (Shared : Shared_Project_Tree_Data_Access;
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type)
is
begin
- Create_Temp_File (In_Tree, Path_FD, Path_Name, "path file");
+ Create_Temp_File (Shared, Path_FD, Path_Name, "path file");
end Create_New_Path_File;
------------------------------------
-- For_All_Object_Dirs --
-------------------------
- procedure For_All_Object_Dirs (Project : Project_Id) is
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
+ procedure For_All_Object_Dirs
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref)
+ is
+ procedure For_Project
+ (Prj : Project_Id;
+ Tree : Project_Tree_Ref;
+ Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
-- For_Project --
-----------------
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
- pragma Unreferenced (Dummy);
+ procedure For_Project
+ (Prj : Project_Id;
+ Tree : Project_Tree_Ref;
+ Dummy : in out Integer)
+ is
+ pragma Unreferenced (Dummy, Tree);
+
begin
-- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ?
-- Start of processing for For_All_Object_Dirs
begin
- Get_Object_Dirs (Project, Dummy);
+ Get_Object_Dirs (Project, Tree, Dummy);
end For_All_Object_Dirs;
-------------------------
(Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
+ procedure For_Project
+ (Prj : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
-- For_Project --
-----------------
- procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
+ procedure For_Project
+ (Prj : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Integer)
+ is
pragma Unreferenced (Dummy);
+
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
if Has_Ada_Sources (Project) then
while Current /= Nil_String loop
- The_String := In_Tree.String_Elements.Table (Current);
+ The_String := In_Tree.Shared.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
-- Start of processing for For_All_Source_Dirs
begin
- Get_Source_Dirs (Project, Dummy);
+ Get_Source_Dirs (Project, In_Tree, Dummy);
end For_All_Source_Dirs;
-------------------
procedure Initialize (In_Tree : Project_Tree_Ref) is
begin
- In_Tree.Private_Part.Current_Source_Path_File := No_Path;
- In_Tree.Private_Part.Current_Object_Path_File := No_Path;
+ In_Tree.Shared.Private_Part.Current_Source_Path_File := No_Path;
+ In_Tree.Shared.Private_Part.Current_Object_Path_File := No_Path;
end Initialize;
-------------------
Objects_Path : Boolean := True)
is
+ Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
+
Source_Paths : Source_Path_Table.Instance;
Object_Paths : Object_Path_Table.Instance;
-- List of source or object dirs. Only computed the first time this
Buffer : String_Access := new String (1 .. Buffer_Initial);
Buffer_Last : Natural := 0;
- procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean);
+ procedure Recursive_Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/
-- imported projects.
-- Recursive_Add --
-------------------
- procedure Recursive_Add (Project : Project_Id; Dummy : in out Boolean) is
- pragma Unreferenced (Dummy);
+ procedure Recursive_Add
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Dummy : in out Boolean)
+ is
+ pragma Unreferenced (Dummy, In_Tree);
Path : Path_Name_Type;
-- Ada sources.
if Has_Ada_Sources (Project) then
- Add_To_Source_Path (Project.Source_Dirs, In_Tree, Source_Paths);
+ Add_To_Source_Path (Project.Source_Dirs, Shared, Source_Paths);
end if;
end if;
if Include_Path and then Project.Include_Path_File = No_Path then
Source_Path_Table.Init (Source_Paths);
Process_Source_Dirs := True;
- Create_New_Path_File
- (In_Tree, Source_FD, Project.Include_Path_File);
+ Create_New_Path_File (Shared, Source_FD, Project.Include_Path_File);
end if;
-- For the object path, we make a distinction depending on
Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True;
Create_New_Path_File
- (In_Tree, Object_FD, Project.Objects_Path_File_With_Libs);
+ (Shared, Object_FD, Project.Objects_Path_File_With_Libs);
end if;
elsif Objects_Path then
Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True;
Create_New_Path_File
- (In_Tree, Object_FD, Project.Objects_Path_File_Without_Libs);
+ (Shared, Object_FD, Project.Objects_Path_File_Without_Libs);
end if;
end if;
-- then call the recursive procedure Add for Project.
if Process_Source_Dirs or Process_Object_Dirs then
- For_All_Projects (Project, Dummy);
+ For_All_Projects (Project, In_Tree, Dummy);
end if;
-- Write and close any file that has been created. Source_FD is not set
-- corresponding flags.
if Include_Path and then
- In_Tree.Private_Part.Current_Source_Path_File /=
- Project.Include_Path_File
+ Shared.Private_Part.Current_Source_Path_File /=
+ Project.Include_Path_File
then
- In_Tree.Private_Part.Current_Source_Path_File :=
+ Shared.Private_Part.Current_Source_Path_File :=
Project.Include_Path_File;
Set_Path_File_Var
(Project_Include_Path_File,
- Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
+ Get_Name_String (Shared.Private_Part.Current_Source_Path_File));
end if;
if Objects_Path then
if Including_Libraries then
- if In_Tree.Private_Part.Current_Object_Path_File /=
+ if Shared.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_With_Libs
then
- In_Tree.Private_Part.Current_Object_Path_File :=
+ Shared.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_With_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
- (In_Tree.Private_Part.Current_Object_Path_File));
+ (Shared.Private_Part.Current_Object_Path_File));
end if;
else
- if In_Tree.Private_Part.Current_Object_Path_File /=
+ if Shared.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_Without_Libs
then
- In_Tree.Private_Part.Current_Object_Path_File :=
+ Shared.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_Without_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
- (In_Tree.Private_Part.Current_Object_Path_File));
+ (Shared.Private_Part.Current_Object_Path_File));
end if;
end if;
end if;
Self.Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
+
+ if Current_Verbosity = High then
+ Debug_Output ("Adding directories to Project_Path: """
+ & Path & '"');
+ end if;
end Add_Directories;
--------------------
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path) is
begin
Free (To);
+
if From.Path /= null then
To.Path := new String'(From.Path.all);
end if;
- -- No need to copy the Cache, it will be recomputed as needed.
+ -- No need to copy the Cache, it will be recomputed as needed
+
end Copy;
end Prj.Env;
OSDN Git Service
