+2009-04-29 Bob Duff <duff@adacore.com>
+
+ * exp_ch7.adb (Build_Final_List): For an access type that designates a
+ Taft Amendment type, if the access type needs finalization, make sure
+ the implicit with clause for List_Controller occurs on the package spec.
+
+ * rtsfind.adb (Text_IO_Kludge): Fine tune the creation of implicit
+ with's created for the pseudo-children of Text_IO and friends. In
+ particular, avoid cycles, such as Ada.Wide_Text_IO.Integer_IO and
+ Ada.Text_IO.Integer_IO both with-ing each other.
+
+ * sem.adb (Walk_Library_Items): Suppress assertion failure in certain
+ oddball cases when pragma Extend_System is used.
+
+ * sem_ch12.adb (Get_Associated_Node): Prevent direct 'with' cycles in
+ the case where a package spec instantiates a generic whose body with's
+ this package, so Walk_Library_Items won't complain about cyclic with's.
+
+2009-04-29 Emmanuel Briot <briot@adacore.com>
+
+ * gnatcmd.adb, prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads,
+ prj-pp.adb, prj-pp.ads, makeutl.adb, clean.adb, prj-nmsc.adb,
+ mlib-tgt.adb, mlib-tgt.ads, prj-util.adb, prj-env.adb, prj-env.ads
+ (Project_Id): now a real pointer to Project_Data, instead of an index
+ into the Projects_Table. This simplifies the API significantly, avoiding
+ extra lookups in this table and the need to pass the Project_Tree_Ref
+ parameter in several cases
+
2009-04-29 Nicolas Setton <setton@adacore.com>
* gcc-interface/Makefile.in: Produce .dSYM files for shared libs on
procedure Clean_Archive (Project : Project_Id; Global : Boolean) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
- Data : constant Project_Data := Project_Tree.Projects.Table (Project);
-
Lib_Prefix : String_Access;
Archive_Name : String_Access;
-- The name of the archive file for this project
-- The name of the archive dependency file for this project
Obj_Dir : constant String :=
- Get_Name_String (Data.Object_Directory.Display_Name);
+ Get_Name_String (Project.Object_Directory.Display_Name);
begin
Change_Dir (Obj_Dir);
if Global then
Lib_Prefix :=
- new String'("lib" & Get_Name_String (Data.Display_Name));
+ new String'("lib" & Get_Name_String (Project.Display_Name));
else
Lib_Prefix :=
- new String'("lib" & Get_Name_String (Data.Library_Name));
+ new String'("lib" & Get_Name_String (Project.Library_Name));
end if;
Archive_Name := new String'(Lib_Prefix.all & '.' & Archive_Ext);
procedure Clean_Interface_Copy_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir;
- Data : constant Project_Data := Project_Tree.Projects.Table (Project);
Direc : Dir_Type;
Unit : Unit_Data;
begin
- if Data.Library and then Data.Library_Src_Dir /= No_Path_Information then
+ if Project.Library
+ and then Project.Library_Src_Dir /= No_Path_Information
+ then
declare
Directory : constant String :=
- Get_Name_String (Data.Library_Src_Dir.Display_Name);
+ Get_Name_String (Project.Library_Src_Dir.Display_Name);
begin
Change_Dir (Directory);
procedure Clean_Library_Directory (Project : Project_Id) is
Current : constant String := Get_Current_Dir;
- Data : constant Project_Data := Project_Tree.Projects.Table (Project);
- Lib_Filename : constant String := Get_Name_String (Data.Library_Name);
+ Lib_Filename : constant String := Get_Name_String (Project.Library_Name);
DLL_Name : String :=
DLL_Prefix & Lib_Filename & "." & DLL_Ext;
Archive_Name : String :=
Major : String_Access := Empty_String'Access;
begin
- if Data.Library then
- if Data.Library_Kind /= Static
+ if Project.Library then
+ if Project.Library_Kind /= Static
and then MLib.Tgt.Library_Major_Minor_Id_Supported
- and then Data.Lib_Internal_Name /= No_Name
+ and then Project.Lib_Internal_Name /= No_Name
then
- Minor := new String'(Get_Name_String (Data.Lib_Internal_Name));
+ Minor := new String'(Get_Name_String (Project.Lib_Internal_Name));
Major := new String'(MLib.Major_Id_Name (DLL_Name, Minor.all));
end if;
declare
Lib_Directory : constant String :=
Get_Name_String
- (Data.Library_Dir.Display_Name);
+ (Project.Library_Dir.Display_Name);
Lib_ALI_Directory : constant String :=
Get_Name_String
- (Data.Library_ALI_Dir.Display_Name);
+ (Project.Library_ALI_Dir.Display_Name);
begin
Canonical_Case_File_Name (Archive_Name);
declare
Filename : constant String := Name (1 .. Last);
+
begin
if Is_Regular_File (Filename)
or else Is_Symbolic_Link (Filename)
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
- if (Data.Library_Kind = Static
- and then Name (1 .. Last) = Archive_Name)
+ if (Project.Library_Kind = Static
+ and then Name (1 .. Last) = Archive_Name)
or else
- ((Data.Library_Kind = Dynamic or else
- Data.Library_Kind = Relocatable)
+ ((Project.Library_Kind = Dynamic
+ or else
+ Project.Library_Kind = Relocatable)
and then
(Name (1 .. Last) = DLL_Name
- or else Name (1 .. Last) = Minor.all
- or else Name (1 .. Last) = Major.all))
+ or else
+ Name (1 .. Last) = Minor.all
+ or else
+ Name (1 .. Last) = Major.all))
then
if not Do_Nothing then
Set_Writable (Filename);
if Unit.File_Names (Body_Part).Project /=
No_Project
then
- if Ultimate_Extension_Of
+ if Ultimate_Extension_Of
(Unit.File_Names (Body_Part).Project) =
Project
then
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
- Data : constant Project_Data :=
- Project_Tree.Projects.Table (Project);
U_Data : Unit_Data;
File_Name1 : File_Name_Type;
Index1 : Int;
if Project = Main_Project
and then Osint.Number_Of_Files /= 0
- and then Data.Library
+ and then Project.Library
then
Osint.Fail
("Cannot specify executable(s) for a Library Project File");
-- Nothing to clean in an externally built project
- if Data.Externally_Built then
+ if Project.Externally_Built then
if Verbose_Mode then
Put ("Nothing to do to clean externally built project """);
- Put (Get_Name_String (Data.Name));
+ Put (Get_Name_String (Project.Name));
Put_Line ("""");
end if;
else
if Verbose_Mode then
Put ("Cleaning project """);
- Put (Get_Name_String (Data.Name));
+ Put (Get_Name_String (Project.Name));
Put_Line ("""");
end if;
Processed_Projects.Increment_Last;
Processed_Projects.Table (Processed_Projects.Last) := Project;
- if Data.Object_Directory /= No_Path_Information then
+ if Project.Object_Directory /= No_Path_Information then
declare
Obj_Dir : constant String :=
Get_Name_String
- (Data.Object_Directory.Display_Name);
+ (Project.Object_Directory.Display_Name);
begin
Change_Dir (Obj_Dir);
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
- if Has_Ada_Sources (Data)
- or else Data.Extends /= No_Project
+ if Has_Ada_Sources (Project)
+ or else Project.Extends /= No_Project
then
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
-- Check if a global archive and it dependency file could have
-- been created and, if they exist, delete them.
- if Project = Main_Project and then not Data.Library then
+ if Project = Main_Project and then not Project.Library then
Global_Archive := False;
- for Proj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Has_Foreign_Sources
- (Project_Tree.Projects.Table (Proj))
- then
- Global_Archive := True;
- exit;
- end if;
- end loop;
+ declare
+ Proj : Project_List;
+
+ begin
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Has_Foreign_Sources (Proj.Project) then
+ Global_Archive := True;
+ exit;
+ end if;
+
+ Proj := Proj.Next;
+ end loop;
+ end;
if Global_Archive then
Clean_Archive (Project, Global => True);
-- The directories are cleaned only if switch -c is not specified
- if Data.Library then
+ if Project.Library then
if not Compile_Only then
Clean_Library_Directory (Project);
- if Data.Library_Src_Dir /= No_Path_Information then
+ if Project.Library_Src_Dir /= No_Path_Information then
Clean_Interface_Copy_Directory (Project);
end if;
end if;
- if Data.Standalone_Library and then
- Data.Object_Directory /= No_Path_Information
+ if Project.Standalone_Library and then
+ Project.Object_Directory /= No_Path_Information
then
Delete_Binder_Generated_Files
- (Get_Name_String (Data.Object_Directory.Display_Name),
- File_Name_Type (Data.Library_Name));
+ (Get_Name_String (Project.Object_Directory.Display_Name),
+ File_Name_Type (Project.Library_Name));
end if;
end if;
-- For each imported project, call Clean_Project if the project
-- has not been processed already.
- Imported := Data.Imported_Projects;
+ Imported := Project.Imported_Projects;
while Imported /= null loop
Process := True;
-- called before, because no other project may import or extend
-- this project.
- if Data.Extends /= No_Project then
- Clean_Project (Data.Extends);
+ if Project.Extends /= No_Project then
+ Clean_Project (Project.Extends);
end if;
end;
end if;
-- The executables are deleted only if switch -c is not specified
if Project = Main_Project
- and then Data.Exec_Directory /= No_Path_Information
+ and then Project.Exec_Directory /= No_Path_Information
then
declare
Exec_Dir : constant String :=
- Get_Name_String (Data.Exec_Directory.Display_Name);
+ Get_Name_String (Project.Exec_Directory.Display_Name);
begin
Change_Dir (Exec_Dir);
end;
end if;
- if Data.Object_Directory /= No_Path_Information then
+ if Project.Object_Directory /= No_Path_Information then
Delete_Binder_Generated_Files
- (Get_Name_String (Data.Object_Directory.Display_Name),
+ (Get_Name_String (Project.Object_Directory.Display_Name),
Strip_Suffix (Main_Source_File));
end if;
end loop;
-- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree);
- Add_Object_Directories (Main_Project, Project_Tree);
+ Add_Object_Directories (Main_Project);
end if;
Osint.Add_Default_Search_Dirs;
if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
declare
- Value : String_List_Id :=
- Project_Tree.Projects.Table (Main_Project).Mains;
Main : String_Element;
+ Value : String_List_Id := Main_Project.Mains;
begin
while Value /= Prj.Nil_String loop
Main := Project_Tree.String_Elements.Table (Value);
(Of_Project : Project_Id;
Prj : Project_Id) return Boolean
is
- Data : Project_Data;
+ Proj : Project_Id;
begin
if Prj = No_Project or else Of_Project = No_Project then
return True;
end if;
- Data := Project_Tree.Projects.Table (Of_Project);
-
- while Data.Extends /= No_Project loop
- if Data.Extends = Prj then
+ Proj := Of_Project;
+ while Proj.Extends /= No_Project loop
+ if Proj.Extends = Prj then
return True;
end if;
- Data := Project_Tree.Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
- Data := Project_Tree.Projects.Table (Prj);
-
- while Data.Extends /= No_Project loop
- if Data.Extends = Of_Project then
+ Proj := Prj;
+ while Proj.Extends /= No_Project loop
+ if Proj.Extends = Of_Project then
return True;
end if;
- Data := Project_Tree.Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
return False;
function Ultimate_Extension_Of (Project : Project_Id) return Project_Id is
Result : Project_Id := Project;
- Data : Project_Data;
begin
if Project /= No_Project then
loop
- Data := Project_Tree.Projects.Table (Result);
- exit when Data.Extended_By = No_Project;
- Result := Data.Extended_By;
+ exit when Result.Extended_By = No_Project;
+ Result := Result.Extended_By;
end loop;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
New_Reference_To
(RTE (RE_List_Controller), Loc));
+ if Has_Completion_In_Body (Directly_Designated_Type (Typ))
+ and then In_Package_Body (Current_Scope)
+ and then
+ Nkind (Parent (Declaration_Node (Typ))) = N_Package_Specification
+ then
+ -- The type is declared in a package declaration and designates a
+ -- Taft amendment type that requires finalization. In general we
+ -- assume that TA types are controlled, but we inhibit this
+ -- worst-case assumption for runtime files, for efficiency reasons
+ -- (see exp_ch3.adb). The reference to RE_List_Controller may have
+ -- added a with_clause to the current body. Formally the spec needs
+ -- the with_clause as well, so we add it now, for use by codepeer.
+
+ declare
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Spec_Unit : constant Node_Id :=
+ Library_Unit (Cunit (Current_Sem_Unit));
+ List_Scope : constant Entity_Id :=
+ Scope (RTE (RE_List_Controller));
+ With_Clause : constant Node_Id :=
+ Make_With_Clause (Loc,
+ Name => New_Occurrence_Of (List_Scope, Loc));
+ begin
+ Set_Library_Unit
+ (With_Clause, Parent (Unit_Declaration_Node (List_Scope)));
+ Set_Corresponding_Spec (With_Clause, List_Scope);
+ Set_Implicit_With (With_Clause);
+ Append (With_Clause, Context_Items (Spec_Unit));
+ end;
+ end if;
+
-- The type may have been frozen already, and this is a late freezing
-- action, in which case the declaration must be elaborated at once.
-- If the call is for an allocator, the chain must also be created now,
if Add_Sources then
declare
Current_Last : constant Integer := Last_Switches.Last;
+ Proj : Project_List;
+
begin
-- Gnatstack needs to add the .ci file for the binder
-- generated files corresponding to all of the library projects
-- and main units belonging to the application.
if The_Command = Stack then
- for Proj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Check_Project (Proj, Project) then
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Check_Project (Proj.Project, Project) then
declare
- Data : Project_Data renames
- Project_Tree.Projects.Table (Proj);
- Main : String_List_Id := Data.Mains;
+ Main : String_List_Id := Proj.Project.Mains;
File : String_Access;
begin
while Main /= Nil_String loop
File :=
new String'
- (Get_Name_String (Data.Object_Directory.Name) &
+ (Get_Name_String
+ (Proj.Project.Object_Directory.Name) &
Directory_Separator &
B_Start.all &
MLib.Fil.Ext_To
Project_Tree.String_Elements.Table (Main).Next;
end loop;
- if Data.Library then
+ if Proj.Project.Library then
-- Include the .ci file for the binder generated
-- files that contains the initialization and
File :=
new String'
- (Get_Name_String (Data.Object_Directory.Name) &
+ (Get_Name_String
+ (Proj.Project.Object_Directory.Name) &
Directory_Separator &
B_Start.all &
- Get_Name_String (Data.Library_Name) &
+ Get_Name_String (Proj.Project.Library_Name) &
".ci");
if Is_Regular_File (File.all) then
end if;
end;
end if;
+
+ Proj := Proj.Next;
end loop;
end if;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
- (Project_Tree.Projects.Table
- (Unit_Data.File_Names
- (Body_Part).Project).
+ (Unit_Data.File_Names
+ (Body_Part).Project.
Object_Directory.Name) &
Directory_Separator &
MLib.Fil.Ext_To
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
- (Project_Tree.Projects.Table
- (Unit_Data.File_Names
- (Specification).Project).
+ (Unit_Data.File_Names
+ (Specification).Project.
Object_Directory.Name) &
Dir_Separator &
MLib.Fil.Ext_To
(Project : Project_Id;
Root_Project : Project_Id) return Boolean
is
+ Proj : Project_Id;
+
begin
if Project = No_Project then
return False;
return True;
elsif The_Command = Metric then
- declare
- Data : Project_Data;
-
- begin
- Data := Project_Tree.Projects.Table (Root_Project);
- while Data.Extends /= No_Project loop
- if Project = Data.Extends then
- return True;
- end if;
+ Proj := Root_Project;
+ while Proj.Extends /= No_Project loop
+ if Project = Proj.Extends then
+ return True;
+ end if;
- Data := Project_Tree.Projects.Table (Data.Extends);
- end loop;
- end;
+ Proj := Proj.Extends;
+ end loop;
end if;
return False;
end if;
end loop;
- Get_Name_String (Project_Tree.Projects.Table
- (Project).Exec_Directory.Name);
+ Get_Name_String (Project.Exec_Directory.Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
begin
Prj.Env.Create_Config_Pragmas_File
(Project, Project, Project_Tree, Include_Config_Files => False);
- return Project_Tree.Projects.Table (Project).Config_File_Name;
+ return Project.Config_File_Name;
end Configuration_Pragmas_File;
------------------------------
procedure Delete_Temp_Config_Files is
Success : Boolean;
+ Proj : Project_List;
pragma Warnings (Off, Success);
begin
pragma Assert (not Keep_Temporary_Files);
if Project /= No_Project then
- for Prj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if
- Project_Tree.Projects.Table (Prj).Config_File_Temp
- then
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Proj.Project.Config_File_Temp then
if Verbose_Mode then
Output.Write_Str ("Deleting temp configuration file """);
Output.Write_Str
- (Get_Name_String
- (Project_Tree.Projects.Table
- (Prj).Config_File_Name));
+ (Get_Name_String (Proj.Project.Config_File_Name));
Output.Write_Line ("""");
end if;
Delete_File
- (Name =>
- Get_Name_String
- (Project_Tree.Projects.Table (Prj).Config_File_Name),
+ (Name => Get_Name_String (Proj.Project.Config_File_Name),
Success => Success);
end if;
+
+ Proj := Proj.Next;
end loop;
end if;
-- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= None then
- Set_Libraries (Project, Project_Tree, Libraries_Present);
+ Set_Libraries (Project, Libraries_Present);
end if;
-- If there are, add the necessary additional switches
Project_Loop : loop
declare
Dir : constant String :=
- Get_Name_String
- (Project_Tree.Projects.Table
- (Prj).Object_Directory.Name);
+ Get_Name_String (Prj.Object_Directory.Name);
begin
if Is_Regular_File
(Dir &
-- Go to the project being extended, if any
- Prj :=
- Project_Tree.Projects.Table (Prj).Extends;
+ Prj := Prj.Extends;
exit Project_Loop when Prj = No_Project;
end loop Project_Loop;
end if;
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'("-o");
- Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Exec_Directory.Name);
+ Get_Name_String (Project.Exec_Directory.Name);
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Name_Buffer (1 .. Name_Len) &
begin
-- Case of library project
- if Project_Tree.Projects.Table (Project).Library then
+ if Project.Library then
Libraries_Present := True;
-- Add the -L switch
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
- new String'("-L" &
- Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Library_Dir.Name));
+ new String'("-L" & Get_Name_String (Project.Library_Dir.Name));
-- Add the -l switch
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
- new String'("-l" &
- Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Library_Name));
+ new String'("-l" & Get_Name_String (Project.Library_Name));
-- Add the directory to table Library_Paths, to be processed later
-- if library is not static and if Path_Option is not null.
- if Project_Tree.Projects.Table (Project).Library_Kind /=
- Static
+ if Project.Library_Kind /= Static
and then Path_Option /= null
then
Library_Paths.Increment_Last;
Library_Paths.Table (Library_Paths.Last) :=
- new String'(Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Library_Dir.Name));
+ new String'(Get_Name_String (Project.Library_Dir.Name));
end if;
end if;
end Set_Library_For;
-- file and if there is one, get the switches, if any, and scan them.
declare
- Data : constant Prj.Project_Data :=
- Project_Tree.Projects.Table (Project);
-
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Tool_Package_Name,
- In_Packages => Data.Decl.Packages,
+ In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Element : Package_Element;
or else The_Command = Link
or else The_Command = Elim
then
- Change_Dir
- (Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Object_Directory.Name));
+ Change_Dir (Get_Name_String (Project.Object_Directory.Name));
end if;
-- Set up the env vars for project path files
-- Carg_Switches table.
declare
- Data : constant Prj.Project_Data :=
- Project_Tree.Projects.Table (Project);
-
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Compiler,
- In_Packages => Data.Decl.Packages,
+ In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Element : Package_Element;
(Last_Switches.Table (J), Current_Work_Dir);
end loop;
- Get_Name_String
- (Project_Tree.Projects.Table (Project).Directory.Name);
+ Get_Name_String (Project.Directory.Name);
declare
Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
elsif The_Command = Stub then
declare
- Data : constant Prj.Project_Data :=
- Project_Tree.Projects.Table (Project);
File_Index : Integer := 0;
Dir_Index : Integer := 0;
Last : constant Integer := Last_Switches.Last;
-- indicate to gnatstub the name of the body file with
-- a -o switch.
- if Body_Suffix_Id_Of (Project_Tree, Name_Ada, Data.Naming) /=
+ if Body_Suffix_Id_Of (Project_Tree, Name_Ada, Project.Naming) /=
Prj.Default_Ada_Spec_Suffix
then
if File_Index /= 0 then
begin
Get_Name_String
(Spec_Suffix_Id_Of
- (Project_Tree, Name_Ada, Data.Naming));
+ (Project_Tree, Name_Ada, Project.Naming));
if Spec'Length > Name_Len
and then Spec (Last - Name_Len + 1 .. Last) =
Last := Last - Name_Len;
Get_Name_String
(Body_Suffix_Id_Of
- (Project_Tree, Name_Ada, Data.Naming));
+ (Project_Tree, Name_Ada, Project.Naming));
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'("-o");
-- if there is no object directory available.
if The_Command = Metric
- and then
- Project_Tree.Projects.Table (Project).Object_Directory /=
- No_Path_Information
+ and then Project.Object_Directory /= No_Path_Information
then
First_Switches.Increment_Last;
First_Switches.Table (2 .. First_Switches.Last) :=
First_Switches.Table (1 .. First_Switches.Last - 1);
First_Switches.Table (1) :=
new String'("-d=" &
- Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Object_Directory.Name));
+ Get_Name_String (Project.Object_Directory.Name));
end if;
-- For gnat check, -rules and the following switches need to be the
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.OS_Lib; use GNAT.OS_Lib;
-- Mapping files
-----------------
- type Temp_Path_Names is
- array (Project_Id range <>, Positive range <>) of Path_Name_Type;
-
+ type Temp_Path_Names is array (Positive range <>) of Path_Name_Type;
type Temp_Path_Ptr is access Temp_Path_Names;
- type Indices is array (Project_Id range <>) of Natural;
+ type Free_File_Indices is array (Positive range <>) of Positive;
+ type Free_Indices_Ptr is access Free_File_Indices;
- type Indices_Ptr is access Indices;
+ type Project_Compilation_Data is record
+ Mapping_File_Names : Temp_Path_Ptr;
+ -- The name ids of the temporary mapping files used. This is indexed
+ -- on the maximum number of compilation processes we will be spawning
+ -- (-j parameter)
- type Free_File_Indices is array
- (Project_Id range <>, Positive range <>) of Positive;
+ Last_Mapping_File_Names : Natural;
+ -- Index of the last mapping file created for this project
- type Free_Indices_Ptr is access Free_File_Indices;
+ Free_Mapping_File_Indices : Free_Indices_Ptr;
+ -- Indices in Mapping_File_Names of the mapping file names that can be
+ -- reused for subsequent compilations.
- The_Mapping_File_Names : Temp_Path_Ptr;
- -- For each project, the name ids of the temporary mapping files used
+ Last_Free_Indices : Natural;
+ -- Number of mapping files that can be reused
+ end record;
+ -- Information necessary when compiling a project
- Last_Mapping_File_Names : Indices_Ptr;
- -- For each project, the index of the last mapping file created
+ type Project_Compilation_Access is access Project_Compilation_Data;
- The_Free_Mapping_File_Indices : Free_Indices_Ptr;
- -- For each project, the indices in The_Mapping_File_Names of the mapping
- -- file names that can be reused for subsequent compilations.
+ package Project_Compilation_Htable is new Simple_HTable
+ (Header_Num => Prj.Header_Num,
+ Element => Project_Compilation_Access,
+ No_Element => null,
+ Key => Project_Id,
+ Hash => Prj.Hash,
+ Equal => "=");
- Last_Free_Indices : Indices_Ptr;
- -- For each project, the number of mapping files that can be reused
+ Project_Compilation : Project_Compilation_Htable.Instance;
Gnatmake_Mapping_File : String_Access := null;
-- The path name of a mapping file specified by switch -C=
-- which ensures that Debug_Flag_N is False.
procedure Init_Mapping_File
- (Project : Project_Id;
+ (Project : Project_Id;
+ Data : in out Project_Compilation_Data;
File_Index : in out Natural);
-- Create a new temporary mapping file, and fill it with the project file
-- mappings, when using project file(s). The out parameter File_Index is
Add_Lib_Search_Dir (Normalize_Pathname (Path));
else
- Get_Name_String
- (Project_Tree.Projects.Table (Main_Project).Directory.Display_Name);
+ Get_Name_String (Main_Project.Directory.Display_Name);
Add_Lib_Search_Dir
(Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
end if;
Add_Src_Search_Dir (Normalize_Pathname (Path));
else
- Get_Name_String
- (Project_Tree.Projects.Table (Main_Project).Directory.Display_Name);
+ Get_Name_String (Main_Project.Directory.Display_Name);
Add_Src_Search_Dir
(Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
end if;
(Source_File => Name_Find,
Source_File_Name => File_Name,
Source_Index => Index,
- Naming => Project_Tree.Projects.Table
- (Main_Project).Naming,
+ Naming => Main_Project.Naming,
In_Package => The_Package,
Allow_ALI => Program = Binder or else Program = Linker);
if Project_Of_Current_Object_Directory /= Actual_Project then
Project_Of_Current_Object_Directory := Actual_Project;
- Object_Directory :=
- Project_Tree.Projects.Table (Actual_Project).Object_Directory.Name;
+ Object_Directory := Actual_Project.Object_Directory.Name;
-- Set the working directory to the object directory of the actual
-- project.
if Verbose_Mode then
Write_Str ("Changing to object directory of """);
- Write_Name
- (Project_Tree.Projects.Table (Actual_Project).Display_Name);
+ Write_Name (Actual_Project.Display_Name);
Write_Str (""": """);
Write_Name (Object_Directory);
Write_Line ("""");
when Directory_Error =>
Make_Failed ("unable to change to object directory """ &
Path_Or_File_Name
- (Project_Tree.Projects.Table
- (Actual_Project).Object_Directory.Name) &
+ (Actual_Project.Object_Directory.Name) &
""" of project " &
- Get_Name_String (Project_Tree.Projects.Table
- (Actual_Project).Display_Name));
+ Get_Name_String (Actual_Project.Display_Name));
end Change_To_Object_Directory;
-----------
Obj_Dir := Name_Find;
- while ALI_Project /= No_Project and then
- Obj_Dir /=
- Project_Tree.Projects.Table
- (ALI_Project).Object_Directory.Name
+ while ALI_Project /= No_Project
+ and then Obj_Dir /= ALI_Project.Object_Directory.Name
loop
- ALI_Project :=
- Project_Tree.Projects.Table (ALI_Project).Extended_By;
+ ALI_Project := ALI_Project.Extended_By;
end loop;
end;
-- If the ALI project is not extended, then it must be in
-- the correct object directory.
- if Project_Tree.Projects.Table (ALI_Project).Extended_By =
- No_Project
- then
+ if ALI_Project.Extended_By = No_Project then
return;
end if;
Num_Ext := 0;
Proj := ALI_Project;
loop
- Proj := Project_Tree.Projects.Table (Proj).Extended_By;
+ Proj := Proj.Extended_By;
exit when Proj = No_Project;
Num_Ext := Num_Ext + 1;
end loop;
begin
Proj := ALI_Project;
for J in Projects'Range loop
- Proj := Project_Tree.Projects.Table (Proj).Extended_By;
+ Proj := Proj.Extended_By;
Projects (J) := Proj;
end loop;
Get_Name_String (Source_File);
Compiler_Package : Prj.Package_Id;
Switches : Prj.Variable_Value;
- Data : Project_Data;
begin
Prj.Env.
if Arguments_Project = No_Project then
Add_Arguments (The_Saved_Gcc_Switches.all);
- elsif not Project_Tree.Projects.Table
- (Arguments_Project).Externally_Built
- then
+ elsif not Arguments_Project.Externally_Built then
-- We get the project directory for the relative path
-- switches and arguments.
Arguments_Project := Ultimate_Extending_Project_Of
- (Arguments_Project, Project_Tree);
- Data := Project_Tree.Projects.Table (Arguments_Project);
+ (Arguments_Project);
-- If building a dynamic or relocatable library, compile with
-- PIC option, if it exists.
- if Data.Library and then Data.Library_Kind /= Static then
+ if Arguments_Project.Library
+ and then Arguments_Project.Library_Kind /= Static
+ then
declare
PIC : constant String := MLib.Tgt.PIC_Option;
Compiler_Package :=
Prj.Util.Value_Of
(Name => Name_Compiler,
- In_Packages => Data.Decl.Packages,
+ In_Packages => Arguments_Project.Decl.Packages,
In_Tree => Project_Tree);
if Compiler_Package /= No_Package then
(Source_File => Source_File,
Source_File_Name => Source_File_Name,
Source_Index => Source_Index,
- Naming => Data.Naming,
+ Naming => Arguments_Project.Naming,
In_Package => Compiler_Package,
Allow_ALI => False);
declare
New_Args : Argument_List (1 .. Number);
Last_New : Natural := 0;
- Dir_Path : constant String :=
- Get_Name_String (Data.Directory.Name);
+ Dir_Path : constant String := Get_Name_String
+ (Arguments_Project.Directory.Name);
begin
Current := Switches.Values;
(1 => new String'
(Name_Buffer (1 .. Name_Len)));
Dir_Path : constant String :=
- Get_Name_String (Data.Directory.Name);
+ Get_Name_String (Arguments_Project.Directory.Name);
begin
Test_If_Relative_Path
is
Pid : Process_Id;
Project : Project_Id;
+ Data : Project_Compilation_Access;
begin
pragma Assert (Outstanding_Compiles > 0);
-- get its file name for reuse by a subsequent compilation
if Running_Compile (J).Mapping_File /= No_Mapping_File then
- Last_Free_Indices (Project) :=
- Last_Free_Indices (Project) + 1;
- The_Free_Mapping_File_Indices
- (Project, Last_Free_Indices (Project)) :=
+ Data := Project_Compilation_Htable.Get
+ (Project_Compilation, Project);
+ Data.Last_Free_Indices := Data.Last_Free_Indices + 1;
+ Data.Free_Mapping_File_Indices (Data.Last_Free_Indices) :=
Running_Compile (J).Mapping_File;
end if;
-- check for an eventual library project, and use the full path.
if Arguments_Project /= No_Project then
- if not Project_Tree.Projects.Table
- (Arguments_Project).Externally_Built
- then
+ if not Arguments_Project.Externally_Built then
Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True);
if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= Prj.None
then
declare
- The_Data : Project_Data :=
- Project_Tree.Projects.Table
- (Arguments_Project);
-
- Prj : Project_Id := Arguments_Project;
+ Prj : constant Project_Id :=
+ Ultimate_Extending_Project_Of (Arguments_Project);
begin
- while The_Data.Extended_By /= No_Project loop
- Prj := The_Data.Extended_By;
- The_Data := Project_Tree.Projects.Table (Prj);
- end loop;
-
- if The_Data.Library
- and then not The_Data.Externally_Built
- and then not The_Data.Need_To_Build_Lib
+ if Prj.Library
+ and then not Prj.Externally_Built
+ and then not Prj.Need_To_Build_Lib
then
-- Add to the Q all sources of the project that
- -- have not been marked
+ -- have not been marked.
Insert_Project_Sources
(The_Project => Prj,
-- Now mark the project as processed
- Project_Tree.Projects.Table
- (Prj).Need_To_Build_Lib := True;
+ Prj.Need_To_Build_Lib := True;
end if;
end;
end if;
----------------------
procedure Get_Mapping_File (Project : Project_Id) is
+ Data : Project_Compilation_Access;
+
begin
+ Data := Project_Compilation_Htable.Get (Project_Compilation, Project);
+
-- If there is a mapping file ready to be reused, reuse it
- if Last_Free_Indices (Project) > 0 then
- Mfile := The_Free_Mapping_File_Indices
- (Project, Last_Free_Indices (Project));
- Last_Free_Indices (Project) := Last_Free_Indices (Project) - 1;
+ if Data.Last_Free_Indices > 0 then
+ Mfile := Data.Free_Mapping_File_Indices (Data.Last_Free_Indices);
+ Data.Last_Free_Indices := Data.Last_Free_Indices - 1;
-- Otherwise, create and initialize a new one
else
- Init_Mapping_File (Project => Project, File_Index => Mfile);
+ Init_Mapping_File
+ (Project => Project, Data => Data.all, File_Index => Mfile);
end if;
-- Put the name in the mapping file argument for the invocation
Free (Mapping_File_Arg);
Mapping_File_Arg :=
new String'("-gnatem=" &
- Get_Name_String
- (The_Mapping_File_Names (Project, Mfile)));
-
+ Get_Name_String (Data.Mapping_File_Names (Mfile)));
end Get_Mapping_File;
-----------------------
-- Do nothing if project of source is externally built
if Arguments_Project = No_Project
- or else not Project_Tree.Projects.Table
- (Arguments_Project).Externally_Built
+ or else not Arguments_Project.Externally_Built
then
-- Don't waste any time if we have to recompile anyway
else
declare
Parent_Directory : constant String :=
- Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Directory.Display_Name);
+ Get_Name_String (Project.Directory.Display_Name);
begin
if Parent_Directory (Parent_Directory'Last) =
Prj.Env.Create_Config_Pragmas_File
(For_Project, Main_Project, Project_Tree);
- if Project_Tree.Projects.Table
- (For_Project).Config_File_Name /= No_Path
- then
- Temporary_Config_File :=
- Project_Tree.Projects.Table (For_Project).Config_File_Temp;
+ if For_Project.Config_File_Name /= No_Path then
+ Temporary_Config_File := For_Project.Config_File_Temp;
Last := 1;
Result (1) :=
new String'
- ("-gnatec=" &
- Get_Name_String
- (Project_Tree.Projects.Table
- (For_Project).Config_File_Name));
+ ("-gnatec=" & Get_Name_String (For_Project.Config_File_Name));
else
Temporary_Config_File := False;
-- Check for attribute Builder'Global_Configuration_Pragmas
- The_Packages := Project_Tree.Projects.Table
- (Main_Project).Decl.Packages;
+ The_Packages := Main_Project.Decl.Packages;
Gnatmake :=
Prj.Util.Value_Of
(Name => Name_Builder,
-- Check for attribute Compiler'Local_Configuration_Pragmas
- The_Packages :=
- Project_Tree.Projects.Table (For_Project).Decl.Packages;
+ The_Packages := For_Project.Decl.Packages;
Compiler :=
Prj.Util.Value_Of
(Name => Name_Compiler,
Success : Boolean;
pragma Warnings (Off, Success);
+ Proj : Project_List;
+ Data : Project_Compilation_Access;
+
begin
-- The caller is responsible for ensuring that Debug_Flag_N is False
pragma Assert (not Debug.Debug_Flag_N);
- if The_Mapping_File_Names /= null then
- for Project in The_Mapping_File_Names'Range (1) loop
- for Index in 1 .. Last_Mapping_File_Names (Project) loop
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ Data := Project_Compilation_Htable.Get
+ (Project_Compilation, Proj.Project);
+
+ if Data /= null and then Data.Mapping_File_Names /= null then
+ for Index in 1 .. Data.Last_Mapping_File_Names loop
Delete_File
- (Name => Get_Name_String
- (The_Mapping_File_Names (Project, Index)),
+ (Name => Get_Name_String (Data.Mapping_File_Names (Index)),
Success => Success);
end loop;
- end loop;
- end if;
+ end if;
+
+ Proj := Proj.Next;
+ end loop;
end Delete_Mapping_Files;
------------------------------
procedure Delete_Temp_Config_Files is
Success : Boolean;
+ Proj : Project_List;
pragma Warnings (Off, Success);
begin
pragma Assert (not Debug.Debug_Flag_N);
if Main_Project /= No_Project then
- for Project in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if
- Project_Tree.Projects.Table (Project).Config_File_Temp
- then
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Proj.Project.Config_File_Temp then
if Verbose_Mode then
Write_Str ("Deleting temp configuration file """);
- Write_Str (Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Config_File_Name));
+ Write_Str (Get_Name_String (Proj.Project.Config_File_Name));
Write_Line ("""");
end if;
Delete_File
- (Name => Get_Name_String
- (Project_Tree.Projects.Table
- (Project).Config_File_Name),
+ (Name => Get_Name_String (Proj.Project.Config_File_Name),
Success => Success);
-- Make sure that we don't have a config file for this project,
-- recreate another config file: we cannot reuse the one that
-- we just deleted!
- Project_Tree.Projects.Table (Project).
- Config_Checked := False;
- Project_Tree.Projects.Table (Project).
- Config_File_Name := No_Path;
- Project_Tree.Projects.Table (Project).
- Config_File_Temp := False;
+ Proj.Project.Config_Checked := False;
+ Proj.Project.Config_File_Name := No_Path;
+ Proj.Project.Config_File_Temp := False;
end if;
+ Proj := Proj.Next;
end loop;
end if;
end Delete_Temp_Config_Files;
Proj : Project_Id := No_Project;
-- The project of the current main
- Data : Project_Data;
-
Real_Path : String_Access;
begin
-- is the actual path of a source of a project.
if Main /= File_Name then
- Data :=
- Project_Tree.Projects.Table (Main_Project);
-
Real_Path :=
Locate_Regular_File
(Main &
- Body_Suffix_Of (Project_Tree, "ada", Data.Naming),
+ Body_Suffix_Of
+ (Project_Tree, "ada", Main_Project.Naming),
"");
if Real_Path = null then
Real_Path :=
Locate_Regular_File
(Main &
- Spec_Suffix_Of (Project_Tree, "ada", Data.Naming),
+ Spec_Suffix_Of
+ (Project_Tree, "ada", Main_Project.Naming),
"");
end if;
if Real_Path = null then
- Real_Path :=
- Locate_Regular_File (Main, "");
+ Real_Path := Locate_Regular_File (Main, "");
end if;
-- Fail if the file cannot be found
Make_Failed
("""" & Main &
""" is not a source of project " &
- Get_Name_String
- (Project_Tree.Projects.Table
- (Real_Main_Project).Name));
+ Get_Name_String (Real_Main_Project.Name));
end if;
end if;
end if;
-- extending project obj dir.
if ALI_Name /= No_File
- and then
- Project_Tree.Projects.Table
- (ALI_Project).Extended_By = No_Project
- and then
- Project_Tree.Projects.Table
- (ALI_Project).Extends = No_Project
+ and then ALI_Project.Extended_By = No_Project
+ and then ALI_Project.Extends = No_Project
then
-- First check if the ALI file exists. If it does not,
-- do not put the unit in the mapping file.
declare
ALI : constant String :=
Get_Name_String (ALI_Name);
- PD : Project_Data renames
- Project_Tree.Projects.Table (ALI_Project);
begin
-- For library projects, use the library directory,
-- for other projects, use the object directory.
- if PD.Library then
- Get_Name_String (PD.Library_Dir.Name);
+ if ALI_Project.Library then
+ Get_Name_String (ALI_Project.Library_Dir.Name);
else
- Get_Name_String (PD.Object_Directory.Name);
+ Get_Name_String
+ (ALI_Project.Object_Directory.Name);
end if;
if Name_Buffer (Name_Len) /=
-- And the project file cannot be a library project file
- elsif Project_Tree.Projects.Table (Main_Project).Library then
+ elsif Main_Project.Library then
Make_Failed ("-B cannot be used for a library project file");
else
-- cannot be specified on the command line.
if Osint.Number_Of_Files /= 0 then
- if Project_Tree.Projects.Table (Main_Project).Library
+ if Main_Project.Library
and then not Unique_Compile
and then ((not Make_Steps) or else Bind_Only or else Link_Only)
then
end if;
declare
- Value : String_List_Id :=
- Project_Tree.Projects.Table (Main_Project).Mains;
+ Value : String_List_Id := Main_Project.Mains;
begin
-- The attribute Main is an empty list or not specified,
if Value = Prj.Nil_String or else Unique_Compile then
if (not Make_Steps) or else Compile_Only
- or else not Project_Tree.Projects.Table
- (Main_Project).Library
+ or else not Main_Project.Library
then
-- First make sure that the binder and the linker
-- will not be invoked.
-- all the sources of the project.
declare
- Data : constant Project_Data :=
- Project_Tree.Projects.Table (Main_Project);
-
Languages : constant Variable_Value :=
Prj.Util.Value_Of
(Name_Languages,
- Data.Decl.Attributes,
+ Main_Project.Decl.Attributes,
Project_Tree);
Current : String_List_Id;
end if;
if Main_Project /= No_Project
- and then Project_Tree.Projects.Table
- (Main_Project).Externally_Built
+ and then Main_Project.Externally_Built
then
Make_Failed
("nothing to do for a main project that is externally built");
if Osint.Number_Of_Files = 0 then
if Main_Project /= No_Project
- and then Project_Tree.Projects.Table (Main_Project).Library
+ and then Main_Project.Library
then
if Do_Bind_Step
- and then not Project_Tree.Projects.Table
- (Main_Project).Standalone_Library
+ and then not Main_Project.Standalone_Library
then
Make_Failed ("only stand-alone libraries may be bound");
end if;
if Main_Project /= No_Project then
- if Project_Tree.Projects.Table
- (Main_Project).Object_Directory /= No_Path_Information
- then
+ if Main_Project.Object_Directory /= No_Path_Information then
-- Change current directory to object directory of main project
Project_Of_Current_Object_Directory := No_Project;
not Unique_Compile);
The_Packages : constant Package_Id :=
- Project_Tree.Projects.Table
- (Main_Project).Decl.Packages;
+ Main_Project.Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= Prj.None
then
- for Proj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Project_Tree.Projects.Table (Proj).Library then
- Project_Tree.Projects.Table
- (Proj).Need_To_Build_Lib :=
- (not MLib.Tgt.Library_Exists_For (Proj, Project_Tree))
- and then (not Project_Tree.Projects.Table
- (Proj).Externally_Built);
-
- if Project_Tree.Projects.Table (Proj).Need_To_Build_Lib then
+ declare
+ Proj : Project_List;
- -- If there is no object directory, then it will be
- -- impossible to build the library. So fail immediately.
+ begin
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Proj.Project.Library then
+ Proj.Project.Need_To_Build_Lib :=
+ not MLib.Tgt.Library_Exists_For
+ (Proj.Project, Project_Tree)
+ and then not Proj.Project.Externally_Built;
+
+ if Proj.Project.Need_To_Build_Lib then
+
+ -- If there is no object directory, then it will be
+ -- impossible to build the library. So fail
+ -- immediately.
+
+ if
+ Proj.Project.Object_Directory = No_Path_Information
+ then
+ Make_Failed
+ ("no object files to build library for project """
+ & Get_Name_String (Proj.Project.Name)
+ & """");
+ Proj.Project.Need_To_Build_Lib := False;
- if Project_Tree.Projects.Table (Proj).Object_Directory =
- No_Path_Information
- then
- Make_Failed
- ("no object files to build library for project """
- & Get_Name_String
- (Project_Tree.Projects.Table (Proj).Name)
- & """");
- Project_Tree.Projects.Table
- (Proj).Need_To_Build_Lib := False;
+ else
+ if Verbose_Mode then
+ Write_Str
+ ("Library file does not exist for project """);
+ Write_Str (Get_Name_String (Proj.Project.Name));
+ Write_Line ("""");
+ end if;
- else
- if Verbose_Mode then
- Write_Str
- ("Library file does not exist for project """);
- Write_Str
- (Get_Name_String
- (Project_Tree.Projects.Table
- (Proj).Name));
- Write_Line ("""");
+ Insert_Project_Sources
+ (The_Project => Proj.Project,
+ All_Projects => False,
+ Into_Q => True);
end if;
-
- Insert_Project_Sources
- (The_Project => Proj,
- All_Projects => False,
- Into_Q => True);
end if;
end if;
- end if;
- end loop;
+
+ Proj := Proj.Next;
+ end loop;
+ end;
end if;
-- If a relative path output file has been specified, we add
begin
if not Is_Absolute_Path (Exec_File_Name) then
- Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Exec_Directory.Name);
+ Get_Name_String (Main_Project.Exec_Directory.Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
declare
Dir_Path : constant String :=
- Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Directory.Name);
+ Get_Name_String (Main_Project.Directory.Name);
begin
for J in 1 .. Binder_Switches.Last loop
Test_If_Relative_Path
-- Allocate as many temporary mapping file names as the maximum
-- number of compilation processed, for each possible project.
- The_Mapping_File_Names :=
- new Temp_Path_Names
- (No_Project .. Project_Table.Last (Project_Tree.Projects),
- 1 .. Saved_Maximum_Processes);
- Last_Mapping_File_Names :=
- new Indices'
- (No_Project .. Project_Table.Last (Project_Tree.Projects)
- => 0);
-
- The_Free_Mapping_File_Indices :=
- new Free_File_Indices
- (No_Project .. Project_Table.Last (Project_Tree.Projects),
- 1 .. Saved_Maximum_Processes);
- Last_Free_Indices :=
- new Indices'(No_Project .. Project_Table.Last
- (Project_Tree.Projects) => 0);
+ declare
+ Data : Project_Compilation_Access;
+ Proj : Project_List := Project_Tree.Projects;
+ begin
+ while Proj /= null loop
+ Data := new Project_Compilation_Data'
+ (Mapping_File_Names => new Temp_Path_Names
+ (1 .. Saved_Maximum_Processes),
+ Last_Mapping_File_Names => 0,
+ Free_Mapping_File_Indices => new Free_File_Indices
+ (1 .. Saved_Maximum_Processes),
+ Last_Free_Indices => 0);
+ Project_Compilation_Htable.Set
+ (Project_Compilation, Proj.Project, Data);
+ Proj := Proj.Next;
+ end loop;
+
+ Data := new Project_Compilation_Data'
+ (Mapping_File_Names => new Temp_Path_Names
+ (1 .. Saved_Maximum_Processes),
+ Last_Mapping_File_Names => 0,
+ Free_Mapping_File_Indices => new Free_File_Indices
+ (1 .. Saved_Maximum_Processes),
+ Last_Free_Indices => 0);
+ Project_Compilation_Htable.Set
+ (Project_Compilation, No_Project, Data);
+ end;
Bad_Compilation.Init;
- -- If project files are used, create the mapping of all the sources,
- -- so that the correct paths will be found. Otherwise, if there is
- -- a file which is not a source with the same name in a source directory
- -- this file may be incorrectly found.
+ -- If project files are used, create the mapping of all the sources, so
+ -- that the correct paths will be found. Otherwise, if there is a file
+ -- which is not a source with the same name in a source directory this
+ -- file may be incorrectly found.
if Main_Project /= No_Project then
Prj.Env.Create_Mapping (Project_Tree);
end if;
if Main_Project /= No_Project
- and then
- Project_Tree.Projects.Table
- (Main_Project).Exec_Directory /= No_Path_Information
+ and then Main_Project.Exec_Directory /= No_Path_Information
then
declare
Exec_File_Name : constant String :=
begin
if not Is_Absolute_Path (Exec_File_Name) then
- Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Exec_Directory.Display_Name);
+ Get_Name_String (Main_Project.Exec_Directory.Display_Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
declare
Depth : Natural;
Current : Natural;
+ Proj1 : Project_List;
procedure Add_To_Library_Projs (Proj : Project_Id);
-- Add project Project to table Library_Projs in
begin
Library_Projs.Increment_Last;
- Depth := Project_Tree.Projects.Table (Proj).Depth;
+ Depth := Proj.Depth;
-- Put the projects in decreasing depth order, so that
-- if libA depends on libB, libB is first in order.
Current := Library_Projs.Last;
while Current > 1 loop
Prj := Library_Projs.Table (Current - 1);
- exit when Project_Tree.Projects.Table
- (Prj).Depth >= Depth;
+ exit when Prj.Depth >= Depth;
Library_Projs.Table (Current) := Prj;
Current := Current - 1;
end loop;
-- Put in Library_Projs table all library project
-- file ids when the library need to be rebuilt.
- for Proj1 in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Project_Tree.Projects.Table
- (Proj1).Standalone_Library
- then
+ Proj1 := Project_Tree.Projects;
+ while Proj1 /= null loop
+ if Proj1.Project.Standalone_Library then
Stand_Alone_Libraries := True;
end if;
- if Project_Tree.Projects.Table (Proj1).Library then
- MLib.Prj.Check_Library (Proj1, Project_Tree);
+ if Proj1.Project.Library then
+ MLib.Prj.Check_Library
+ (Proj1.Project, Project_Tree);
end if;
- if Project_Tree.Projects.Table
- (Proj1).Need_To_Build_Lib
- then
- Add_To_Library_Projs (Proj1);
+ if Proj1.Project.Need_To_Build_Lib then
+ Add_To_Library_Projs (Proj1.Project);
end if;
+
+ Proj1 := Proj1.Next;
end loop;
-- Check if importing libraries should be regenerated
-- because at least an imported library will be
-- regenerated or is more recent.
- for Proj1 in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Project_Tree.Projects.Table (Proj1).Library
- and then
- Project_Tree.Projects.Table (Proj1).Library_Kind /=
- Static
- and then not Project_Tree.Projects.Table
- (Proj1).Need_To_Build_Lib
- and then not Project_Tree.Projects.Table
- (Proj1).Externally_Built
+ Proj1 := Project_Tree.Projects;
+ while Proj1 /= null loop
+ if Proj1.Project.Library
+ and then Proj1.Project.Library_Kind /= Static
+ and then not Proj1.Project.Need_To_Build_Lib
+ and then not Proj1.Project.Externally_Built
then
declare
List : Project_List;
Rebuild : Boolean := False;
Lib_Timestamp1 : constant Time_Stamp_Type :=
- Project_Tree.Projects.Table
- (Proj1).Library_TS;
+ Proj1.Project.Library_TS;
begin
- List := Project_Tree.Projects.Table (Proj1).
- All_Imported_Projects;
+ List := Proj1.Project.All_Imported_Projects;
while List /= null loop
Proj2 := List.Project;
- if
- Project_Tree.Projects.Table (Proj2).Library
- then
- if Project_Tree.Projects.Table (Proj2).
- Need_To_Build_Lib
+ if Proj2.Library then
+ if Proj2.Need_To_Build_Lib
or else
- (Lib_Timestamp1 <
- Project_Tree.Projects.Table
- (Proj2).Library_TS)
+ (Lib_Timestamp1 < Proj2.Library_TS)
then
Rebuild := True;
exit;
end loop;
if Rebuild then
- Project_Tree.Projects.Table
- (Proj1).Need_To_Build_Lib := True;
- Add_To_Library_Projs (Proj1);
+ Proj1.Project.Need_To_Build_Lib := True;
+ Add_To_Library_Projs (Proj1.Project);
end if;
end;
end if;
+
+ Proj1 := Proj1.Next;
end loop;
-- Reset the flags Need_To_Build_Lib for the next main,
-- to avoid rebuilding libraries uselessly.
- for Proj1 in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- Project_Tree.Projects.Table
- (Proj1).Need_To_Build_Lib := False;
+ Proj1 := Project_Tree.Projects;
+ while Proj1 /= null loop
+ Proj1.Project.Need_To_Build_Lib := False;
+ Proj1 := Proj1.Next;
end loop;
end;
-- Set to True when there are shared library project files or
-- when gnatbind is invoked with -shared.
+ Proj : Project_List;
+
begin
-- Check if there are shared libraries, so that gnatbind is
-- called with -shared. Check also if gnatbind is called with
if Main_Project /= No_Project
and then MLib.Tgt.Support_For_Libraries /= Prj.None
then
- for Proj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Project_Tree.Projects.Table (Proj).Library
- and then Project_Tree.Projects.Table
- (Proj).Library_Kind /= Static
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ if Proj.Project.Library
+ and then Proj.Project.Library_Kind /= Static
then
Shared_Libs := True;
Bind_Shared := Shared_Switch'Access;
exit;
end if;
+ Proj := Proj.Next;
end loop;
end if;
Current : Natural;
Proj2 : Project_Id;
Depth : Natural;
+ Proj1 : Project_List;
begin
if not Run_Path_Option then
-- Check for library projects
- for Proj1 in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- if Proj1 /= Main_Project
- and then
- Project_Tree.Projects.Table (Proj1).Library
+ Proj1 := Project_Tree.Projects;
+ while Proj1 /= null loop
+ if Proj1.Project /= Main_Project
+ and then Proj1.Project.Library
then
-- Add this project to table Library_Projs
Libraries_Present := True;
- Depth := Project_Tree.Projects.Table (Proj1).Depth;
+ Depth := Proj1.Project.Depth;
Library_Projs.Increment_Last;
Current := Library_Projs.Last;
while Current > 1 loop
Proj2 := Library_Projs.Table (Current - 1);
- exit when Project_Tree.Projects.Table
- (Proj2).Depth <= Depth;
+ exit when Proj2.Depth <= Depth;
Library_Projs.Table (Current) := Proj2;
Current := Current - 1;
end loop;
- Library_Projs.Table (Current) := Proj1;
+ Library_Projs.Table (Current) := Proj1.Project;
-- If it is not a static library and path option
-- is set, add it to the Library_Paths table.
- if Project_Tree.Projects.Table
- (Proj1).Library_Kind /= Static
+ if Proj1.Project.Library_Kind /= Static
and then Path_Option /= null
then
Library_Paths.Increment_Last;
Library_Paths.Table (Library_Paths.Last) :=
new String'
(Get_Name_String
- (Project_Tree.Projects.Table
- (Proj1).Library_Dir.Display_Name));
+ (Proj1.Project.Library_Dir.Display_Name));
end if;
end if;
+
+ Proj1 := Proj1.Next;
end loop;
for Index in 1 .. Library_Projs.Last loop
Linker_Switches.Table (Linker_Switches.Last) :=
new String'("-L" &
Get_Name_String
- (Project_Tree.Projects.Table
- (Library_Projs.Table (Index)).
- Library_Dir.Display_Name));
+ (Library_Projs.Table (Index).
+ Library_Dir.Display_Name));
-- Add the -l switch
Linker_Switches.Table (Linker_Switches.Last) :=
new String'("-l" &
Get_Name_String
- (Project_Tree.Projects.Table
- (Library_Projs.Table (Index)).
- Library_Name));
+ (Library_Projs.Table (Index).
+ Library_Name));
end loop;
end if;
not Unique_Compile);
The_Packages : constant Package_Id :=
- Project_Tree.Projects.Table
- (Main_Project).Decl.Packages;
+ Main_Project.Decl.Packages;
Binder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
declare
Dir_Path : constant String :=
Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Directory.Name);
+ (Main_Project.Directory.Name);
begin
for
procedure Init_Mapping_File
(Project : Project_Id;
+ Data : in out Project_Compilation_Data;
File_Index : in out Natural)
is
FD : File_Descriptor;
begin
-- Increase the index of the last mapping file for this project
- Last_Mapping_File_Names (Project) :=
- Last_Mapping_File_Names (Project) + 1;
+ Data.Last_Mapping_File_Names := Data.Last_Mapping_File_Names + 1;
-- If there is a project file, call Create_Mapping_File with
-- the project id.
(Project,
In_Tree => Project_Tree,
Language => No_Name,
- Name => The_Mapping_File_Names
- (Project, Last_Mapping_File_Names (Project)));
+ Name => Data.Mapping_File_Names
+ (Data.Last_Mapping_File_Names));
-- Otherwise, just create an empty file
else
Tempdir.Create_Temp_File
(FD,
- The_Mapping_File_Names
- (No_Project, Last_Mapping_File_Names (No_Project)));
+ Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
if FD = Invalid_FD then
Make_Failed ("disk full");
else
Record_Temp_File
- (The_Mapping_File_Names
- (No_Project, Last_Mapping_File_Names (No_Project)));
+ (Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
end if;
Close (FD, Status);
-- And return the index of the newly created file
- File_Index := Last_Mapping_File_Names (Project);
+ File_Index := Data.Last_Mapping_File_Names;
end Init_Mapping_File;
------------
-- to the search paths.
Add_Source_Directories (Main_Project, Project_Tree);
- Add_Object_Directories (Main_Project, Project_Tree);
+ Add_Object_Directories (Main_Project);
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, Project_Tree);
- end loop;
+ declare
+ Proj : Project_List;
+ begin
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ Compute_All_Imported_Projects (Proj.Project);
+ Proj := Proj.Next;
+ end loop;
+ end;
else
Sfile : File_Name_Type;
Index : Int;
- Extending : constant Boolean :=
- Project_Tree.Projects.Table
- (The_Project).Extends /= No_Project;
+ Extending : constant Boolean := The_Project.Extends /= No_Project;
function Check_Project (P : Project_Id) return Boolean;
-- Returns True if P is The_Project or a project extended by The_Project
elsif Extending then
declare
- Data : Project_Data :=
- Project_Tree.Projects.Table (The_Project);
+ Proj : Project_Id;
begin
- loop
- if P = Data.Extends then
+ Proj := The_Project;
+ while Proj /= null loop
+ if P = Proj.Extends then
return True;
end if;
- Data := Project_Tree.Projects.Table (Data.Extends);
- exit when Data.Extends = No_Project;
+ Proj := Proj.Extends;
end loop;
end;
end if;
Index := 0;
-- If there is a source for the body, and the body has not been
- -- locally removed,
+ -- locally removed.
if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Path.Name /= Slash
if Check_Project (Unit.File_Names (Body_Part).Project) then
-- If we don't have a spec, we cannot consider the source
- -- if it is a subunit
+ -- if it is a subunit.
if Unit.File_Names (Specification).Name = No_File then
declare
Get_Name_String (Source_File);
Saved_Verbosity : constant Verbosity := Current_Verbosity;
Project : Project_Id := No_Project;
- Data : Project_Data;
Path_Name : Path_Name_Type := No_Path;
pragma Warnings (Off, Path_Name);
-- ALI file will not be skipped.
if Project /= No_Project then
- Data := Project_Tree.Projects.Table (Project);
-
declare
Object_Directory : constant String :=
Normalize_Pathname
(Get_Name_String
- (Data.Object_Directory.Display_Name));
+ (Project.
+ Object_Directory.Display_Name));
Olast : Natural := Object_Directory'Last;
declare
Real_Path : constant String :=
Normalize_Pathname
- (Dir,
- Get_Name_String
- (Project_Tree.Projects.Table
- (Main_Project).Directory.Display_Name));
+ (Dir, Get_Name_String (Main_Project.Directory.Display_Name));
begin
if Real_Path'Length = 0 then
-------------
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)
+ if Prj.Depth >= Depth
+ or Get (Seen, Prj) -- or needed instead of or else ???
then
return;
end if;
Set (Seen, Prj, True);
- Data.Depth := Depth;
+ Prj.Depth := Depth;
-- Visit each imported project
- List := Data.Imported_Projects;
+ List := Prj.Imported_Projects;
while List /= null loop
Proj := List.Project;
List := List.Next;
-- Start of processing for Recursive_Compute_Depth
+ Proj : Project_List;
begin
- for Proj in Project_Table.First ..
- Project_Table.Last (Project_Tree.Projects)
- loop
- Project_Tree.Projects.Table (Proj).Depth := 0;
+ Proj := Project_Tree.Projects;
+ while Proj /= null loop
+ Proj.Project.Depth := 0;
+ Proj := Proj.Next;
end loop;
Recurse (Project, Depth => 1);
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;
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
- In_Packages => Data.Decl.Packages,
+ In_Packages => Proj.Decl.Packages,
In_Tree => In_Tree);
Options :=
begin
Linker_Opts.Init;
- For_All_Projects (Project, In_Tree, Dummy, Imported_First => True);
+ For_All_Projects (Project, Dummy, Imported_First => True);
Last_Linker_Option := 0;
for Index in reverse 1 .. Linker_Opts.Last loop
declare
- Options : String_List_Id := Linker_Opts.Table (Index).Options;
+ Options : String_List_Id;
Proj : constant Project_Id :=
Linker_Opts.Table (Index).Project;
Option : Name_Id;
Dir_Path : constant String :=
- Get_Name_String (In_Tree.Projects.Table (Proj).Directory.Name);
+ Get_Name_String (Proj.Directory.Name);
begin
+ Options := Linker_Opts.Table (Index).Options;
while Options /= Nil_String loop
Option := In_Tree.String_Elements.Table (Options).Value;
Get_Name_String (Option);
Including_L_Switch => True);
end if;
- Options :=
- In_Tree.String_Elements.Table (Options).Next;
+ Options := In_Tree.String_Elements.Table (Options).Next;
end loop;
end;
end loop;
-- Indicate if Stand-Alone Libraries are automatically initialized using
-- the constructor mechanism.
- function Ultimate_Extension_Of
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref) return Project_Id;
- -- Returns the Project_Id of project Project. Returns No_Project
- -- if Project is No_Project.
-
------------------
-- Add_Argument --
------------------
-- Set to True for the first warning about a unit missing from the
-- interface set.
- Data : Project_Data := In_Tree.Projects.Table (For_Project);
+ Current_Proj : Project_Id;
- Libgnarl_Needed : Yes_No_Unknown := Data.Libgnarl_Needed;
+ Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
-- Set to True if library needs to be linked with libgnarl
Libdecgnat_Needed : Boolean := False;
Object_Directory_Path : constant String :=
Get_Name_String
- (Data.Object_Directory.Display_Name);
+ (For_Project.Object_Directory.Display_Name);
- Standalone : constant Boolean := Data.Standalone_Library;
+ Standalone : constant Boolean := For_Project.Standalone_Library;
- Project_Name : constant String := Get_Name_String (Data.Name);
+ Project_Name : constant String := Get_Name_String (For_Project.Name);
Current_Dir : constant String := Get_Current_Dir;
elsif P /= No_Project then
declare
- Data : Project_Data :=
- In_Tree.Projects.Table (For_Project);
+ Proj : Project_Id := For_Project;
begin
- while Data.Extends /= No_Project loop
- if P = Data.Extends then
+ while Proj.Extends /= No_Project loop
+ if P = Proj.Extends then
return True;
end if;
- Data := In_Tree.Projects.Table (Data.Extends);
+ Proj := Proj.Extends;
end loop;
end;
end if;
Libgnarl_Needed := Yes;
if Main_Project then
- In_Tree.Projects.Table (For_Project).Libgnarl_Needed :=
- Yes;
+ For_Project.Libgnarl_Needed := Yes;
else
exit;
end if;
if not Interface_ALIs.Get (Afile) then
if not Warning_For_Library then
Write_Str ("Warning: In library project """);
- Get_Name_String (Data.Name);
+ Get_Name_String (Current_Proj.Name);
To_Mixed (Name_Buffer (1 .. Name_Len));
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Line ("""");
---------------------
procedure Process_Project (Project : Project_Id) is
- Data : Project_Data := In_Tree.Projects.Table (Project);
Imported : Project_List;
begin
-- Nothing to do if process has already been processed
- if not Processed_Projects.Get (Data.Name) then
- Processed_Projects.Set (Data.Name, True);
+ if not Processed_Projects.Get (Project.Name) then
+ Processed_Projects.Set (Project.Name, True);
-- Call Process_Project recursively for any imported project.
-- We first process the imported projects to guarantee that
-- we have a proper reverse order for the libraries.
- Imported := Data.Imported_Projects;
+ Imported := Project.Imported_Projects;
while Imported /= null loop
if Imported.Project /= No_Project then
Process_Project (Imported.Project);
-- If it is a library project, add it to Library_Projs
- if Project /= For_Project and then Data.Library then
+ if Project /= For_Project and then Project.Library then
Library_Projs.Increment_Last;
Library_Projs.Table (Library_Projs.Last) := Project;
-- Check if because of this library we need to use libgnarl
if Libgnarl_Needed = Unknown then
- if Data.Libgnarl_Needed = Unknown
- and then Data.Object_Directory /= No_Path_Information
+ if Project.Libgnarl_Needed = Unknown
+ and then Project.Object_Directory /= No_Path_Information
then
-- Check if libgnarl is needed for this library
declare
Object_Dir_Path : constant String :=
Get_Name_String
- (Data.Object_Directory.
+ (Project.Object_Directory.
Display_Name);
Object_Dir : Dir_Type;
Filename : String (1 .. 255);
(ALI_File, Main_Project => False);
if Libgnarl_Needed = Yes then
- Data.Libgnarl_Needed := Yes;
- In_Tree.Projects.Table
- (For_Project).Libgnarl_Needed :=
- Yes;
+ Project.Libgnarl_Needed := Yes;
+ For_Project.Libgnarl_Needed := Yes;
exit;
end if;
end if;
end;
end if;
- if Data.Libgnarl_Needed = Yes then
+ if Project.Libgnarl_Needed = Yes then
Libgnarl_Needed := Yes;
- In_Tree.Projects.Table (For_Project).Libgnarl_Needed :=
- Yes;
+ For_Project.Libgnarl_Needed := Yes;
end if;
end if;
end if;
for Index in reverse 1 .. Library_Projs.Last loop
Current := Library_Projs.Table (Index);
- Get_Name_String
- (In_Tree.Projects.Table (Current).Library_Dir.Display_Name);
+ Get_Name_String (Current.Library_Dir.Display_Name);
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'("-L" & Name_Buffer (1 .. Name_Len));
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
- new String'
- ("-l" &
- Get_Name_String
- (In_Tree.Projects.Table
- (Current).Library_Name));
+ new String'("-l" & Get_Name_String (Current.Library_Name));
end loop;
end Process_Imported_Libraries;
-- Fail if project is not a library project
- if not Data.Library then
+ if not For_Project.Library then
Com.Fail ("project """ & Project_Name & """ has no library");
end if;
-- Do not attempt to build the library if it is externally built
- if Data.Externally_Built then
+ if For_Project.Externally_Built then
return;
end if;
end if;
Add_Argument
- (B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
- Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
+ Add_Argument ("-L" & Get_Name_String (For_Project.Library_Name));
- if Data.Lib_Auto_Init and then SALs_Use_Constructors then
+ if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then
Add_Argument (Auto_Initialize);
end if;
Binder_Package : constant Package_Id :=
Value_Of
(Name => Name_Binder,
- In_Packages => Data.Decl.Packages,
+ In_Packages => For_Project.Decl.Packages,
In_Tree => In_Tree);
begin
if not Success then
Com.Fail ("could not bind standalone library "
- & Get_Name_String (Data.Library_Name));
+ & Get_Name_String (For_Project.Library_Name));
end if;
end if;
end if;
Add_Argument
- (B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
+ (B_Start.all
+ & Get_Name_String (For_Project.Library_Name) & ".adb");
-- If necessary, add the PIC option
if not Success then
Com.Fail
("could not compile binder generated file for library "
- & Get_Name_String (Data.Library_Name));
+ & Get_Name_String (For_Project.Library_Name));
end if;
-- Process binder generated file for pragmas Linker_Options
-- If attributes Library_GCC or Linker'Driver were specified, get the
-- driver name.
- if Data.Config.Shared_Lib_Driver /= No_File then
- Driver_Name := Name_Id (Data.Config.Shared_Lib_Driver);
+ if For_Project.Config.Shared_Lib_Driver /= No_File then
+ Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
end if;
-- If attribute Library_Options was specified, add these additional
-- options.
- Library_Options :=
- Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree);
+ Library_Options := Value_Of
+ (Name_Library_Options, For_Project.Decl.Attributes, In_Tree);
if not Library_Options.Default then
declare
end if;
Lib_Dirpath :=
- new String'(Get_Name_String (Data.Library_Dir.Display_Name));
- Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
+ new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
+ Lib_Filename := new String'
+ (Get_Name_String (For_Project.Library_Name));
- case Data.Library_Kind is
+ case For_Project.Library_Kind is
when Static =>
The_Build_Mode := Static;
-- Get the library version, if any
- if Data.Lib_Internal_Name /= No_Name then
+ if For_Project.Lib_Internal_Name /= No_Name then
Lib_Version :=
- new String'(Get_Name_String (Data.Lib_Internal_Name));
+ new String'(Get_Name_String (For_Project.Lib_Internal_Name));
end if;
-- Add the objects found in the object directory and the object
In_Main_Object_Directory := True;
- Foreign_Sources := Has_Foreign_Sources (Data);
+ Foreign_Sources := Has_Foreign_Sources (For_Project);
+ Current_Proj := For_Project;
loop
- if Data.Object_Directory /= No_Path_Information then
+ if Current_Proj.Object_Directory /= No_Path_Information then
declare
Object_Dir_Path : constant String :=
Get_Name_String
- (Data.Object_Directory.Display_Name);
+ (Current_Proj.Object_Directory
+ .Display_Name);
Object_Dir : Dir_Type;
Filename : String (1 .. 255);
Last : Natural;
when Directory_Error =>
Com.Fail ("cannot find object directory """
& Get_Name_String
- (Data.Object_Directory.Display_Name)
+ (Current_Proj.Object_Directory.Display_Name)
& """");
end;
end if;
- exit when Data.Extends = No_Project;
+ exit when Current_Proj.Extends = No_Project;
In_Main_Object_Directory := False;
- Data := In_Tree.Projects.Table (Data.Extends);
+ Current_Proj := Current_Proj.Extends;
end loop;
-- Add the -L and -l switches for the imported Library Project Files,
-- the library directory (by Copy_ALI_Files, below).
if Standalone then
- Data := In_Tree.Projects.Table (For_Project);
+ Current_Proj := For_Project;
declare
- Iface : String_List_Id := Data.Lib_Interface_ALIs;
+ Iface : String_List_Id := For_Project.Lib_Interface_ALIs;
ALI : File_Name_Type;
begin
Iface := In_Tree.String_Elements.Table (Iface).Next;
end loop;
- Iface := Data.Lib_Interface_ALIs;
+ Iface := For_Project.Lib_Interface_ALIs;
if not Opt.Quiet_Output then
-- the library file and any ALI file of a source of the project.
begin
- Get_Name_String
- (In_Tree.Projects.Table (For_Project).Library_Dir.Name);
+ Get_Name_String (For_Project.Library_Dir.Name);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
if Unit.File_Names (Body_Part).Project /=
No_Project
then
- if Ultimate_Extension_Of
- (Unit.File_Names (Body_Part).Project,
- In_Tree) = For_Project
+ if Ultimate_Extending_Project_Of
+ (Unit.File_Names (Body_Part).Project) =
+ For_Project
then
Get_Name_String
(Unit.File_Names (Body_Part).Name);
end if;
end if;
- elsif Ultimate_Extension_Of
- (Unit.File_Names (Specification).Project,
- In_Tree) = For_Project
+ elsif Ultimate_Extending_Project_Of
+ (Unit.File_Names (Specification).Project) =
+ For_Project
then
Get_Name_String
(Unit.File_Names (Specification).Name);
Interfaces => Arguments (1 .. Argument_Number),
Lib_Filename => Lib_Filename.all,
Lib_Dir => Lib_Dirpath.all,
- Symbol_Data => Data.Symbol_Data,
+ Symbol_Data => Current_Proj.Symbol_Data,
Driver_Name => Driver_Name,
Lib_Version => Lib_Version.all,
- Auto_Init => Data.Lib_Auto_Init);
+ Auto_Init => Current_Proj.Lib_Auto_Init);
when Static =>
MLib.Build_Library
Copy_ALI_Files
(Files => Ali_Files.all,
- To => In_Tree.Projects.Table
- (For_Project).Library_ALI_Dir.Name,
+ To => For_Project.Library_ALI_Dir.Name,
Interfaces => Arguments (1 .. Argument_Number));
-- Copy interface sources if Library_Src_Dir specified
if Standalone
- and then In_Tree.Projects.Table
- (For_Project).Library_Src_Dir /= No_Path_Information
+ and then For_Project.Library_Src_Dir /= No_Path_Information
then
-- Clean the interface copy directory: remove any source that
-- could be a source of the project.
begin
- Get_Name_String
- (In_Tree.Projects.Table (For_Project).Library_Src_Dir.Name);
+ Get_Name_String (For_Project.Library_Src_Dir.Name);
Change_Dir (Name_Buffer (1 .. Name_Len));
exception
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
- if Ultimate_Extension_Of
- (Unit.File_Names (Body_Part).Project, In_Tree) =
- For_Project
+ if Ultimate_Extending_Project_Of
+ (Unit.File_Names (Body_Part).Project) = For_Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
exit;
end if;
- if Ultimate_Extension_Of
- (Unit.File_Names (Specification).Project, In_Tree) =
- For_Project
+ if Ultimate_Extending_Project_Of
+ (Unit.File_Names (Specification).Project) =
+ For_Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
(For_Project => For_Project,
In_Tree => In_Tree,
Interfaces => Arguments (1 .. Argument_Number),
- To_Dir => In_Tree.Projects.Table
- (For_Project).Library_Src_Dir.Display_Name);
+ To_Dir => For_Project.Library_Src_Dir.Display_Name);
end if;
end if;
procedure Check_Library
(For_Project : Project_Id; In_Tree : Project_Tree_Ref)
is
- Data : constant Project_Data :=
- In_Tree.Projects.Table (For_Project);
Lib_TS : Time_Stamp_Type;
Current : constant Dir_Name_Str := Get_Current_Dir;
-- No need to build the library if there is no object directory,
-- hence no object files to build the library.
- if Data.Library then
+ if For_Project.Library then
declare
Lib_Name : constant File_Name_Type :=
Library_File_Name_For (For_Project, In_Tree);
begin
- Change_Dir (Get_Name_String (Data.Library_Dir.Name));
+ Change_Dir (Get_Name_String (For_Project.Library_Dir.Name));
Lib_TS := File_Stamp (Lib_Name);
- In_Tree.Projects.Table (For_Project).Library_TS := Lib_TS;
+ For_Project.Library_TS := Lib_TS;
end;
- if not Data.Externally_Built
- and then not Data.Need_To_Build_Lib
- and then Data.Object_Directory /= No_Path_Information
+ if not For_Project.Externally_Built
+ and then not For_Project.Need_To_Build_Lib
+ and then For_Project.Object_Directory /= No_Path_Information
then
declare
Obj_TS : Time_Stamp_Type;
-- If the library file does not exist, then the time stamp will
-- be Empty_Time_Stamp, earlier than any other time stamp.
- Change_Dir (Get_Name_String (Data.Object_Directory.Name));
+ Change_Dir
+ (Get_Name_String (For_Project.Object_Directory.Name));
Open (Dir => Object_Dir, Dir_Name => ".");
-- For all entries in the object directory
-- Library must be rebuilt
- In_Tree.Projects.Table
- (For_Project).Need_To_Build_Lib := True;
+ For_Project.Need_To_Build_Lib := True;
exit;
end if;
end if;
return True;
end if;
- Ext := In_Tree.Projects.Table (Ext).Extends;
+ Ext := Ext.Extends;
end loop;
return False;
begin
-- Change the working directory to the object directory
- Change_Dir
- (Get_Name_String
- (In_Tree.Projects.Table (For_Project).Object_Directory.Name));
+ Change_Dir (Get_Name_String (For_Project.Object_Directory.Name));
for Index in Interfaces'Range loop
return C_SALs_Init_Using_Constructors /= 0;
end SALs_Use_Constructors;
- ---------------------------
- -- Ultimate_Extension_Of --
- ---------------------------
-
- function Ultimate_Extension_Of
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref) return Project_Id
- is
- Result : Project_Id := Project;
- Data : Project_Data;
-
- begin
- if Project /= No_Project then
- loop
- Data := In_Tree.Projects.Table (Result);
- exit when Data.Extended_By = No_Project;
- Result := Data.Extended_By;
- end loop;
- end if;
-
- return Result;
- end Ultimate_Extension_Of;
-
end MLib.Prj;
-- --
-- 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- --
function Library_Exists_For_Default
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
+ pragma Unreferenced (In_Tree);
begin
- if not In_Tree.Projects.Table (Project).Library then
+ if not Project.Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
else
declare
Lib_Dir : constant String :=
- Get_Name_String
- (In_Tree.Projects.Table (Project).Library_Dir.Name);
+ Get_Name_String (Project.Library_Dir.Name);
Lib_Name : constant String :=
- Get_Name_String
- (In_Tree.Projects.Table (Project).Library_Name);
+ Get_Name_String (Project.Library_Name);
begin
- if In_Tree.Projects.Table (Project).Library_Kind = Static then
+ if Project.Library_Kind = Static then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Append_To (Lib_Name, Archive_Ext));
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return File_Name_Type
is
+ pragma Unreferenced (In_Tree);
begin
- if not In_Tree.Projects.Table (Project).Library then
+ if not Project.Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_File;
else
declare
Lib_Name : constant String :=
- Get_Name_String
- (In_Tree.Projects.Table (Project).Library_Name);
+ Get_Name_String (Project.Library_Name);
begin
- if In_Tree.Projects.Table (Project).Library_Kind =
+ if Project.Library_Kind =
Static
then
Name_Len := 3;
Library_Exists_For_Default'Access;
function Library_File_Name_For_Default
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref) return File_Name_Type;
+ (Project : Project_Id; In_Tree : Project_Tree_Ref) return File_Name_Type;
Library_File_Name_For_Ptr : Library_File_Name_For_Function :=
Library_File_Name_For_Default'Access;
-- Call Setenv, after calling To_Host_File_Spec
function Ultimate_Extension_Of
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref) return Project_Id;
+ (Project : Project_Id) return Project_Id;
-- Return a project that is either Project or an extended ancestor of
-- Project that itself is not extended.
procedure Add (Project : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
begin
- Add_To_Path (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
+ Add_To_Path (Project.Source_Dirs, In_Tree);
end Add;
procedure For_All_Projects is
-- 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 Project.Ada_Include_Path = null then
In_Tree.Private_Part.Ada_Path_Length := 0;
- For_All_Projects (Project, In_Tree, Dummy);
+ For_All_Projects (Project, Dummy);
- In_Tree.Projects.Table (Project).Ada_Include_Path :=
+ Project.Ada_Include_Path :=
new String'
(In_Tree.Private_Part.Ada_Path_Buffer
(1 .. In_Tree.Private_Part.Ada_Path_Length));
end if;
- return In_Tree.Projects.Table (Project).Ada_Include_Path;
+ return Project.Ada_Include_Path;
end Ada_Include_Path;
----------------------
return Ada_Include_Path (Project, In_Tree).all;
else
In_Tree.Private_Part.Ada_Path_Length := 0;
- Add_To_Path
- (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
+ Add_To_Path (Project.Source_Dirs, In_Tree);
return
In_Tree.Private_Part.Ada_Path_Buffer
(1 .. In_Tree.Private_Part.Ada_Path_Length);
pragma Unreferenced (Dummy);
Path : constant Path_Name_Type :=
Get_Object_Directory
- (In_Tree, Project,
+ (Project,
Including_Libraries => Including_Libraries,
Only_If_Ada => False);
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 Project.Ada_Objects_Path = null then
In_Tree.Private_Part.Ada_Path_Length := 0;
- For_All_Projects (Project, In_Tree, Dummy);
+ For_All_Projects (Project, Dummy);
- In_Tree.Projects.Table (Project).Ada_Objects_Path :=
+ Project.Ada_Objects_Path :=
new String'
(In_Tree.Private_Part.Ada_Path_Buffer
(1 .. In_Tree.Private_Part.Ada_Path_Length));
end if;
- return In_Tree.Projects.Table (Project).Ada_Objects_Path;
+ return Project.Ada_Objects_Path;
end Ada_Objects_Path;
------------------------
-----------
procedure Check (Project : Project_Id) is
- Data : constant Project_Data :=
- In_Tree.Projects.Table (Project);
-
begin
if Current_Verbosity = High then
Write_Str ("Checking project file """);
- Write_Str (Namet.Get_Name_String (Data.Name));
+ Write_Str (Namet.Get_Name_String (Project.Name));
Write_Str (""".");
Write_Eol;
end if;
Naming_Table.Last (In_Tree.Private_Part.Namings)
and then not Same_Naming_Scheme
(Left => In_Tree.Private_Part.Namings.Table (Current_Naming),
- Right => Data.Naming) loop
+ Right => Project.Naming) loop
Current_Naming := Current_Naming + 1;
end loop;
Naming_Table.Increment_Last (In_Tree.Private_Part.Namings);
In_Tree.Private_Part.Namings.Table
(Naming_Table.Last (In_Tree.Private_Part.Namings)) :=
- Data.Naming;
+ Project.Naming;
-- We need a temporary file to be created
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Spec_File_Name => ""*" &
- Spec_Suffix_Of (In_Tree, "ada", Data.Naming) &
+ Spec_Suffix_Of (In_Tree, "ada", Project.Naming) &
""",");
Put_Line
(File, " Casing => " &
- Image (Data.Naming.Casing) & ",");
+ Image (Project.Naming.Casing) & ",");
Put_Line
(File, " Dot_Replacement => """ &
- Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
+ Namet.Get_Name_String (Project.Naming.Dot_Replacement) &
""");");
-- and body
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Body_File_Name => ""*" &
- Body_Suffix_Of (In_Tree, "ada", Data.Naming) &
+ Body_Suffix_Of (In_Tree, "ada", Project.Naming) &
""",");
Put_Line
(File, " Casing => " &
- Image (Data.Naming.Casing) & ",");
+ Image (Project.Naming.Casing) & ",");
Put_Line
(File, " Dot_Replacement => """ &
- Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
+ Namet.Get_Name_String (Project.Naming.Dot_Replacement) &
""");");
-- and maybe separate
- if Body_Suffix_Of (In_Tree, "ada", Data.Naming) /=
- Get_Name_String (Data.Naming.Separate_Suffix)
+ if Body_Suffix_Of (In_Tree, "ada", Project.Naming) /=
+ Get_Name_String (Project.Naming.Separate_Suffix)
then
Put_Line
(File, "pragma Source_File_Name_Project");
Put_Line
(File, " (Subunit_File_Name => ""*" &
- Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
+ Namet.Get_Name_String (Project.Naming.Separate_Suffix) &
""",");
Put_Line
(File, " Casing => " &
- Image (Data.Naming.Casing) &
+ Image (Project.Naming.Casing) &
",");
Put_Line
(File, " Dot_Replacement => """ &
- Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
+ Namet.Get_Name_String (Project.Naming.Dot_Replacement) &
""");");
end if;
end if;
- if Data.Extends /= No_Project then
- Check (Data.Extends);
+ if Project.Extends /= No_Project then
+ Check (Project.Extends);
end if;
declare
- Current : Project_List := Data.Imported_Projects;
+ Current : Project_List := Project.Imported_Projects;
begin
while Current /= null loop
Check (Current.Project);
-- Start of processing for Create_Config_Pragmas_File
begin
- if not
- In_Tree.Projects.Table (For_Project).Config_Checked
- then
+ if not For_Project.Config_Checked then
-- Remove any memory of processed naming schemes, if any
Write_Line ("""");
end if;
- In_Tree.Projects.Table (For_Project).Config_File_Name :=
- File_Name;
- In_Tree.Projects.Table (For_Project).Config_File_Temp :=
- True;
-
- In_Tree.Projects.Table (For_Project).Config_Checked :=
- True;
+ For_Project.Config_File_Name := File_Name;
+ For_Project.Config_File_Temp := True;
+ For_Project.Config_Checked := True;
end if;
end Create_Config_Pragmas_File;
File : File_Descriptor := Invalid_FD;
Status : Boolean;
- Present : array (No_Project .. Project_Table.Last (In_Tree.Projects))
- of Boolean := (others => False);
+ Present : Project_Boolean_Htable.Instance;
-- For each project in the closure of Project, the corresponding flag
-- will be set to True.
-- Nothing to do for non existent project or project that has already
-- been flagged.
- if Prj /= No_Project and then not Present (Prj) then
- Present (Prj) := True;
+ if Prj /= No_Project
+ and then not Project_Boolean_Htable.Get (Present, Prj)
+ then
+ Project_Boolean_Htable.Set (Present, Prj, True);
- Imported := In_Tree.Projects.Table (Prj).Imported_Projects;
+ Imported := Prj.Imported_Projects;
while Imported /= null loop
Recursive_Flag (Imported.Project);
Imported := Imported.Next;
end loop;
- Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
+ Recursive_Flag (Prj.Extends);
end if;
end Recursive_Flag;
-- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project.
- if Data.Name /= No_File and then Present (Data.Project) then
+ if Data.Name /= No_File
+ and then Project_Boolean_Htable.Get (Present, Data.Project)
+ then
Put_Data (Spec => True);
end if;
-- If there is a body (or subunit) put its mapping in the
-- file if it is from a project in the closure of Project.
- if Data.Name /= No_File and then Present (Data.Project) then
+ if Data.Name /= No_File
+ and then Project_Boolean_Htable.Get (Present, Data.Project)
+ then
Put_Data (Spec => False);
end if;
end if;
else
-- For all source of the Language of all projects in the closure
- for Proj in Present'Range loop
- if Present (Proj) then
-
- Iter := For_Each_Source (In_Tree, Proj);
- loop
- Source := Prj.Element (Iter);
- exit when Source = No_Source;
-
- if Source.Language.Name = Language
- and then not Source.Locally_Removed
- and then Source.Replaced_By = No_Source
- and then Source.Path.Name /= No_Path
- then
- if Source.Unit /= No_Name then
- Get_Name_String (Source.Unit);
-
- if Source.Kind = Spec then
- Suffix :=
- Source.Language.Config.Mapping_Spec_Suffix;
- else
- Suffix :=
- Source.Language.Config.Mapping_Body_Suffix;
+ declare
+ P : Project_List;
+ begin
+ P := In_Tree.Projects;
+ while P /= null loop
+ if Project_Boolean_Htable.Get (Present, P.Project) then
+
+ Iter := For_Each_Source (In_Tree, P.Project);
+ loop
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
+
+ if Source.Language.Name = Language
+ and then not Source.Locally_Removed
+ and then Source.Replaced_By = No_Source
+ and then Source.Path.Name /= No_Path
+ then
+ if Source.Unit /= No_Name then
+ Get_Name_String (Source.Unit);
+
+ if Source.Kind = Spec then
+ Suffix :=
+ Source.Language.Config.Mapping_Spec_Suffix;
+ else
+ Suffix :=
+ Source.Language.Config.Mapping_Body_Suffix;
+ end if;
+
+ if Suffix /= No_File then
+ Add_Str_To_Name_Buffer
+ (Get_Name_String (Suffix));
+ end if;
+
+ Put_Name_Buffer;
end if;
- if Suffix /= No_File then
- Add_Str_To_Name_Buffer (Get_Name_String (Suffix));
- end if;
+ Get_Name_String (Source.File);
+ Put_Name_Buffer;
+ Get_Name_String (Source.Path.Name);
Put_Name_Buffer;
end if;
- Get_Name_String (Source.File);
- Put_Name_Buffer;
-
- Get_Name_String (Source.Path.Name);
- Put_Name_Buffer;
- end if;
+ Next (Iter);
+ end loop;
+ end if;
- Next (Iter);
- end loop;
- end if;
- end loop;
+ P := P.Next;
+ end loop;
+ end;
end if;
GNAT.OS_Lib.Close (File, Status);
Prj.Com.Fail ("disk full, could not write mapping file");
end if;
+
+ Project_Boolean_Htable.Reset (Present);
end Create_Mapping_File;
--------------------------
Full_Path : Boolean := False) return String
is
The_Project : Project_Id := Project;
- Data : Project_Data :=
- In_Tree.Projects.Table (Project);
Original_Name : String := Name;
Extended_Spec_Name : String :=
Name &
- Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
+ Spec_Suffix_Of (In_Tree, "ada", Project.Naming);
Extended_Body_Name : String :=
Name &
- Body_Suffix_Of (In_Tree, "ada", Data.Naming);
+ Body_Suffix_Of (In_Tree, "ada", Project.Naming);
Unit : Unit_Data;
-- If we are not in an extending project, give up
- exit when (not Main_Project_Only) or else Data.Extends = No_Project;
+ exit when not Main_Project_Only
+ or else The_Project.Extends = No_Project;
-- Otherwise, look in the project we are extending
- The_Project := Data.Extends;
- Data := In_Tree.Projects.Table (The_Project);
+ The_Project := The_Project.Extends;
end loop;
-- We don't know this file name, return an empty string
-- For_All_Object_Dirs --
-------------------------
- procedure For_All_Object_Dirs
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref)
- is
+ procedure For_All_Object_Dirs (Project : Project_Id) is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer);
-- Get all object directories of Prj
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);
+ if Prj.Object_Directory /= No_Path_Information then
+ Get_Name_String (Prj.Object_Directory.Display_Name);
Action (Name_Buffer (1 .. Name_Len));
end if;
end For_Project;
-- Start of processing for For_All_Object_Dirs
begin
- Get_Object_Dirs (Project, In_Tree, Dummy);
+ Get_Object_Dirs (Project, Dummy);
end For_All_Object_Dirs;
-------------------------
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;
+ Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
begin
-- If there are Ada sources, call action with the name of every
-- source directory.
- if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
+ if Has_Ada_Sources (Project) then
while Current /= Nil_String loop
The_String := In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
-- Start of processing for For_All_Source_Dirs
begin
- Get_Source_Dirs (Project, In_Tree, Dummy);
+ Get_Source_Dirs (Project, Dummy);
end For_All_Source_Dirs;
-------------------
Original_Name)
then
Project := Ultimate_Extension_Of
- (Project => Unit.File_Names (Specification).Project,
- In_Tree => In_Tree);
+ (Project => Unit.File_Names (Specification).Project);
Path := Unit.File_Names (Specification).Path.Display_Name;
if Current_Verbosity > Default then
Original_Name)
then
Project := Ultimate_Extension_Of
- (Project => Unit.File_Names (Body_Part).Project,
- In_Tree => In_Tree);
+ (Project => Unit.File_Names (Body_Part).Project);
Path := Unit.File_Names (Body_Part).Path.Display_Name;
if Current_Verbosity > Default then
else
Write_Str (" Project: ");
Get_Name_String
- (In_Tree.Projects.Table
- (Unit.File_Names (Specification).Project).Path.Name);
+ (Unit.File_Names (Specification).Project.Path.Name);
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
else
Write_Str (" Project: ");
Get_Name_String
- (In_Tree.Projects.Table
- (Unit.File_Names (Body_Part).Project).Path.Name);
+ (Unit.File_Names (Body_Part).Project.Path.Name);
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
Original_Name : String := Name;
- Data : constant Project_Data :=
- In_Tree.Projects.Table (Main_Project);
-
Extended_Spec_Name : String :=
- Name &
- Spec_Suffix_Of (In_Tree, "ada", Data.Naming);
+ Name & Spec_Suffix_Of (In_Tree, "ada", Main_Project.Naming);
Extended_Body_Name : String :=
- Name &
- Body_Suffix_Of (In_Tree, "ada", Data.Naming);
+ Name & Body_Suffix_Of (In_Tree, "ada", Main_Project.Naming);
Unit : Unit_Data;
-- Get the ultimate extending project
if Result /= No_Project then
- while In_Tree.Projects.Table (Result).Extended_By /=
- No_Project
- loop
- Result := In_Tree.Projects.Table (Result).Extended_By;
+ while Result.Extended_By /= No_Project loop
+ Result := Result.Extended_By;
end loop;
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
-- Add to path all source directories of this project if there are
-- Ada sources.
- if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
- Add_To_Source_Path (Data.Source_Dirs, In_Tree);
+ if Has_Ada_Sources (Project) then
+ Add_To_Source_Path (Project.Source_Dirs, In_Tree);
end if;
end if;
if Process_Object_Dirs then
Path := Get_Object_Directory
- (In_Tree, Project,
+ (Project,
Including_Libraries => Including_Libraries,
Only_If_Ada => True);
-- If it is the first time we call this procedure for this project,
-- compute the source path and/or the object path.
- if In_Tree.Projects.Table (Project).Include_Path_File = No_Path then
+ if Project.Include_Path_File = No_Path then
Process_Source_Dirs := True;
Create_New_Path_File
- (In_Tree, Source_FD,
- In_Tree.Projects.Table (Project).Include_Path_File);
+ (In_Tree, Source_FD, Project.Include_Path_File);
end if;
-- For the object path, we make a distinction depending on
-- Including_Libraries.
if Including_Libraries then
- if In_Tree.Projects.Table
- (Project).Objects_Path_File_With_Libs = No_Path
- then
+ if Project.Objects_Path_File_With_Libs = No_Path then
Process_Object_Dirs := True;
Create_New_Path_File
- (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
- Objects_Path_File_With_Libs);
+ (In_Tree, Object_FD, Project.Objects_Path_File_With_Libs);
end if;
else
- if In_Tree.Projects.Table
- (Project).Objects_Path_File_Without_Libs = No_Path
- then
+ if Project.Objects_Path_File_Without_Libs = No_Path then
Process_Object_Dirs := True;
Create_New_Path_File
- (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
- Objects_Path_File_Without_Libs);
+ (In_Tree, Object_FD, Project.Objects_Path_File_Without_Libs);
end if;
end if;
if Process_Source_Dirs or Process_Object_Dirs then
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);
+ For_All_Projects (Project, Dummy);
end if;
-- Write and close any file that has been created
-- corresponding flags.
if In_Tree.Private_Part.Current_Source_Path_File /=
- In_Tree.Projects.Table (Project).Include_Path_File
+ Project.Include_Path_File
then
In_Tree.Private_Part.Current_Source_Path_File :=
- In_Tree.Projects.Table (Project).Include_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));
if Including_Libraries then
if In_Tree.Private_Part.Current_Object_Path_File /=
- In_Tree.Projects.Table (Project).Objects_Path_File_With_Libs
+ Project.Objects_Path_File_With_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
- In_Tree.Projects.Table
- (Project).Objects_Path_File_With_Libs;
+ Project.Objects_Path_File_With_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
else
if In_Tree.Private_Part.Current_Object_Path_File /=
- In_Tree.Projects.Table (Project).Objects_Path_File_Without_Libs
+ Project.Objects_Path_File_Without_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
- In_Tree.Projects.Table
- (Project).Objects_Path_File_Without_Libs;
+ Project.Objects_Path_File_Without_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
---------------------------
function Ultimate_Extension_Of
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref) return Project_Id
+ (Project : Project_Id) return Project_Id
is
Result : Project_Id := Project;
begin
- while In_Tree.Projects.Table (Result).Extended_By /= No_Project loop
- Result := In_Tree.Projects.Table (Result).Extended_By;
+ while Result.Extended_By /= No_Project loop
+ Result := Result.Extended_By;
end loop;
return Result;
generic
with procedure Action (Path : String);
- procedure For_All_Object_Dirs
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref);
+ procedure For_All_Object_Dirs (Project : Project_Id);
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
procedure Find_Excluded_Sources
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : Project_Data);
+ In_Tree : Project_Tree_Ref);
-- Find the list of files that should not be considered as source files
-- for this project. Sets the list in the Excluded_Sources_Htable.
-- Check that a name is a valid Ada unit name
procedure Check_Naming_Schemes
- (Data : in out Project_Data;
- Project : Project_Id;
+ (Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Check the naming scheme part of Data
procedure Check_Configuration
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ In_Tree : Project_Tree_Ref);
-- Check the configuration attributes for the project
procedure Check_If_Externally_Built
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ In_Tree : Project_Tree_Ref);
-- Check attribute Externally_Built of project Project in project tree
-- In_Tree and modify its data Data if it has the value "true".
procedure Check_Interfaces
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ In_Tree : Project_Tree_Ref);
-- If a list of sources is specified in attribute Interfaces, set
-- In_Interfaces only for the sources specified in the list.
procedure Check_Library_Attributes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Current_Dir : String;
- Data : in out Project_Data);
+ Current_Dir : String);
-- Check the library attributes of project Project in project tree In_Tree
-- and modify its data Data accordingly.
-- Current_Dir should represent the current directory, and is passed for
procedure Check_Package_Naming
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ In_Tree : Project_Tree_Ref);
-- Check package Naming of project Project in project tree In_Tree and
-- modify its data Data accordingly.
procedure Check_Programming_Languages
(In_Tree : Project_Tree_Ref;
- Project : Project_Id;
- Data : in out Project_Data);
+ Project : Project_Id);
-- Check attribute Languages for the project with data Data in project
-- tree In_Tree and set the components of Data for all the programming
-- languages indicated in attribute Languages, if any.
function Check_Project
(P : Project_Id;
Root_Project : Project_Id;
- In_Tree : Project_Tree_Ref;
Extending : Boolean) return Boolean;
-- Returns True if P is Root_Project or, if Extending is True, a project
-- extended by Root_Project.
procedure Check_Stand_Alone_Library
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Current_Dir : String;
Extending : Boolean);
-- Check if project Project in project tree In_Tree is a Stand-Alone
procedure Search_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
For_All_Sources : Boolean);
-- Search the source directories to find the sources.
-- If For_All_Sources is True, check each regular file name against the
procedure Check_File
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
procedure Check_File_Naming_Schemes
(In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
+ Project : Project_Id;
File_Name : File_Name_Type;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
procedure Get_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Current_Dir : String;
- Data : in out Project_Data);
+ Current_Dir : String);
-- Get the object directory, the exec directory and the source directories
-- of a project.
--
procedure Get_Mains
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data);
+ In_Tree : Project_Tree_Ref);
-- Get the mains of a project from attribute Main, if it exists, and put
-- them in the project data.
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Proc_Data : in out Processing_Data);
-- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable.
procedure Look_For_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Proc_Data : in out Processing_Data);
-- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. This assumes that Data.First_Source has
-- when there are no sources for language Lang_Name.
procedure Show_Source_Dirs
- (Data : Project_Data; In_Tree : Project_Tree_Ref);
+ (Project : Project_Id; In_Tree : Project_Tree_Ref);
-- List all the source directories of a project
procedure Warn_If_Not_Sources
Current_Dir : String;
Proc_Data : in out Processing_Data)
is
- Data : Project_Data renames In_Tree.Projects.Table (Project);
Extending : Boolean := False;
begin
Recursive_Dirs.Reset;
- Check_If_Externally_Built (Project, In_Tree, Data);
+ Check_If_Externally_Built (Project, In_Tree);
-- Object, exec and source directories
- Get_Directories (Project, In_Tree, Current_Dir, Data);
+ Get_Directories (Project, In_Tree, Current_Dir);
-- Get the programming languages
- Check_Programming_Languages (In_Tree, Project, Data);
+ Check_Programming_Languages (In_Tree, Project);
- if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
+ if Project.Qualifier = Dry
+ and then Project.Source_Dirs /= Nil_String
+ then
Error_Msg
(Project, In_Tree,
"an abstract project needs to have no language, no sources " &
"or no source directories",
- Data.Location);
+ Project.Location);
end if;
-- Check configuration in multi language mode
if Must_Check_Configuration then
- Check_Configuration (Project, In_Tree, Data);
+ Check_Configuration (Project, In_Tree);
end if;
-- Library attributes
- Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
+ Check_Library_Attributes (Project, In_Tree, Current_Dir);
if Current_Verbosity = High then
- Show_Source_Dirs (Data, In_Tree);
+ Show_Source_Dirs (Project, In_Tree);
end if;
- Check_Package_Naming (Project, In_Tree, Data);
+ Check_Package_Naming (Project, In_Tree);
- Extending := Data.Extends /= No_Project;
+ Extending := Project.Extends /= No_Project;
- Check_Naming_Schemes (Data, Project, In_Tree);
+ Check_Naming_Schemes (Project, In_Tree);
if Get_Mode = Ada_Only then
Prepare_Ada_Naming_Exceptions
- (Data.Naming.Bodies, In_Tree, Body_Part);
+ (Project.Naming.Bodies, In_Tree, Body_Part);
Prepare_Ada_Naming_Exceptions
- (Data.Naming.Specs, In_Tree, Specification);
+ (Project.Naming.Specs, In_Tree, Specification);
end if;
-- Find the sources
- if Data.Source_Dirs /= Nil_String then
- Look_For_Sources (Project, In_Tree, Data, Proc_Data);
+ if Project.Source_Dirs /= Nil_String then
+ Look_For_Sources (Project, In_Tree, Proc_Data);
if Get_Mode = Ada_Only then
-- of this project file.
Warn_If_Not_Sources
- (Project, In_Tree, Data.Naming.Bodies,
+ (Project, In_Tree, Project.Naming.Bodies,
Specs => False,
Extending => Extending);
Warn_If_Not_Sources
- (Project, In_Tree, Data.Naming.Specs,
+ (Project, In_Tree, Project.Naming.Specs,
Specs => True,
Extending => Extending);
elsif Get_Mode = Multi_Language and then
- (not Data.Externally_Built) and then
+ (not Project.Externally_Built) and then
(not Extending)
then
declare
Iter : Source_Iterator;
begin
- Language := Data.Languages;
+ Language := Project.Languages;
while Language /= No_Language_Index loop
-- If there are no sources for this language, check whether
(Project,
Get_Name_String (Language.Display_Name),
In_Tree,
- Data.Location,
+ Project.Location,
Continuation);
Continuation := True;
end if;
-- If a list of sources is specified in attribute Interfaces, set
-- In_Interfaces only for the sources specified in the list.
- Check_Interfaces (Project, In_Tree, Data);
+ Check_Interfaces (Project, In_Tree);
end if;
-- If it is a library project file, check if it is a standalone library
- if Data.Library then
+ if Project.Library then
Check_Stand_Alone_Library
- (Project, In_Tree, Data, Current_Dir, Extending);
+ (Project, In_Tree, Current_Dir, Extending);
end if;
-- Put the list of Mains, if any, in the project data
- Get_Mains (Project, In_Tree, Data);
-
- -- Update the project data in the Projects table
-
- In_Tree.Projects.Table (Project) := Data;
+ Get_Mains (Project, In_Tree);
Free_Ada_Naming_Exceptions;
end Check;
procedure Check_Configuration
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Dot_Replacement : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case;
-- Nothing to do if the language is the same as the current language
if Current_Language /= Real_Language then
- Lang_Index := Data.Languages;
+ Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
exit when Lang_Index.Name = Real_Language;
Lang_Index := Lang_Index.Next;
-- Attribute Executable_Suffix: the suffix of the
-- executables.
- Data.Config.Executable_Suffix :=
+ Project.Config.Executable_Suffix :=
Attribute.Value.Value;
end if;
end if;
-- Attribute Linker'Driver: the default linker to use
- Data.Config.Linker :=
+ Project.Config.Linker :=
Path_Name_Type (Attribute.Value.Value);
-- Linker'Driver is also used to link shared libraries
-- if the obsolescent attribute Library_GCC has not been
-- specified.
- if Data.Config.Shared_Lib_Driver = No_File then
- Data.Config.Shared_Lib_Driver :=
+ if Project.Config.Shared_Lib_Driver = No_File then
+ Project.Config.Shared_Lib_Driver :=
File_Name_Type (Attribute.Value.Value);
end if;
-- Attribute Required_Switches: the minimum
-- options to use when invoking the linker
- Put (Into_List =>
- Data.Config.Minimum_Linker_Options,
+ Put (Into_List => Project.Config.Minimum_Linker_Options,
From_List => Attribute.Value.Values,
In_Tree => In_Tree);
elsif Attribute.Name = Name_Map_File_Option then
- Data.Config.Map_File_Option := Attribute.Value.Value;
+ Project.Config.Map_File_Option := Attribute.Value.Value;
elsif Attribute.Name = Name_Max_Command_Line_Length then
begin
- Data.Config.Max_Command_Line_Length :=
+ Project.Config.Max_Command_Line_Length :=
Natural'Value (Get_Name_String
(Attribute.Value.Value));
Name := Name_Find;
if Name = Name_None then
- Data.Config.Resp_File_Format := None;
+ Project.Config.Resp_File_Format := None;
elsif Name = Name_Gnu then
- Data.Config.Resp_File_Format := GNU;
+ Project.Config.Resp_File_Format := GNU;
elsif Name = Name_Object_List then
- Data.Config.Resp_File_Format := Object_List;
+ Project.Config.Resp_File_Format := Object_List;
elsif Name = Name_Option_List then
- Data.Config.Resp_File_Format := Option_List;
+ Project.Config.Resp_File_Format := Option_List;
else
Error_Msg
end;
elsif Attribute.Name = Name_Response_File_Switches then
- Put (Into_List =>
- Data.Config.Resp_File_Options,
+ Put (Into_List => Project.Config.Resp_File_Options,
From_List => Attribute.Value.Values,
In_Tree => In_Tree);
end if;
-- Start of processing for Process_Packages
begin
- Packages := Data.Decl.Packages;
+ Packages := Project.Decl.Packages;
while Packages /= No_Package loop
Element := In_Tree.Packages.Table (Packages);
begin
-- Process non associated array attribute at project level
- Attribute_Id := Data.Decl.Attributes;
+ Attribute_Id := Project.Decl.Attributes;
while Attribute_Id /= No_Variable loop
Attribute :=
In_Tree.Variable_Elements.Table (Attribute_Id);
-- Attribute Target: the target specified
- Data.Config.Target := Attribute.Value.Value;
+ Project.Config.Target := Attribute.Value.Value;
elsif Attribute.Name = Name_Library_Builder then
-- Attribute Library_Builder: the application to invoke
-- to build libraries.
- Data.Config.Library_Builder :=
+ Project.Config.Library_Builder :=
Path_Name_Type (Attribute.Value.Value);
elsif Attribute.Name = Name_Archive_Builder then
Attribute.Value.Location);
end if;
- Put (Into_List => Data.Config.Archive_Builder,
+ Put (Into_List => Project.Config.Archive_Builder,
From_List => List,
In_Tree => In_Tree);
if List /= Nil_String then
Put
- (Into_List => Data.Config.Archive_Builder_Append_Option,
+ (Into_List =>
+ Project.Config.Archive_Builder_Append_Option,
From_List => List,
In_Tree => In_Tree);
end if;
Attribute.Value.Location);
end if;
- Put (Into_List => Data.Config.Archive_Indexer,
+ Put (Into_List => Project.Config.Archive_Indexer,
From_List => List,
In_Tree => In_Tree);
Attribute.Value.Location);
end if;
- Put (Into_List => Data.Config.Lib_Partial_Linker,
+ Put (Into_List => Project.Config.Lib_Partial_Linker,
From_List => List,
In_Tree => In_Tree);
elsif Attribute.Name = Name_Library_GCC then
- Data.Config.Shared_Lib_Driver :=
+ Project.Config.Shared_Lib_Driver :=
File_Name_Type (Attribute.Value.Value);
Error_Msg
(Project,
Attribute.Value.Location);
elsif Attribute.Name = Name_Archive_Suffix then
- Data.Config.Archive_Suffix :=
+ Project.Config.Archive_Suffix :=
File_Name_Type (Attribute.Value.Value);
elsif Attribute.Name = Name_Linker_Executable_Option then
Attribute.Value.Location);
end if;
- Put (Into_List => Data.Config.Linker_Executable_Option,
+ Put (Into_List => Project.Config.Linker_Executable_Option,
From_List => List,
In_Tree => In_Tree);
Attribute.Value.Location);
end if;
- Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
+ Project.Config.Linker_Lib_Dir_Option :=
+ Attribute.Value.Value;
elsif Attribute.Name = Name_Linker_Lib_Name_Option then
Attribute.Value.Location);
end if;
- Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
+ Project.Config.Linker_Lib_Name_Option :=
+ Attribute.Value.Value;
elsif Attribute.Name = Name_Run_Path_Option then
List := Attribute.Value.Values;
if List /= Nil_String then
- Put (Into_List => Data.Config.Run_Path_Option,
+ Put (Into_List => Project.Config.Run_Path_Option,
From_List => List,
In_Tree => In_Tree);
end if;
declare
pragma Unsuppress (All_Checks);
begin
- Data.Config.Separate_Run_Path_Options :=
+ Project.Config.Separate_Run_Path_Options :=
Boolean'Value (Get_Name_String (Attribute.Value.Value));
exception
when Constraint_Error =>
declare
pragma Unsuppress (All_Checks);
begin
- Data.Config.Lib_Support :=
+ Project.Config.Lib_Support :=
Library_Support'Value (Get_Name_String
(Attribute.Value.Value));
exception
end;
elsif Attribute.Name = Name_Shared_Library_Prefix then
- Data.Config.Shared_Lib_Prefix :=
+ Project.Config.Shared_Lib_Prefix :=
File_Name_Type (Attribute.Value.Value);
elsif Attribute.Name = Name_Shared_Library_Suffix then
- Data.Config.Shared_Lib_Suffix :=
+ Project.Config.Shared_Lib_Suffix :=
File_Name_Type (Attribute.Value.Value);
elsif Attribute.Name = Name_Symbolic_Link_Supported then
declare
pragma Unsuppress (All_Checks);
begin
- Data.Config.Symbolic_Link_Supported :=
+ Project.Config.Symbolic_Link_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
exception
declare
pragma Unsuppress (All_Checks);
begin
- Data.Config.Lib_Maj_Min_Id_Supported :=
+ Project.Config.Lib_Maj_Min_Id_Supported :=
Boolean'Value (Get_Name_String
(Attribute.Value.Value));
exception
declare
pragma Unsuppress (All_Checks);
begin
- Data.Config.Auto_Init_Supported :=
+ Project.Config.Auto_Init_Supported :=
Boolean'Value (Get_Name_String (Attribute.Value.Value));
exception
when Constraint_Error =>
List := Attribute.Value.Values;
if List /= Nil_String then
- Put (Into_List => Data.Config.Shared_Lib_Min_Options,
+ Put (Into_List => Project.Config.Shared_Lib_Min_Options,
From_List => List,
In_Tree => In_Tree);
end if;
List := Attribute.Value.Values;
if List /= Nil_String then
- Put (Into_List => Data.Config.Lib_Version_Options,
+ Put (Into_List => Project.Config.Lib_Version_Options,
From_List => List,
In_Tree => In_Tree);
end if;
begin
-- Process the associative array attributes at project level
- Current_Array_Id := Data.Decl.Arrays;
+ Current_Array_Id := Project.Decl.Arrays;
while Current_Array_Id /= No_Array loop
Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
-- For unit based languages, set Casing, Dot_Replacement and
-- Separate_Suffix in Naming_Data.
- Lang_Index := Data.Languages;
+ Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
if Lang_Index.Name = Name_Ada then
Lang_Index.Config.Naming_Data.Casing := Casing;
-- Give empty names to various prefixes/suffixes, if they have not
-- been specified in the configuration.
- if Data.Config.Archive_Suffix = No_File then
- Data.Config.Archive_Suffix := Empty_File;
+ if Project.Config.Archive_Suffix = No_File then
+ Project.Config.Archive_Suffix := Empty_File;
end if;
- if Data.Config.Shared_Lib_Prefix = No_File then
- Data.Config.Shared_Lib_Prefix := Empty_File;
+ if Project.Config.Shared_Lib_Prefix = No_File then
+ Project.Config.Shared_Lib_Prefix := Empty_File;
end if;
- if Data.Config.Shared_Lib_Suffix = No_File then
- Data.Config.Shared_Lib_Suffix := Empty_File;
+ if Project.Config.Shared_Lib_Suffix = No_File then
+ Project.Config.Shared_Lib_Suffix := Empty_File;
end if;
- Lang_Index := Data.Languages;
+ Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
Current_Language := Lang_Index.Display_Name;
", ignoring all its sources",
No_Location);
- if Lang_Index = Data.Languages then
- Data.Languages := Lang_Index.Next;
+ if Lang_Index = Project.Languages then
+ Project.Languages := Lang_Index.Next;
else
Prev_Index.Next := Lang_Index.Next;
end if;
procedure Check_If_Externally_Built
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Externally_Built : constant Variable_Value :=
Util.Value_Of
(Name_Externally_Built,
- Data.Decl.Attributes, In_Tree);
+ Project.Decl.Attributes, In_Tree);
begin
if not Externally_Built.Default then
To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Buffer (1 .. Name_Len) = "true" then
- Data.Externally_Built := True;
+ Project.Externally_Built := True;
elsif Name_Buffer (1 .. Name_Len) /= "false" then
Error_Msg (Project, In_Tree,
-- A virtual project extending an externally built project is itself
-- externally built.
- if Data.Virtual and then Data.Extends /= No_Project then
- Data.Externally_Built :=
- In_Tree.Projects.Table (Data.Extends).Externally_Built;
+ if Project.Virtual and then Project.Extends /= No_Project then
+ Project.Externally_Built := Project.Extends.Externally_Built;
end if;
if Current_Verbosity = High then
Write_Str ("Project is ");
- if not Data.Externally_Built then
+ if not Project.Externally_Built then
Write_Str ("not ");
end if;
procedure Check_Interfaces
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Interfaces,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
List : String_List_Id;
Next (Iter);
end loop;
- Project_2 := In_Tree.Projects.Table (Project_2).Extends;
+ Project_2 := Project_2.Extends;
end loop;
List := Interfaces.Values;
Next (Iter);
end loop;
- Project_2 := In_Tree.Projects.Table (Project_2).Extends;
+ Project_2 := Project_2.Extends;
end loop Big_Loop;
if Source = No_Source then
Error_Msg_File_1 := File_Name_Type (Element.Value);
- Error_Msg_Name_1 := Data.Name;
+ Error_Msg_Name_1 := Project.Name;
Error_Msg
(Project,
List := Element.Next;
end loop;
- Data.Interfaces_Defined := True;
+ Project.Interfaces_Defined := True;
- elsif Data.Extends /= No_Project then
- Data.Interfaces_Defined :=
- In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
+ elsif Project.Extends /= No_Project then
+ Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
- if Data.Interfaces_Defined then
+ if Project.Interfaces_Defined then
Iter := For_Each_Source (In_Tree, Project);
loop
Source := Prj.Element (Iter);
--------------------------
procedure Check_Naming_Schemes
- (Data : in out Project_Data;
- Project : Project_Id;
+ (Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
Naming_Id : constant Package_Id :=
- Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
+ Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree);
Naming : Package_Element;
procedure Check_Naming_Ada_Only;
if Source /= No_Source then
Other_Project := Source.Project;
- if Is_Extending (Project, Other_Project, In_Tree) then
+ if Is_Extending (Project, Other_Project) then
Other_Part := Source.Other_Part;
-- Record the source to be removed
else
Error_Msg_Name_1 := Unit;
- Error_Msg_Name_2 :=
- In_Tree.Projects.Table (Other_Project).Name;
+ Error_Msg_Name_2 := Other_Project.Name;
Error_Msg
(Project,
In_Tree,
Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
- In_Array => Data.Naming.Spec_Suffix,
+ In_Array => Project.Naming.Spec_Suffix,
In_Tree => In_Tree);
Ada_Body_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
- In_Array => Data.Naming.Body_Suffix,
+ In_Array => Project.Naming.Body_Suffix,
In_Tree => In_Tree);
begin
and then Length_Of_Name (Ada_Body_Suffix.Value) /= 0
then
Body_Suffix := Canonical_Case_File_Name (Ada_Body_Suffix.Value);
- Data.Naming.Separate_Suffix := Body_Suffix;
- Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
+ Project.Naming.Separate_Suffix := Body_Suffix;
+ Set_Body_Suffix (In_Tree, "ada", Project.Naming, Body_Suffix);
else
Body_Suffix := Default_Ada_Body_Suffix;
- Data.Naming.Separate_Suffix := Body_Suffix;
- Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
+ Project.Naming.Separate_Suffix := Body_Suffix;
+ Set_Body_Suffix (In_Tree, "ada", Project.Naming, Body_Suffix);
end if;
Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix));
-- We'll need the dot replacement below, so compute it now
Check_Common
- (Dot_Replacement => Data.Naming.Dot_Replacement,
- Casing => Data.Naming.Casing,
+ (Dot_Replacement => Project.Naming.Dot_Replacement,
+ Casing => Project.Naming.Casing,
Casing_Defined => Casing_Defined,
- Separate_Suffix => Data.Naming.Separate_Suffix,
+ Separate_Suffix => Project.Naming.Separate_Suffix,
Sep_Suffix_Loc => Sep_Suffix_Loc);
- Data.Naming.Bodies :=
+ Project.Naming.Bodies :=
Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
- if Data.Naming.Bodies /= No_Array_Element then
+ if Project.Naming.Bodies /= No_Array_Element then
Check_And_Normalize_Unit_Names
- (Project, In_Tree, Data.Naming.Bodies, "Naming.Bodies");
+ (Project, In_Tree, Project.Naming.Bodies, "Naming.Bodies");
end if;
- Data.Naming.Specs :=
+ Project.Naming.Specs :=
Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
- if Data.Naming.Specs /= No_Array_Element then
+ if Project.Naming.Specs /= No_Array_Element then
Check_And_Normalize_Unit_Names
- (Project, In_Tree, Data.Naming.Specs, "Naming.Specs");
+ (Project, In_Tree, Project.Naming.Specs, "Naming.Specs");
end if;
-- Check Spec_Suffix
and then Length_Of_Name (Ada_Spec_Suffix.Value) /= 0
then
Spec_Suffix := Canonical_Case_File_Name (Ada_Spec_Suffix.Value);
- Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix);
+ Set_Spec_Suffix (In_Tree, "ada", Project.Naming, Spec_Suffix);
if Is_Illegal_Suffix
- (Spec_Suffix, Data.Naming.Dot_Replacement)
+ (Spec_Suffix, Project.Naming.Dot_Replacement)
then
Err_Vars.Error_Msg_File_1 := Spec_Suffix;
Error_Msg
else
Spec_Suffix := Default_Ada_Spec_Suffix;
- Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix);
+ Set_Spec_Suffix (In_Tree, "ada", Project.Naming, Spec_Suffix);
end if;
Write_Attr ("Spec_Suffix", Get_Name_String (Spec_Suffix));
-- Check Body_Suffix
- if Is_Illegal_Suffix (Body_Suffix, Data.Naming.Dot_Replacement) then
+ if Is_Illegal_Suffix
+ (Body_Suffix, Project.Naming.Dot_Replacement)
+ then
Err_Vars.Error_Msg_File_1 := Body_Suffix;
Error_Msg
(Project, In_Tree,
Ada_Body_Suffix.Location);
end if;
- if Body_Suffix /= Data.Naming.Separate_Suffix
- and then Spec_Suffix = Data.Naming.Separate_Suffix
+ if Body_Suffix /= Project.Naming.Separate_Suffix
+ and then Spec_Suffix = Project.Naming.Separate_Suffix
then
Error_Msg
(Project, In_Tree,
"Separate_Suffix (""" &
- Get_Name_String (Data.Naming.Separate_Suffix) &
+ Get_Name_String (Project.Naming.Separate_Suffix) &
""") cannot be the same as Spec_Suffix.",
Sep_Suffix_Loc);
end if;
or else Casing_Defined
or else Separate_Suffix /= No_File
then
- Lang_Id := Data.Languages;
+ Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop
if Lang_Id.Config.Kind = Unit_Based then
if Dot_Replacement /= No_File then
-- Next, get the spec and body suffixes
- Lang_Id := Data.Languages;
+ Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop
Lang := Lang_Id.Name;
-- Get the naming exceptions for all languages
for Kind in Spec .. Impl loop
- Lang_Id := Data.Languages;
+ Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop
case Lang_Id.Config.Kind is
when File_Based =>
procedure Check_Library_Attributes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Current_Dir : String;
- Data : in out Project_Data)
+ Current_Dir : String)
is
- Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
+ Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
Lib_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of
-------------------
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
- Proj_Data : Project_Data;
Src_Id : Source_Id;
Iter : Source_Iterator;
begin
if Proj /= No_Project then
- Proj_Data := In_Tree.Projects.Table (Proj);
-
- if not Proj_Data.Library then
+ if not Proj.Library then
-- The only not library projects that are OK are those that
-- have no sources. However, header files from non-Ada
end loop;
if Src_Id /= No_Source then
- Error_Msg_Name_1 := Data.Name;
- Error_Msg_Name_2 := Proj_Data.Name;
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
if Extends then
- if Data.Library_Kind /= Static then
+ if Project.Library_Kind /= Static then
Error_Msg
(Project, In_Tree,
Continuation.all &
"shared library project %% cannot extend " &
"project %% that is not a library project",
- Data.Location);
+ Project.Location);
Continuation := Continuation_String'Access;
end if;
elsif (not Unchecked_Shared_Lib_Imports)
- and then Data.Library_Kind /= Static
+ and then Project.Library_Kind /= Static
then
Error_Msg
(Project, In_Tree,
Continuation.all &
"shared library project %% cannot import project %% " &
"that is not a shared library project",
- Data.Location);
+ Project.Location);
Continuation := Continuation_String'Access;
end if;
end if;
- elsif Data.Library_Kind /= Static and then
- Proj_Data.Library_Kind = Static
+ elsif Project.Library_Kind /= Static and then
+ Proj.Library_Kind = Static
then
- Error_Msg_Name_1 := Data.Name;
- Error_Msg_Name_2 := Proj_Data.Name;
+ Error_Msg_Name_1 := Project.Name;
+ Error_Msg_Name_2 := Proj.Name;
if Extends then
Error_Msg
Continuation.all &
"shared library project %% cannot extend static " &
"library project %%",
- Data.Location);
+ Project.Location);
Continuation := Continuation_String'Access;
elsif not Unchecked_Shared_Lib_Imports then
Continuation.all &
"shared library project %% cannot import static " &
"library project %%",
- Data.Location);
+ Project.Location);
Continuation := Continuation_String'Access;
end if;
-- Special case of extending project
- if Data.Extends /= No_Project then
- declare
- Extended_Data : constant Project_Data :=
- In_Tree.Projects.Table (Data.Extends);
-
- begin
- -- If the project extended is a library project, we inherit the
- -- library name, if it is not redefined; we check that the library
- -- directory is specified.
+ if Project.Extends /= No_Project then
+ -- If the project extended is a library project, we inherit the
+ -- library name, if it is not redefined; we check that the library
+ -- directory is specified.
- if Extended_Data.Library then
- if Data.Qualifier = Standard then
- Error_Msg
- (Project, In_Tree,
- "a standard project cannot extend a library project",
- Data.Location);
+ if Project.Extends.Library then
+ if Project.Qualifier = Standard then
+ Error_Msg
+ (Project, In_Tree,
+ "a standard project cannot extend a library project",
+ Project.Location);
- else
- if Lib_Name.Default then
- Data.Library_Name := Extended_Data.Library_Name;
- end if;
+ else
+ if Lib_Name.Default then
+ Project.Library_Name := Project.Extends.Library_Name;
+ end if;
- if Lib_Dir.Default then
- if not Data.Virtual then
- Error_Msg
- (Project, In_Tree,
- "a project extending a library project must " &
- "specify an attribute Library_Dir",
- Data.Location);
+ if Lib_Dir.Default then
+ if not Project.Virtual then
+ Error_Msg
+ (Project, In_Tree,
+ "a project extending a library project must " &
+ "specify an attribute Library_Dir",
+ Project.Location);
- else
- -- For a virtual project extending a library project,
- -- inherit library directory.
+ else
+ -- For a virtual project extending a library project,
+ -- inherit library directory.
- Data.Library_Dir := Extended_Data.Library_Dir;
- Library_Directory_Present := True;
- end if;
+ Project.Library_Dir := Project.Extends.Library_Dir;
+ Library_Directory_Present := True;
end if;
end if;
end if;
- end;
+ end if;
end if;
pragma Assert (Lib_Name.Kind = Single);
if Lib_Name.Value = Empty_String then
if Current_Verbosity = High
- and then Data.Library_Name = No_Name
+ and then Project.Library_Name = No_Name
then
Write_Line ("No library name");
end if;
else
-- There is no restriction on the syntax of library names
- Data.Library_Name := Lib_Name.Value;
+ Project.Library_Name := Lib_Name.Value;
end if;
- if Data.Library_Name /= No_Name then
+ if Project.Library_Name /= No_Name then
if Current_Verbosity = High then
- Write_Attr ("Library name", Get_Name_String (Data.Library_Name));
+ Write_Attr
+ ("Library name", Get_Name_String (Project.Library_Name));
end if;
pragma Assert (Lib_Dir.Kind = Single);
else
-- Find path name (unless inherited), check that it is a directory
- if Data.Library_Dir = No_Path_Information then
+ if Project.Library_Dir = No_Path_Information then
Locate_Directory
(Project,
In_Tree,
File_Name_Type (Lib_Dir.Value),
- Data.Directory.Display_Name,
- Data.Library_Dir.Name,
- Data.Library_Dir.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Library_Dir.Name,
+ Project.Library_Dir.Display_Name,
Create => "library",
Current_Dir => Current_Dir,
Location => Lib_Dir.Location,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
end if;
- if Data.Library_Dir = No_Path_Information then
+ if Project.Library_Dir = No_Path_Information then
-- Get the absolute name of the library directory that
-- does not exist, to report an error.
File_Name_Type (Lib_Dir.Value);
else
- Get_Name_String (Data.Directory.Display_Name);
+ Get_Name_String (Project.Directory.Display_Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
-- The library directory cannot be the same as the Object
-- directory.
- elsif Data.Library_Dir.Name = Data.Object_Directory.Name then
+ elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
Error_Msg
(Project, In_Tree,
"library directory cannot be the same " &
"as object directory",
Lib_Dir.Location);
- Data.Library_Dir := No_Path_Information;
+ Project.Library_Dir := No_Path_Information;
else
declare
OK : Boolean := True;
Dirs_Id : String_List_Id;
Dir_Elem : String_Element;
+ Pid : Project_List;
begin
-- The library directory cannot be the same as a source
-- directory of the current project.
- Dirs_Id := Data.Source_Dirs;
+ Dirs_Id := Project.Source_Dirs;
while Dirs_Id /= Nil_String loop
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if
- Data.Library_Dir.Name = Path_Name_Type (Dir_Elem.Value)
+ if Project.Library_Dir.Name =
+ Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
-- The library directory cannot be the same as a source
-- directory of another project either.
- Project_Loop :
- for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
- if Pid /= Project then
- Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
+ Pid := In_Tree.Projects;
+ Project_Loop : loop
+ exit Project_Loop when Pid = null;
+
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
Dir_Loop : while Dirs_Id /= Nil_String loop
Dir_Elem :=
In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if Data.Library_Dir.Name =
+ if Project.Library_Dir.Name =
Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
- Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Pid).Name;
+ Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
Error_Msg
(Project, In_Tree,
end if;
end loop Dir_Loop;
end if;
+
+ Pid := Pid.Next;
end loop Project_Loop;
end if;
if not OK then
- Data.Library_Dir := No_Path_Information;
+ Project.Library_Dir := No_Path_Information;
elsif Current_Verbosity = High then
Write_Attr
("Library directory",
- Get_Name_String (Data.Library_Dir.Display_Name));
+ Get_Name_String (Project.Library_Dir.Display_Name));
end if;
end;
end if;
end if;
- Data.Library :=
- Data.Library_Dir /= No_Path_Information
- and then
- Data.Library_Name /= No_Name;
+ Project.Library :=
+ Project.Library_Dir /= No_Path_Information
+ and then Project.Library_Name /= No_Name;
- if Data.Extends = No_Project then
- case Data.Qualifier is
+ if Project.Extends = No_Project then
+ case Project.Qualifier is
when Standard =>
- if Data.Library then
+ if Project.Library then
Error_Msg
(Project, In_Tree,
"a standard project cannot be a library project",
end if;
when Library =>
- if not Data.Library then
- if Data.Library_Dir = No_Path_Information then
+ if not Project.Library then
+ if Project.Library_Dir = No_Path_Information then
Error_Msg
(Project, In_Tree,
"\attribute Library_Dir not declared",
- Data.Location);
+ Project.Location);
end if;
- if Data.Library_Name = No_Name then
+ if Project.Library_Name = No_Name then
Error_Msg
(Project, In_Tree,
"\attribute Library_Name not declared",
- Data.Location);
+ Project.Location);
end if;
end if;
end case;
end if;
- if Data.Library then
+ if Project.Library then
if Get_Mode = Multi_Language then
- Support_For_Libraries := Data.Config.Lib_Support;
+ Support_For_Libraries := Project.Config.Lib_Support;
else
Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
(Project, In_Tree,
"?libraries are not supported on this platform",
Lib_Name.Location);
- Data.Library := False;
+ Project.Library := False;
else
if Lib_ALI_Dir.Value = Empty_String then
if Current_Verbosity = High then
Write_Line ("No library ALI directory specified");
end if;
- Data.Library_ALI_Dir := Data.Library_Dir;
+ Project.Library_ALI_Dir := Project.Library_Dir;
else
-- Find path name, check that it is a directory
(Project,
In_Tree,
File_Name_Type (Lib_ALI_Dir.Value),
- Data.Directory.Display_Name,
- Data.Library_ALI_Dir.Name,
- Data.Library_ALI_Dir.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Library_ALI_Dir.Name,
+ Project.Library_ALI_Dir.Display_Name,
Create => "library ALI",
Current_Dir => Current_Dir,
Location => Lib_ALI_Dir.Location,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
- if Data.Library_ALI_Dir = No_Path_Information then
+ if Project.Library_ALI_Dir = No_Path_Information then
-- Get the absolute name of the library ALI directory that
-- does not exist, to report an error.
File_Name_Type (Lib_Dir.Value);
else
- Get_Name_String (Data.Directory.Display_Name);
+ Get_Name_String (Project.Directory.Display_Name);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
end;
end if;
- if Data.Library_ALI_Dir /= Data.Library_Dir then
+ if Project.Library_ALI_Dir /= Project.Library_Dir then
-- The library ALI directory cannot be the same as the
-- Object directory.
- if Data.Library_ALI_Dir = Data.Object_Directory then
+ if Project.Library_ALI_Dir = Project.Object_Directory then
Error_Msg
(Project, In_Tree,
"library 'A'L'I directory cannot be the same " &
"as object directory",
Lib_ALI_Dir.Location);
- Data.Library_ALI_Dir := No_Path_Information;
+ Project.Library_ALI_Dir := No_Path_Information;
else
declare
OK : Boolean := True;
Dirs_Id : String_List_Id;
Dir_Elem : String_Element;
+ Pid : Project_List;
begin
-- The library ALI directory cannot be the same as
-- a source directory of the current project.
- Dirs_Id := Data.Source_Dirs;
+ Dirs_Id := Project.Source_Dirs;
while Dirs_Id /= Nil_String loop
Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if Data.Library_ALI_Dir.Name =
+ if Project.Library_ALI_Dir.Name =
Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
-- The library ALI directory cannot be the same as
-- a source directory of another project either.
- ALI_Project_Loop :
- for
- Pid in 1 .. Project_Table.Last (In_Tree.Projects)
- loop
- if Pid /= Project then
- Dirs_Id :=
- In_Tree.Projects.Table (Pid).Source_Dirs;
+ Pid := In_Tree.Projects;
+ ALI_Project_Loop : loop
+ exit ALI_Project_Loop when Pid = null;
+
+ if Pid.Project /= Project then
+ Dirs_Id := Pid.Project.Source_Dirs;
ALI_Dir_Loop :
while Dirs_Id /= Nil_String loop
In_Tree.String_Elements.Table (Dirs_Id);
Dirs_Id := Dir_Elem.Next;
- if Data.Library_ALI_Dir.Name =
+ if Project.Library_ALI_Dir.Name =
Path_Name_Type (Dir_Elem.Value)
then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Dir_Elem.Value);
Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Pid).Name;
+ Pid.Project.Name;
Error_Msg
(Project, In_Tree,
end if;
end loop ALI_Dir_Loop;
end if;
+ Pid := Pid.Next;
end loop ALI_Project_Loop;
end if;
if not OK then
- Data.Library_ALI_Dir := No_Path_Information;
+ Project.Library_ALI_Dir := No_Path_Information;
elsif Current_Verbosity = High then
Write_Attr
("Library ALI dir",
Get_Name_String
- (Data.Library_ALI_Dir.Display_Name));
+ (Project.Library_ALI_Dir.Display_Name));
end if;
end;
end if;
end if;
else
- Data.Lib_Internal_Name := Lib_Version.Value;
+ Project.Lib_Internal_Name := Lib_Version.Value;
end if;
pragma Assert (The_Lib_Kind.Kind = Single);
begin
if Kind_Name = "static" then
- Data.Library_Kind := Static;
+ Project.Library_Kind := Static;
elsif Kind_Name = "dynamic" then
- Data.Library_Kind := Dynamic;
+ Project.Library_Kind := Dynamic;
elsif Kind_Name = "relocatable" then
- Data.Library_Kind := Relocatable;
+ Project.Library_Kind := Relocatable;
else
Error_Msg
Write_Attr ("Library kind", Kind_Name);
end if;
- if Data.Library_Kind /= Static then
+ if Project.Library_Kind /= Static then
if Support_For_Libraries = Prj.Static_Only then
Error_Msg
(Project, In_Tree,
"only static libraries are supported " &
"on this platform",
The_Lib_Kind.Location);
- Data.Library := False;
+ Project.Library := False;
else
-- Check if (obsolescent) attribute Library_GCC or
"?Library_'G'C'C is an obsolescent attribute, " &
"use Linker''Driver instead",
Lib_GCC.Location);
- Data.Config.Shared_Lib_Driver :=
+ Project.Config.Shared_Lib_Driver :=
File_Name_Type (Lib_GCC.Value);
else
Linker : constant Package_Id :=
Value_Of
(Name_Linker,
- Data.Decl.Packages,
+ Project.Decl.Packages,
In_Tree);
Driver : constant Variable_Value :=
Value_Of
if Driver /= Nil_Variable_Value
and then Driver.Value /= Empty_String
then
- Data.Config.Shared_Lib_Driver :=
+ Project.Config.Shared_Lib_Driver :=
File_Name_Type (Driver.Value);
end if;
end;
end;
end if;
- if Data.Library then
+ if Project.Library then
if Current_Verbosity = High then
Write_Line ("This is a library project file");
end if;
if Get_Mode = Multi_Language then
- Check_Library (Data.Extends, Extends => True);
+ Check_Library (Project.Extends, Extends => True);
- Imported_Project_List := Data.Imported_Projects;
+ Imported_Project_List := Project.Imported_Projects;
while Imported_Project_List /= null loop
Check_Library
(Imported_Project_List.Project,
-- Warn if they are declared, as it is a common error to think that
-- library are "linked" with Linker switches.
- if Data.Library then
+ if Project.Library then
declare
Linker_Package_Id : constant Package_Id :=
Util.Value_Of
- (Name_Linker, Data.Decl.Packages, In_Tree);
+ (Name_Linker,
+ Project.Decl.Packages, In_Tree);
Linker_Package : Package_Element;
Switches : Array_Element_Id := No_Array_Element;
end;
end if;
- if Data.Extends /= No_Project then
- In_Tree.Projects.Table (Data.Extends).Library := False;
+ if Project.Extends /= No_Project then
+ Project.Extends.Library := False;
end if;
end Check_Library_Attributes;
procedure Check_Package_Naming
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Naming_Id : constant Package_Id :=
- Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
+ Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree);
Naming : Package_Element;
-- in the project file or if there were none, the default.
if Spec_Suffixs /= No_Array_Element then
- Suffix := Data.Naming.Spec_Suffix;
+ Suffix := Project.Naming.Spec_Suffix;
while Suffix /= No_Array_Element loop
Element :=
-- Put the resulting array as the specification suffixes
- Data.Naming.Spec_Suffix := Spec_Suffixs;
+ Project.Naming.Spec_Suffix := Spec_Suffixs;
end if;
end;
Element : Array_Element;
begin
- Current := Data.Naming.Spec_Suffix;
+ Current := Project.Naming.Spec_Suffix;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value);
-- in the project file or if there were none, the default.
if Impl_Suffixs /= No_Array_Element then
- Suffix := Data.Naming.Body_Suffix;
+ Suffix := Project.Naming.Body_Suffix;
while Suffix /= No_Array_Element loop
Element :=
In_Tree.Array_Elements.Table (Suffix);
-- Put the resulting array as the implementation suffixes
- Data.Naming.Body_Suffix := Impl_Suffixs;
+ Project.Naming.Body_Suffix := Impl_Suffixs;
end if;
end;
Element : Array_Element;
begin
- Current := Data.Naming.Body_Suffix;
+ Current := Project.Naming.Body_Suffix;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value);
-- Get the exceptions, if any
- Data.Naming.Specification_Exceptions :=
+ Project.Naming.Specification_Exceptions :=
Util.Value_Of
(Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
- Data.Naming.Implementation_Exceptions :=
+ Project.Naming.Implementation_Exceptions :=
Util.Value_Of
(Name_Implementation_Exceptions,
In_Arrays => Naming.Decl.Arrays,
procedure Check_Programming_Languages
(In_Tree : Project_Tree_Ref;
- Project : Project_Id;
- Data : in out Project_Data)
+ Project : Project_Id)
is
Languages : Variable_Value := Nil_Variable_Value;
Def_Lang : Variable_Value := Nil_Variable_Value;
Def_Lang_Id : Name_Id;
begin
- Data.Languages := No_Language_Index;
+ Project.Languages := No_Language_Index;
Languages :=
- Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
+ Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, In_Tree);
Def_Lang :=
Prj.Util.Value_Of
- (Name_Default_Language, Data.Decl.Attributes, In_Tree);
+ (Name_Default_Language, Project.Decl.Attributes, In_Tree);
-- Shouldn't these be set to False by default, and only set to True when
-- we actually find some source file???
- if Data.Source_Dirs /= Nil_String then
+ if Project.Source_Dirs /= Nil_String then
-- Check if languages are specified in this project
(Project,
In_Tree,
"no languages defined for this project",
- Data.Location);
+ Project.Location);
Def_Lang_Id := No_Name;
else
Def_Lang_Id := Name_Ada;
end if;
if Def_Lang_Id /= No_Name then
- Data.Languages :=
- new Language_Data'(No_Language_Data);
- Data.Languages.Name := Def_Lang_Id;
+ Project.Languages := new Language_Data'(No_Language_Data);
+ Project.Languages.Name := Def_Lang_Id;
Get_Name_String (Def_Lang_Id);
Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
- Data.Languages.Display_Name := Name_Find;
+ Project.Languages.Display_Name := Name_Find;
if Def_Lang_Id = Name_Ada then
- Data.Languages.Config.Kind := Unit_Based;
- Data.Languages.Config.Dependency_Kind :=
- ALI_File;
+ Project.Languages.Config.Kind := Unit_Based;
+ Project.Languages.Config.Dependency_Kind := ALI_File;
else
- Data.Languages.Config.Kind := File_Based;
+ Project.Languages.Config.Kind := File_Based;
end if;
end if;
-- If there are no languages declared, there are no sources
if Current = Nil_String then
- Data.Source_Dirs := Nil_String;
+ Project.Source_Dirs := Nil_String;
- if Data.Qualifier = Standard then
+ if Project.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
-- If the language was not already specified (duplicates
-- are simply ignored).
- NL_Id := Data.Languages;
+ NL_Id := Project.Languages;
while NL_Id /= No_Language_Index loop
exit when Lang_Name = NL_Id.Name;
NL_Id := NL_Id.Next;
Index := new Language_Data'(No_Language_Data);
Index.Name := Lang_Name;
Index.Display_Name := Element.Value;
- Index.Next := Data.Languages;
+ Index.Next := Project.Languages;
if Lang_Name = Name_Ada then
Index.Config.Kind := Unit_Based;
Index.Config.Dependency_Kind := None;
end if;
- Data.Languages := Index;
+ Project.Languages := Index;
end if;
Current := Element.Next;
function Check_Project
(P : Project_Id;
Root_Project : Project_Id;
- In_Tree : Project_Tree_Ref;
Extending : Boolean) return Boolean
is
+ Prj : Project_Id;
begin
if P = Root_Project then
return True;
elsif Extending then
- declare
- Data : Project_Data;
-
- begin
- Data := In_Tree.Projects.Table (Root_Project);
- while Data.Extends /= No_Project loop
- if P = Data.Extends then
- return True;
- end if;
+ Prj := Root_Project;
+ while Prj.Extends /= No_Project loop
+ if P = Prj.Extends then
+ return True;
+ end if;
- Data := In_Tree.Projects.Table (Data.Extends);
- end loop;
- end;
+ Prj := Prj.Extends;
+ end loop;
end if;
return False;
procedure Check_Stand_Alone_Library
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Current_Dir : String;
Extending : Boolean)
is
Lib_Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Interface,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Lib_Auto_Init : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Auto_Init,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Lib_Src_Dir : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Src_Dir,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Lib_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Symbol_File,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Lib_Symbol_Policy : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Symbol_Policy,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Library_Reference_Symbol_File,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Auto_Init_Supported : Boolean;
begin
if Get_Mode = Multi_Language then
- Auto_Init_Supported := Data.Config.Auto_Init_Supported;
+ Auto_Init_Supported := Project.Config.Auto_Init_Supported;
else
Auto_Init_Supported :=
MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
-- Start of processing for SAL_Library
begin
- Data.Standalone_Library := True;
+ Project.Standalone_Library := True;
-- Library_Interface cannot be an empty list
then
if Check_Project
(UData.File_Names (Body_Part).Project,
- Project, In_Tree, Extending)
+ Project, Extending)
then
-- There is a body for this unit.
-- If there is no spec, we need to check that it
and then Check_Project
(UData.File_Names
(Specification).Project,
- Project, In_Tree, Extending)
+ Project, Extending)
then
-- The unit is part of the project, it has a spec,
else
-- Multi_Language mode
- Next_Proj := Data.Extends;
+ Next_Proj := Project.Extends;
Iter := For_Each_Source (In_Tree, Project);
Next_Proj = No_Project;
Iter := For_Each_Source (In_Tree, Next_Proj);
- Next_Proj :=
- In_Tree.Projects.Table (Next_Proj).Extends;
+ Next_Proj := Next_Proj.Extends;
end loop;
if Source /= No_Source then
if Source /= No_Source then
if Source.Project /= Project
and then
- not Is_Extending (Project, Source.Project, In_Tree)
+ not Is_Extending (Project, Source.Project)
then
Source := No_Source;
end if;
-- Put the list of Interface ALIs in the project data
- Data.Lib_Interface_ALIs := Interface_ALIs;
+ Project.Lib_Interface_ALIs := Interface_ALIs;
-- Check value of attribute Library_Auto_Init and set
-- Lib_Auto_Init accordingly.
-- If no attribute Library_Auto_Init is declared, then set auto
-- init only if it is supported.
- Data.Lib_Auto_Init := Auto_Init_Supported;
+ Project.Lib_Auto_Init := Auto_Init_Supported;
else
Get_Name_String (Lib_Auto_Init.Value);
To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Buffer (1 .. Name_Len) = "false" then
- Data.Lib_Auto_Init := False;
+ Project.Lib_Auto_Init := False;
elsif Name_Buffer (1 .. Name_Len) = "true" then
if Auto_Init_Supported then
- Data.Lib_Auto_Init := True;
+ Project.Lib_Auto_Init := True;
else
-- Library_Auto_Init cannot be "true" if auto init is not
(Project,
In_Tree,
Dir_Id,
- Data.Directory.Display_Name,
- Data.Library_Src_Dir.Name,
- Data.Library_Src_Dir.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Library_Src_Dir.Name,
+ Project.Library_Src_Dir.Display_Name,
Create => "library source copy",
Current_Dir => Current_Dir,
Location => Lib_Src_Dir.Location,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
-- If directory does not exist, report an error
- if Data.Library_Src_Dir = No_Path_Information then
+ if Project.Library_Src_Dir = No_Path_Information then
-- Get the absolute name of the library directory that does
-- not exist, to report an error.
Err_Vars.Error_Msg_File_1 := Dir_Id;
else
- Get_Name_String (Data.Directory.Name);
+ Get_Name_String (Project.Directory.Name);
if Name_Buffer (Name_Len) /=
Directory_Separator
-- Report error if it is the same as the object directory
- elsif Data.Library_Src_Dir = Data.Object_Directory then
+ elsif Project.Library_Src_Dir = Project.Object_Directory then
Error_Msg
(Project, In_Tree,
"directory to copy interfaces cannot be " &
"the object directory",
Lib_Src_Dir.Location);
- Data.Library_Src_Dir := No_Path_Information;
+ Project.Library_Src_Dir := No_Path_Information;
else
declare
Src_Dirs : String_List_Id;
Src_Dir : String_Element;
+ Pid : Project_List;
begin
-- Interface copy directory cannot be one of the source
-- directory of the current project.
- Src_Dirs := Data.Source_Dirs;
+ Src_Dirs := Project.Source_Dirs;
while Src_Dirs /= Nil_String loop
Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source directories
- if Data.Library_Src_Dir.Name =
+ if Project.Library_Src_Dir.Name =
Path_Name_Type (Src_Dir.Value)
then
Error_Msg
"directory to copy interfaces cannot " &
"be one of the source directories",
Lib_Src_Dir.Location);
- Data.Library_Src_Dir := No_Path_Information;
+ Project.Library_Src_Dir := No_Path_Information;
exit;
end if;
Src_Dirs := Src_Dir.Next;
end loop;
- if Data.Library_Src_Dir /= No_Path_Information then
+ if Project.Library_Src_Dir /= No_Path_Information then
-- It cannot be a source directory of any other
-- project either.
- Project_Loop : for Pid in 1 ..
- Project_Table.Last (In_Tree.Projects)
- loop
- Src_Dirs :=
- In_Tree.Projects.Table (Pid).Source_Dirs;
+ Pid := In_Tree.Projects;
+ Project_Loop : loop
+ exit Project_Loop when Pid = null;
+
+ Src_Dirs := Pid.Project.Source_Dirs;
Dir_Loop : while Src_Dirs /= Nil_String loop
Src_Dir :=
In_Tree.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source
-- directories
- if Data.Library_Src_Dir.Name =
+ if Project.Library_Src_Dir.Name =
Path_Name_Type (Src_Dir.Value)
then
Error_Msg_File_1 :=
File_Name_Type (Src_Dir.Value);
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Pid).Name;
+ Error_Msg_Name_1 := Pid.Project.Name;
Error_Msg
(Project, In_Tree,
"directory to copy interfaces cannot " &
"be the same as source directory { of " &
"project %%",
Lib_Src_Dir.Location);
- Data.Library_Src_Dir := No_Path_Information;
+ Project.Library_Src_Dir :=
+ No_Path_Information;
exit Project_Loop;
end if;
Src_Dirs := Src_Dir.Next;
end loop Dir_Loop;
+
+ Pid := Pid.Next;
end loop Project_Loop;
end if;
end;
-- In high verbosity, if there is a valid Library_Src_Dir,
-- display its path name.
- if Data.Library_Src_Dir /= No_Path_Information
+ if Project.Library_Src_Dir /= No_Path_Information
and then Current_Verbosity = High
then
Write_Attr
("Directory to copy interfaces",
- Get_Name_String (Data.Library_Src_Dir.Name));
+ Get_Name_String (Project.Library_Src_Dir.Name));
end if;
end if;
end;
-- Symbol policy must hove one of a limited number of values
if Value = "autonomous" or else Value = "default" then
- Data.Symbol_Data.Symbol_Policy := Autonomous;
+ Project.Symbol_Data.Symbol_Policy := Autonomous;
elsif Value = "compliant" then
- Data.Symbol_Data.Symbol_Policy := Compliant;
+ Project.Symbol_Data.Symbol_Policy := Compliant;
elsif Value = "controlled" then
- Data.Symbol_Data.Symbol_Policy := Controlled;
+ Project.Symbol_Data.Symbol_Policy := Controlled;
elsif Value = "restricted" then
- Data.Symbol_Data.Symbol_Policy := Restricted;
+ Project.Symbol_Data.Symbol_Policy := Restricted;
elsif Value = "direct" then
- Data.Symbol_Data.Symbol_Policy := Direct;
+ Project.Symbol_Data.Symbol_Policy := Direct;
else
Error_Msg
-- cannot be Restricted.
if Lib_Symbol_File.Default then
- if Data.Symbol_Data.Symbol_Policy = Restricted then
+ if Project.Symbol_Data.Symbol_Policy = Restricted then
Error_Msg
(Project, In_Tree,
"Library_Symbol_File needs to be defined when " &
else
-- Library_Symbol_File is defined
- Data.Symbol_Data.Symbol_File :=
+ Project.Symbol_Data.Symbol_File :=
Path_Name_Type (Lib_Symbol_File.Value);
Get_Name_String (Lib_Symbol_File.Value);
-- symbol policy cannot be Compliant or Controlled.
if Lib_Ref_Symbol_File.Default then
- if Data.Symbol_Data.Symbol_Policy = Compliant
- or else Data.Symbol_Data.Symbol_Policy = Controlled
+ if Project.Symbol_Data.Symbol_Policy = Compliant
+ or else Project.Symbol_Data.Symbol_Policy = Controlled
then
Error_Msg
(Project, In_Tree,
else
-- Library_Reference_Symbol_File is defined, check file exists
- Data.Symbol_Data.Reference :=
+ Project.Symbol_Data.Reference :=
Path_Name_Type (Lib_Ref_Symbol_File.Value);
Get_Name_String (Lib_Ref_Symbol_File.Value);
if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
Name_Len := 0;
Add_Str_To_Name_Buffer
- (Get_Name_String (Data.Directory.Name));
+ (Get_Name_String (Project.Directory.Name));
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer
(Get_Name_String (Lib_Ref_Symbol_File.Value));
- Data.Symbol_Data.Reference := Name_Find;
+ Project.Symbol_Data.Reference := Name_Find;
end if;
if not Is_Regular_File
- (Get_Name_String (Data.Symbol_Data.Reference))
+ (Get_Name_String (Project.Symbol_Data.Reference))
then
Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value);
-- symbol policies, this is just a warning
Error_Msg_Warn :=
- Data.Symbol_Data.Symbol_Policy /= Controlled
- and then Data.Symbol_Data.Symbol_Policy /= Direct;
+ Project.Symbol_Data.Symbol_Policy /= Controlled
+ and then Project.Symbol_Data.Symbol_Policy /= Direct;
Error_Msg
(Project, In_Tree,
-- is no reference to check against, and we don't want to
-- fail in this case.
- if Data.Symbol_Data.Symbol_Policy /= Controlled then
- if Data.Symbol_Data.Symbol_Policy = Compliant then
- Data.Symbol_Data.Symbol_Policy := Autonomous;
+ if Project.Symbol_Data.Symbol_Policy /= Controlled then
+ if Project.Symbol_Data.Symbol_Policy = Compliant then
+ Project.Symbol_Data.Symbol_Policy := Autonomous;
end if;
end if;
end if;
-- If both the reference symbol file and the symbol file are
-- defined, then check that they are not the same file.
- if Data.Symbol_Data.Symbol_File /= No_Path then
- Get_Name_String (Data.Symbol_Data.Symbol_File);
+ if Project.Symbol_Data.Symbol_File /= No_Path then
+ Get_Name_String (Project.Symbol_Data.Symbol_File);
if Name_Len > 0 then
declare
Symb_Path : constant String :=
Normalize_Pathname
(Get_Name_String
- (Data.Object_Directory.Name) &
+ (Project.Object_Directory.Name) &
Directory_Separator &
Name_Buffer (1 .. Name_Len),
Directory => Current_Dir,
Ref_Path : constant String :=
Normalize_Pathname
(Get_Name_String
- (Data.Symbol_Data.Reference),
+ (Project.Symbol_Data.Reference),
Directory => Current_Dir,
Resolve_Links =>
Opt.Follow_Links_For_Files);
-- If location of error is unknown, use the location of the project
if Real_Location = No_Location then
- Real_Location := In_Tree.Projects.Table (Project).Location;
+ Real_Location := Project.Location;
end if;
if Error_Report = null then
procedure Get_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Current_Dir : String;
- Data : in out Project_Data)
+ Current_Dir : String)
is
Object_Dir : constant Variable_Value :=
Util.Value_Of
- (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
+ (Name_Object_Dir, Project.Decl.Attributes, In_Tree);
Exec_Dir : constant Variable_Value :=
Util.Value_Of
- (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
+ (Name_Exec_Dir, Project.Decl.Attributes, In_Tree);
Source_Dirs : constant Variable_Value :=
Util.Value_Of
- (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
+ (Name_Source_Dirs, Project.Decl.Attributes, In_Tree);
Excluded_Source_Dirs : constant Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_Dirs,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Source_Files : constant Variable_Value :=
Util.Value_Of
- (Name_Source_Files, Data.Decl.Attributes, In_Tree);
+ (Name_Source_Files, Project.Decl.Attributes, In_Tree);
Last_Source_Dir : String_List_Id := Nil_String;
Languages : constant Variable_Value :=
Prj.Util.Value_Of
- (Name_Languages, Data.Decl.Attributes, In_Tree);
+ (Name_Languages, Project.Decl.Attributes, In_Tree);
procedure Find_Source_Dirs
(From : File_Name_Type;
-- Check if directory is already in list
- List := Data.Source_Dirs;
+ List := Project.Source_Dirs;
Prev := Nil_String;
while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List);
-- Case of first source directory
if Last_Source_Dir = Nil_String then
- Data.Source_Dirs := String_Element_Table.Last
+ Project.Source_Dirs := String_Element_Table.Last
(In_Tree.String_Elements);
-- Here we already have source directories
elsif Removed and Found then
if Prev = Nil_String then
- Data.Source_Dirs :=
+ Project.Source_Dirs :=
In_Tree.String_Elements.Table (List).Next;
else
In_Tree.String_Elements.Table (Prev).Next :=
Directory (Directory'Last - 2) = Directory_Separator)
then
if not Removed then
- Data.Known_Order_Of_Source_Dirs := False;
+ Project.Known_Order_Of_Source_Dirs := False;
end if;
Name_Len := Directory'Length - 3;
Normalize_Pathname
(Name => Get_Name_String (Base_Dir),
Directory =>
- Get_Name_String (Data.Directory.Display_Name),
+ Get_Name_String
+ (Project.Directory.Display_Name),
Resolve_Links => False,
Case_Sensitive => True);
Error_Msg
(Project, In_Tree,
"{ is not a valid directory.",
- Data.Location);
+ Project.Location);
else
Error_Msg
(Project, In_Tree,
(Project => Project,
In_Tree => In_Tree,
Name => From,
- Parent => Data.Directory.Display_Name,
+ Parent => Project.Directory.Display_Name,
Dir => Path_Name,
Display => Display_Path_Name,
Current_Dir => Current_Dir);
Error_Msg
(Project, In_Tree,
"{ is not a valid directory",
- Data.Location);
+ Project.Location);
else
Error_Msg
(Project, In_Tree,
-- This is the first source directory
- Data.Source_Dirs := String_Element_Table.Last
+ Project.Source_Dirs := String_Element_Table.Last
(In_Tree.String_Elements);
else
else
-- Remove source dir, if present
- List := Data.Source_Dirs;
+ List := Project.Source_Dirs;
Prev := Nil_String;
-- Look for source dir in current list
-- Source dir was found, remove it from the list
if Prev = Nil_String then
- Data.Source_Dirs :=
+ Project.Source_Dirs :=
In_Tree.String_Elements.Table (List).Next;
else
((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
or else
((not Languages.Default) and then Languages.Values = Nil_String))
- and then Data.Extends = No_Project
+ and then Project.Extends = No_Project
then
- Data.Object_Directory := No_Path_Information;
+ Project.Object_Directory := No_Path_Information;
else
- Data.Object_Directory := Data.Directory;
+ Project.Object_Directory := Project.Directory;
end if;
-- Check the object directory
(Project,
In_Tree,
File_Name_Type (Object_Dir.Value),
- Data.Directory.Display_Name,
- Data.Object_Directory.Name,
- Data.Object_Directory.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Object_Directory.Name,
+ Project.Object_Directory.Display_Name,
Create => "object",
Location => Object_Dir.Location,
Current_Dir => Current_Dir,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
- if Data.Object_Directory = No_Path_Information then
+ if Project.Object_Directory = No_Path_Information then
-- The object directory does not exist, report an error if the
-- project is not externally built.
- if not Data.Externally_Built then
+ if not Project.Externally_Built then
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Object_Dir.Value);
Error_Msg
(Project, In_Tree,
"object directory { not found",
- Data.Location);
+ Project.Location);
end if;
-- Do not keep a nil Object_Directory. Set it to the specified
-- tools that recover from errors; for example, these tools
-- could create the non existent directory.
- Data.Object_Directory.Display_Name :=
+ Project.Object_Directory.Display_Name :=
Path_Name_Type (Object_Dir.Value);
- Data.Object_Directory.Name :=
+ Project.Object_Directory.Name :=
Path_Name_Type (Canonical_Case_File_Name (Object_Dir.Value));
end if;
end if;
- elsif Data.Object_Directory /= No_Path_Information and then
+ elsif Project.Object_Directory /= No_Path_Information and then
Subdirs /= null
then
Name_Len := 1;
(Project,
In_Tree,
Name_Find,
- Data.Directory.Display_Name,
- Data.Object_Directory.Name,
- Data.Object_Directory.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Object_Directory.Name,
+ Project.Object_Directory.Display_Name,
Create => "object",
Location => Object_Dir.Location,
Current_Dir => Current_Dir,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
end if;
if Current_Verbosity = High then
- if Data.Object_Directory = No_Path_Information then
+ if Project.Object_Directory = No_Path_Information then
Write_Line ("No object directory");
else
Write_Attr
("Object directory",
- Get_Name_String (Data.Object_Directory.Display_Name));
+ Get_Name_String (Project.Object_Directory.Display_Name));
end if;
end if;
-- We set the object directory to its default
- Data.Exec_Directory := Data.Object_Directory;
+ Project.Exec_Directory := Project.Object_Directory;
if Exec_Dir.Value /= Empty_String then
Get_Name_String (Exec_Dir.Value);
(Project,
In_Tree,
File_Name_Type (Exec_Dir.Value),
- Data.Directory.Display_Name,
- Data.Exec_Directory.Name,
- Data.Exec_Directory.Display_Name,
+ Project.Directory.Display_Name,
+ Project.Exec_Directory.Name,
+ Project.Exec_Directory.Display_Name,
Create => "exec",
Location => Exec_Dir.Location,
Current_Dir => Current_Dir,
- Externally_Built => Data.Externally_Built);
+ Externally_Built => Project.Externally_Built);
- if Data.Exec_Directory = No_Path_Information then
+ if Project.Exec_Directory = No_Path_Information then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
Error_Msg
(Project, In_Tree,
"exec directory { not found",
- Data.Location);
+ Project.Location);
end if;
end if;
end if;
if Current_Verbosity = High then
- if Data.Exec_Directory = No_Path_Information then
+ if Project.Exec_Directory = No_Path_Information then
Write_Line ("No exec directory");
else
Write_Str ("Exec directory: """);
- Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
+ Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
Write_Line ("""");
end if;
end if;
if (not Source_Files.Default) and then
Source_Files.Values = Nil_String
then
- Data.Source_Dirs := Nil_String;
+ Project.Source_Dirs := Nil_String;
- if Data.Qualifier = Standard then
+ if Project.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
String_Element_Table.Increment_Last
(In_Tree.String_Elements);
- Data.Source_Dirs := String_Element_Table.Last
+ Project.Source_Dirs := String_Element_Table.Last
(In_Tree.String_Elements);
- In_Tree.String_Elements.Table (Data.Source_Dirs) :=
- (Value => Name_Id (Data.Directory.Name),
- Display_Value => Name_Id (Data.Directory.Display_Name),
+ In_Tree.String_Elements.Table (Project.Source_Dirs) :=
+ (Value => Name_Id (Project.Directory.Name),
+ Display_Value => Name_Id (Project.Directory.Display_Name),
Location => No_Location,
Flag => False,
Next => Nil_String,
if Current_Verbosity = High then
Write_Attr
("Single source directory",
- Get_Name_String (Data.Directory.Display_Name));
+ Get_Name_String (Project.Directory.Display_Name));
end if;
elsif Source_Dirs.Values = Nil_String then
- if Data.Qualifier = Standard then
+ if Project.Qualifier = Standard then
Error_Msg
(Project,
In_Tree,
Source_Dirs.Location);
end if;
- Data.Source_Dirs := Nil_String;
+ Project.Source_Dirs := Nil_String;
else
declare
end if;
declare
- Current : String_List_Id := Data.Source_Dirs;
+ Current : String_List_Id := Project.Source_Dirs;
Element : String_Element;
begin
procedure Get_Mains
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Mains : constant Variable_Value :=
- Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
+ Prj.Util.Value_Of (Name_Main, Project.Decl.Attributes, In_Tree);
List : String_List_Id;
Elem : String_Element;
begin
- Data.Mains := Mains.Values;
+ Project.Mains := Mains.Values;
-- If no Mains were specified, and if we are an extending project,
-- inherit the Mains from the project we are extending.
if Mains.Default then
- if not Data.Library and then Data.Extends /= No_Project then
- Data.Mains :=
- In_Tree.Projects.Table (Data.Extends).Mains;
+ if not Project.Library and then Project.Extends /= No_Project then
+ Project.Mains := Project.Extends.Mains;
end if;
-- In a library project file, Main cannot be specified
- elsif Data.Library then
+ elsif Project.Library then
Error_Msg
(Project, In_Tree,
"a library project file cannot have Main specified",
procedure Find_Excluded_Sources
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : Project_Data)
+ In_Tree : Project_Tree_Ref)
is
Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_List_File,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Current : String_List_Id;
Locally_Removed := True;
Excluded_Sources :=
Util.Value_Of
- (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
+ (Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree);
end if;
Excluded_Sources_Htable.Reset;
Path_Name_Of
(File_Name_Type
(Excluded_Source_List_File.Value),
- Data.Directory.Name);
+ Project.Directory.Name);
begin
if Source_File_Path_Name'Length = 0 then
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Proc_Data : in out Processing_Data)
is
Sources : constant Variable_Value :=
Util.Value_Of
(Name_Source_Files,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Source_List_File,
- Data.Decl.Attributes,
+ Project.Decl.Attributes,
In_Tree);
Name_Loc : Name_Location;
begin
if Get_Mode = Multi_Language then
if Current = Nil_String then
- Data.Languages := No_Language_Index;
+ Project.Languages := No_Language_Index;
-- This project contains no source. For projects that don't
-- extend other projects, this also means that there is no
-- need for an object directory, if not specified.
- if Data.Extends = No_Project
- and then Data.Object_Directory = Data.Directory
+ if Project.Extends = No_Project
+ and then Project.Object_Directory = Project.Directory
then
- Data.Object_Directory := No_Path_Information;
+ Project.Object_Directory := No_Path_Information;
end if;
end if;
end if;
declare
Source_File_Path_Name : constant String :=
Path_Name_Of
- (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
+ (File_Name_Type (Source_List_File.Value),
+ Project.Directory.Name);
begin
Has_Explicit_Sources := True;
else
Search_Directories
- (Project, In_Tree, Data,
+ (Project, In_Tree,
For_All_Sources =>
Sources.Default and then Source_List_File.Default);
end if;
end if;
if Get_Mode = Ada_Only
- and then Data.Extends = No_Project
+ and then Project.Extends = No_Project
then
-- We should have found at least one source, if not report an error
- if not Has_Ada_Sources (Data) then
+ if not Has_Ada_Sources (Project) then
Report_No_Sources
(Project, "Ada", In_Tree, Source_List_File.Location);
end if;
Explicit_Sources_Only : Boolean;
Proc_Data : in out Processing_Data)
is
- Data : Project_Data renames In_Tree.Projects.Table (Project);
Source_Dir : String_List_Id;
Element : String_Element;
Dir : Dir_Type;
Write_Line ("Looking for Ada sources:");
end if;
- Ada_Language := Data.Languages;
+ Ada_Language := Project.Languages;
while Ada_Language /= No_Language_Index
and then Ada_Language.Name /= Name_Ada
loop
-- We look in all source directories for the file names in the hash
-- table Source_Names.
- Source_Dir := Data.Source_Dirs;
+ Source_Dir := Project.Source_Dirs;
while Source_Dir /= Nil_String loop
Dir_Has_Source := False;
Element := In_Tree.String_Elements.Table (Source_Dir);
procedure Check_File_Naming_Schemes
(In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
+ Project : Project_Id;
File_Name : File_Name_Type;
Alternate_Languages : out Language_List;
Language : out Language_Ptr;
Lang_Kind := File_Based;
Kind := Spec;
- Tmp_Lang := Data.Languages;
+ Tmp_Lang := Project.Languages;
while Tmp_Lang /= No_Language_Index loop
Language_Name := Tmp_Lang.Name;
procedure Check_File
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
-- Check if it is OK to have the same file name in several
-- source directories.
- if not Data.Known_Order_Of_Source_Dirs then
+ if not Project.Known_Order_Of_Source_Dirs then
Error_Msg_File_1 := File_Name;
Error_Msg
(Project, In_Tree,
Check_File_Naming_Schemes
(In_Tree => In_Tree,
- Data => Data,
+ Project => Project,
File_Name => File_Name,
Alternate_Languages => Alternate_Languages,
Language => Language,
-- allowed if order of source directories is known.
if Project = Source.Project then
- if Data.Known_Order_Of_Source_Dirs then
+ if Project.Known_Order_Of_Source_Dirs then
Add_Src := False;
elsif Unit /= No_Name then
-- a file in a project being extended, but it is allowed
-- to have the same file name in unrelated projects.
- elsif Is_Extending (Project, Source.Project, In_Tree) then
+ elsif Is_Extending (Project, Source.Project) then
Source_To_Replace := Source;
elsif Unit /= No_Name
"unit %% cannot belong to several projects",
No_Location);
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Project).Name;
+ Error_Msg_Name_1 := Project.Name;
Error_Msg_Name_2 := Name_Id (Path);
Error_Msg
(Project, In_Tree, "\ project %%, %%", No_Location);
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Source.Project).Name;
+ Error_Msg_Name_1 := Source.Project.Name;
Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
Error_Msg
(Project, In_Tree, "\ project %%, %%", No_Location);
procedure Search_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
For_All_Sources : Boolean)
is
Source_Dir : String_List_Id;
-- Loop through subdirectories
- Source_Dir := Data.Source_Dirs;
+ Source_Dir := Project.Source_Dirs;
while Source_Dir /= Nil_String loop
begin
Element := In_Tree.String_Elements.Table (Source_Dir);
Check_File
(Project => Project,
In_Tree => In_Tree,
- Data => Data,
Path => Path,
File_Name => File_Name,
Display_File_Name => Display_File_Name,
procedure Look_For_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Proc_Data : in out Processing_Data)
is
Iter : Source_Iterator;
is
begin
if Extended = Project
- or else Is_Extending (Project, Extended, In_Tree)
+ or else Is_Extending (Project, Extended)
then
OK := True;
-- ??? This loop could be the same as for Multi_Language if
-- we were setting In_Tree.First_Source when we search for
-- Ada sources (basically once we have removed the use of
- -- Data.Ada_Sources).
+ -- Project.Ada_Sources).
For_Each_Unit :
for Index in Unit_Table.First ..
exit when Src_Id = No_Source;
if Src_Id.Compiled and then Src_Id.Object_Exists
- and then Is_Extending (Project, Src_Id.Project, In_Tree)
+ and then Is_Extending (Project, Src_Id.Project)
then
if Src_Id.Unit = No_Name then
if Src_Id.Kind = Impl then
begin
Source_Names.Reset;
- Find_Excluded_Sources (Project, In_Tree, Data);
+ Find_Excluded_Sources (Project, In_Tree);
- if (Get_Mode = Ada_Only and then Is_A_Language (Data, Name_Ada))
+ if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada))
or else (Get_Mode = Multi_Language
- and then Data.Languages /= No_Language_Index)
+ and then Project.Languages /= No_Language_Index)
then
if Get_Mode = Multi_Language then
Load_Naming_Exceptions (Project, In_Tree);
end if;
- Find_Sources (Project, In_Tree, Data, Proc_Data);
+ Find_Sources (Project, In_Tree, Proc_Data);
Mark_Excluded_Sources;
if Get_Mode = Multi_Language then
Location : Source_Ptr;
Source_Recorded : in out Boolean)
is
- Data : Project_Data renames In_Tree.Projects.Table (Project);
Canonical_File : File_Name_Type;
Canonical_Path : Path_Name_Type;
and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).Name = No_File
or else Is_Extending
- (Data.Extends,
- UData.File_Names (Unit_Kind).Project,
- In_Tree)
+ (Project.Extends, UData.File_Names (Unit_Kind).Project)
then
if UData.File_Names (Unit_Kind).Path.Name = Slash then
Remove_Forbidden_File_Name
elsif UData.File_Names (Unit_Kind).Project = Project
and then
- (Data.Known_Order_Of_Source_Dirs
+ (Project.Known_Order_Of_Source_Dirs
or else
UData.File_Names (Unit_Kind).Path.Name = Canonical_Path)
then
else
if The_Location = No_Location then
- The_Location := In_Tree.Projects.Table (Project).Location;
+ The_Location := Project.Location;
end if;
Err_Vars.Error_Msg_Name_1 := Unit_Name;
(Project, In_Tree, "duplicate unit %%", The_Location);
Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table
- (UData.File_Names (Unit_Kind).Project).Name;
+ UData.File_Names (Unit_Kind).Project.Name;
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (UData.File_Names (Unit_Kind).Path.Name);
Error_Msg
(Project, In_Tree,
"\ project file %%, {", The_Location);
- Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Project).Name;
+ Err_Vars.Error_Msg_Name_1 := Project.Name;
Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path);
Error_Msg
(Project, In_Tree, "\ project file %%, {", The_Location);
and then Unit_Prj /= No_Project
then
Error_Msg_File_1 := File_Name;
- Error_Msg_Name_1 := In_Tree.Projects.Table (Unit_Prj).Name;
+ Error_Msg_Name_1 := Unit_Prj.Name;
Error_Msg
(Project, In_Tree,
"{ is already a source of project %%",
Get_Unit
(In_Tree => In_Tree,
Canonical_File_Name => Canonical_File,
- Naming => Data.Naming,
+ Naming => Project.Naming,
Exception_Id => Exception_Id,
Unit_Name => Unit_Name,
Unit_Kind => Unit_Kind);
----------------------
procedure Show_Source_Dirs
- (Data : Project_Data;
+ (Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
Current : String_List_Id;
begin
Write_Line ("Source_Dirs:");
- Current := Data.Source_Dirs;
+ Current := Project.Source_Dirs;
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Write_Str (" ");
if Specs then
if not Check_Project
(The_Unit_Data.File_Names (Specification).Project,
- Project, In_Tree, Extending)
+ Project, Extending)
then
Error_Msg
(Project, In_Tree,
else
if not Check_Project
(The_Unit_Data.File_Names (Body_Part).Project,
- Project, In_Tree, Extending)
+ Project, Extending)
then
Error_Msg
(Project, In_Tree,
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Backward_Compatibility : Boolean;
- Id : Prj.Project_Id := Prj.No_Project;
- Id_Tree : Prj.Project_Tree_Ref := null)
+ Id : Prj.Project_Id := Prj.No_Project)
is
procedure Print (Node : Project_Node_Id; Indent : Natural);
-- A recursive procedure that traverses a project file tree and outputs
Write_String ("project ");
if Id /= Prj.No_Project then
- Output_Name (Id_Tree.Projects.Table (Id).Display_Name);
+ Output_Name (Id.Display_Name);
else
Output_Name (Name_Of (Node, In_Tree));
end if;
Write_String ("end ");
if Id /= Prj.No_Project then
- Output_Name (Id_Tree.Projects.Table (Id).Display_Name);
+ Output_Name (Id.Display_Name);
else
Output_Name (Name_Of (Node, In_Tree));
end if;
W_Eol : Write_Eol_Ap := null;
W_Str : Write_Str_Ap := null;
Backward_Compatibility : Boolean;
- Id : Prj.Project_Id := Prj.No_Project;
- Id_Tree : Prj.Project_Tree_Ref := null);
+ Id : Prj.Project_Id := Prj.No_Project);
-- Output a project file, using either the default output routines, or the
-- ones specified by W_Char, W_Eol and W_Str.
--
function Imported_Or_Extended_Project_From
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
With_Name : Name_Id) return Project_Id;
-- Find an imported or extended project of Project whose name is With_Name
Data.When_No_Sources := When_No_Sources;
Initialize (Data.Proc_Data);
- Check_All_Projects (Project, In_Tree, Data, Imported_First => True);
+ Check_All_Projects (Project, Data, Imported_First => True);
-- Set the Other_Part field for the units
Name_Of (Term_Project, From_Project_Node_Tree);
The_Project := Imported_Or_Extended_Project_From
(Project => Project,
- In_Tree => In_Tree,
With_Name => The_Name);
end if;
The_Name :=
Name_Of (Term_Package, From_Project_Node_Tree);
- The_Package := In_Tree.Projects.Table
- (The_Project).Decl.Packages;
+ The_Package := The_Project.Decl.Packages;
while The_Package /= No_Package
and then In_Tree.Packages.Table
if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
N_Variable_Reference
then
- The_Variable_Id :=
- In_Tree.Projects.Table
- (The_Project).Decl.Variables;
+ The_Variable_Id := The_Project.Decl.Variables;
else
- The_Variable_Id :=
- In_Tree.Projects.Table
- (The_Project).Decl.Attributes;
+ The_Variable_Id := The_Project.Decl.Attributes;
end if;
while The_Variable_Id /= No_Variable
In_Tree.Packages.Table
(The_Package).Decl.Arrays;
else
- The_Array :=
- In_Tree.Projects.Table
- (The_Project).Decl.Arrays;
+ The_Array := The_Project.Decl.Arrays;
end if;
while The_Array /= No_Array
function Imported_Or_Extended_Project_From
(Project : Project_Id;
- In_Tree : Project_Tree_Ref;
With_Name : Name_Id) return Project_Id
is
- Data : constant Project_Data := In_Tree.Projects.Table (Project);
List : Project_List;
Result : Project_Id;
Temp_Result : Project_Id;
begin
-- First check if it is the name of an extended project
- Result := Data.Extends;
+ Result := Project.Extends;
while Result /= No_Project loop
- if In_Tree.Projects.Table (Result).Name = With_Name then
+ if Result.Name = With_Name then
return Result;
else
- Result := In_Tree.Projects.Table (Result).Extends;
+ Result := Result.Extends;
end if;
end loop;
-- Then check the name of each imported project
Temp_Result := No_Project;
- List := Data.Imported_Projects;
+ List := Project.Imported_Projects;
while List /= null loop
Result := List.Project;
-- If the project is directly imported, then returns its ID
- if In_Tree.Projects.Table (Result).Name = With_Name then
+ if Result.Name = With_Name then
return Result;
end if;
-- if the project is not imported directly.
declare
- Proj : Project_Id := In_Tree.Projects.Table (Result).Extends;
+ Proj : Project_Id := Result.Extends;
begin
while Proj /= No_Project loop
- if In_Tree.Projects.Table (Proj).Name = With_Name then
+ if Proj.Name = With_Name then
Temp_Result := Result;
exit;
end if;
- Proj := In_Tree.Projects.Table (Proj).Extends;
+ Proj := Proj.Extends;
end loop;
end;
In_Tree : Project_Tree_Ref;
With_Name : Name_Id) return Package_Id
is
- Data : constant Project_Data :=
- In_Tree.Projects.Table (Project);
- Result : Package_Id := Data.Decl.Packages;
+ Result : Package_Id := Project.Decl.Packages;
begin
-- Check the name of each existing package of Project
New_Pkg;
else
- The_New_Package.Next :=
- In_Tree.Projects.Table (Project).Decl.Packages;
- In_Tree.Projects.Table (Project).Decl.Packages :=
- New_Pkg;
+ The_New_Package.Next := Project.Decl.Packages;
+ Project.Decl.Packages := New_Pkg;
end if;
In_Tree.Packages.Table (New_Pkg) :=
Renamed_Project :
constant Project_Id :=
Imported_Or_Extended_Project_From
- (Project, In_Tree, Project_Name);
+ (Project, Project_Name);
Renamed_Package : constant Package_Id :=
Package_From
Add_Attributes
(Project,
- In_Tree.Projects.Table (Project).Name,
- Name_Id
- (In_Tree.Projects.Table (Project).Directory.Name),
+ Project.Name,
+ Name_Id (Project.Directory.Name),
In_Tree,
In_Tree.Packages.Table (New_Pkg).Decl,
First_Attribute_Of
-- associative array attribute may already have been
-- declared, and the array elements declared are reused.
+ Prj : Project_List;
+
begin
-- First find if the associative array attribute already
-- has elements declared.
(Pkg).Decl.Arrays;
else
- New_Array := In_Tree.Projects.Table
- (Project).Decl.Arrays;
+ New_Array := Project.Decl.Arrays;
end if;
while New_Array /= No_Array
(Name => Current_Item_Name,
Location => Current_Location,
Value => No_Array_Element,
- Next => In_Tree.Projects.Table
- (Project).Decl.Arrays);
+ Next => Project.Decl.Arrays);
- In_Tree.Projects.Table (Project).Decl.Arrays :=
- New_Array;
+ Project.Decl.Arrays := New_Array;
end if;
end if;
(Current_Item, From_Project_Node_Tree),
From_Project_Node_Tree);
- for Index in Project_Table.First ..
- Project_Table.Last
- (In_Tree.Projects)
- loop
- if In_Tree.Projects.Table (Index).Name =
- Orig_Project_Name
- then
- Orig_Project := Index;
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ if Prj.Project.Name = Orig_Project_Name then
+ Orig_Project := Prj.Project;
exit;
end if;
+ Prj := Prj.Next;
end loop;
pragma Assert (Orig_Project /= No_Project,
if No (Associative_Package_Of
(Current_Item, From_Project_Node_Tree))
then
- Orig_Array :=
- In_Tree.Projects.Table
- (Orig_Project).Decl.Arrays;
+ Orig_Array := Orig_Project.Decl.Arrays;
else
-- If in a package, find the package where the value
(Current_Item, From_Project_Node_Tree),
From_Project_Node_Tree);
- Orig_Package :=
- In_Tree.Projects.Table
- (Orig_Project).Decl.Packages;
+ Orig_Package := Orig_Project.Decl.Packages;
pragma Assert (Orig_Package /= No_Package,
"original package not found");
In_Tree.Packages.Table
(Pkg).Decl.Attributes;
else
- The_Variable :=
- In_Tree.Projects.Table
- (Project).Decl.Attributes;
+ The_Variable := Project.Decl.Attributes;
end if;
else
In_Tree.Packages.Table
(Pkg).Decl.Variables;
else
- The_Variable :=
- In_Tree.Projects.Table
- (Project).Decl.Variables;
+ The_Variable := Project.Decl.Variables;
end if;
end if;
else
In_Tree.Variable_Elements.Table (The_Variable) :=
- (Next =>
- In_Tree.Projects.Table
- (Project).Decl.Variables,
+ (Next => Project.Decl.Variables,
Name => Current_Item_Name,
Value => New_Value);
- In_Tree.Projects.Table
- (Project).Decl.Variables :=
- The_Variable;
+ Project.Decl.Variables := The_Variable;
end if;
-- If the variable/attribute has already been
In_Tree.Packages.Table (Pkg).Decl.Arrays;
else
- The_Array :=
- In_Tree.Projects.Table (Project).Decl.Arrays;
+ The_Array := Project.Decl.Arrays;
end if;
while
(Name => Current_Item_Name,
Location => Current_Location,
Value => No_Array_Element,
- Next => In_Tree.Projects.Table
- (Project).Decl.Arrays);
+ Next => Project.Decl.Arrays);
- In_Tree.Projects.Table
- (Project).Decl.Arrays := The_Array;
+ Project.Decl.Arrays := The_Array;
end if;
-- Otherwise initialize The_Array_Element as the
(Variable_Node, From_Project_Node_Tree),
From_Project_Node_Tree);
The_Project :=
- Imported_Or_Extended_Project_From
- (Project, In_Tree, Name);
+ Imported_Or_Extended_Project_From (Project, Name);
end if;
-- If a package were specified for the case variable,
No (Package_Node_Of
(Variable_Node, From_Project_Node_Tree))
then
- Var_Id := In_Tree.Projects.Table
- (The_Project).Decl.Variables;
+ Var_Id := The_Project.Decl.Variables;
while Var_Id /= No_Variable
and then
In_Tree.Variable_Elements.Table
-- Make sure there are no projects in the data structure
- Project_Table.Set_Last (In_Tree.Projects, No_Project);
+ Free_List (In_Tree.Projects, Free_Project => True);
end if;
Processed_Projects.Reset;
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
Extending2 : Project_Id;
+ Prj : Project_List;
-- Start of processing for Process_Project_Tree_Phase_2
then
declare
Object_Dir : constant Path_Name_Type :=
- In_Tree.Projects.Table
- (Project).Object_Directory.Name;
+ Project.Object_Directory.Name;
begin
- for Index in
- Project_Table.First .. Project_Table.Last (In_Tree.Projects)
- loop
- if In_Tree.Projects.Table (Index).Virtual then
- In_Tree.Projects.Table (Index).Object_Directory.Name :=
- Object_Dir;
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ if Prj.Project.Virtual then
+ Prj.Project.Object_Directory.Name := Object_Dir;
end if;
+ Prj := Prj.Next;
end loop;
end;
end if;
-- the project(s) it extends.
if Project /= No_Project then
- for Proj in
- Project_Table.First .. Project_Table.Last (In_Tree.Projects)
- loop
- Extending := In_Tree.Projects.Table (Proj).Extended_By;
+ Prj := In_Tree.Projects;
+ while Prj /= null loop
+ Extending := Prj.Project.Extended_By;
if Extending /= No_Project then
- Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory.Name;
+ Obj_Dir := Prj.Project.Object_Directory.Name;
-- Check that a project being extended does not share its
-- object directory with any project that extends it, directly
Extending2 := Extending;
while Extending2 /= No_Project loop
- if Has_Ada_Sources (In_Tree.Projects.Table (Extending2))
- and then
- In_Tree.Projects.Table
- (Extending2).Object_Directory.Name = Obj_Dir
+ if Has_Ada_Sources (Extending2)
+ and then Extending2.Object_Directory.Name = Obj_Dir
then
- if In_Tree.Projects.Table (Extending2).Virtual then
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Proj).Display_Name;
+ if Extending2.Virtual then
+ Error_Msg_Name_1 := Prj.Project.Display_Name;
if Error_Report = null then
Error_Msg
("project %% cannot be extended by a virtual" &
" project with the same object directory",
- In_Tree.Projects.Table (Proj).Location);
+ Prj.Project.Location);
else
Error_Report
("project """ &
end if;
else
- Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Extending2).Display_Name;
- Error_Msg_Name_2 :=
- In_Tree.Projects.Table (Proj).Display_Name;
+ Error_Msg_Name_1 := Extending2.Display_Name;
+ Error_Msg_Name_2 := Prj.Project.Display_Name;
if Error_Report = null then
Error_Msg
("project %% cannot extend project %%",
- In_Tree.Projects.Table (Extending2).Location);
+ Extending2.Location);
Error_Msg
("\they share the same object directory",
- In_Tree.Projects.Table (Extending2).Location);
+ Extending2.Location);
else
Error_Report
-- Continue with the next extending project, if any
- Extending2 :=
- In_Tree.Projects.Table (Extending2).Extended_By;
+ Extending2 := Extending2.Extended_By;
end loop;
end if;
+
+ Prj := Prj.Next;
end loop;
end if;
begin
if Verbose_Mode then
Write_Str ("Checking project file """);
- Write_Str
- (Get_Name_String (Data.In_Tree.Projects.Table (Project).Name));
+ Write_Str (Get_Name_String (Project.Name));
Write_Line ("""");
end if;
-- it is nil, then this imported project is our first.
if Imported = null then
- In_Tree.Projects.Table (Project).Imported_Projects :=
+ Project.Imported_Projects :=
new Project_List_Element'
(Project => New_Project,
Next => null);
- Imported :=
- In_Tree.Projects.Table (Project).Imported_Projects;
+ Imported := Project.Imported_Projects;
else
Imported.Next := new Project_List_Element'
(Project => New_Project,
else
declare
- Processed_Data : Project_Data := Empty_Project (In_Tree);
Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Tref : Source_Buffer_Ptr;
-- This is for virtually extended projects.
if Extended_By /= No_Project then
- In_Tree.Projects.Table (Project).Extended_By := Extended_By;
+ Project.Extended_By := Extended_By;
end if;
return;
end if;
- Project_Table.Increment_Last (In_Tree.Projects);
- Project := Project_Table.Last (In_Tree.Projects);
+ Project := new Project_Data'(Empty_Project (In_Tree));
+ In_Tree.Projects := new Project_List_Element'
+ (Project => Project,
+ Next => In_Tree.Projects);
+
Processed_Projects.Set (Name, Project);
- Processed_Data.Name := Name;
- Processed_Data.Qualifier :=
+ Project.Name := Name;
+ Project.Qualifier :=
Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
- In_Tree.Projects.Table (Project).Name := Name;
- In_Tree.Projects.Table (Project).Qualifier :=
- Processed_Data.Qualifier;
Get_Name_String (Name);
and then Name_Buffer (1 .. Virtual_Prefix'Length) =
Virtual_Prefix
then
- Processed_Data.Virtual := True;
- Processed_Data.Display_Name := Name;
+ Project.Virtual := True;
+ Project.Display_Name := Name;
-- If there is no file, for example when the project node tree is
-- built in memory by GPS, the Display_Name cannot be found in
-- the source, so its value is the same as Name.
elsif Location = No_Location then
- Processed_Data.Display_Name := Name;
+ Project.Display_Name := Name;
-- Get the spelling of the project name from the project file
Location := Location + 1;
end loop;
- Processed_Data.Display_Name := Name_Find;
+ Project.Display_Name := Name_Find;
end if;
- Processed_Data.Path.Display_Name :=
+ Project.Path.Display_Name :=
Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
- Get_Name_String (Processed_Data.Path.Display_Name);
+ Get_Name_String (Project.Path.Display_Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Processed_Data.Path.Name := Name_Find;
+ Project.Path.Name := Name_Find;
- Processed_Data.Location :=
+ Project.Location :=
Location_Of (From_Project_Node, From_Project_Node_Tree);
- Processed_Data.Directory.Display_Name :=
+ Project.Directory.Display_Name :=
Directory_Of (From_Project_Node, From_Project_Node_Tree);
- Get_Name_String (Processed_Data.Directory.Display_Name);
+ Get_Name_String (Project.Directory.Display_Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Processed_Data.Directory.Name := Name_Find;
+ Project.Directory.Name := Name_Find;
- Processed_Data.Extended_By := Extended_By;
+ Project.Extended_By := Extended_By;
Add_Attributes
(Project,
Name,
- Name_Id (Processed_Data.Directory.Name),
+ Name_Id (Project.Directory.Name),
In_Tree,
- Processed_Data.Decl,
+ Project.Decl,
Prj.Attr.Attribute_First,
Project_Level => True);
- In_Tree.Projects.Table (Project) := Processed_Data;
-
Process_Imported_Projects (Imported, Limited_With => False);
Declaration_Node :=
Recursive_Process
(In_Tree => In_Tree,
- Project => In_Tree.Projects.Table (Project).Extends,
+ Project => Project.Extends,
From_Project_Node => Extended_Project_Of
(Declaration_Node,
From_Project_Node_Tree),
-- or renamed. Also inherit the languages, if attribute Languages
-- is not explicitly defined.
- Processed_Data := In_Tree.Projects.Table (Project);
-
- if Processed_Data.Extends /= No_Project then
+ if Project.Extends /= No_Project then
declare
Extended_Pkg : Package_Id;
Current_Pkg : Package_Id;
Element : Package_Element;
First : constant Package_Id :=
- Processed_Data.Decl.Packages;
+ Project.Decl.Packages;
Attribute1 : Variable_Id;
Attribute2 : Variable_Id;
Attr_Value1 : Variable;
Attr_Value2 : Variable;
begin
- Extended_Pkg :=
- In_Tree.Projects.Table
- (Processed_Data.Extends).Decl.Packages;
+ Extended_Pkg := Project.Extends.Decl.Packages;
while Extended_Pkg /= No_Package loop
- Element :=
- In_Tree.Packages.Table (Extended_Pkg);
+ Element := In_Tree.Packages.Table (Extended_Pkg);
Current_Pkg := First;
while Current_Pkg /= No_Package
(Name => Element.Name,
Decl => No_Declarations,
Parent => No_Package,
- Next => Processed_Data.Decl.Packages);
- Processed_Data.Decl.Packages := Current_Pkg;
+ Next => Project.Decl.Packages);
+ Project.Decl.Packages := Current_Pkg;
Copy_Package_Declarations
(From => Element.Decl,
To =>
-- Check if attribute Languages is declared in the
-- extending project.
- Attribute1 := Processed_Data.Decl.Attributes;
+ Attribute1 := Project.Decl.Attributes;
while Attribute1 /= No_Variable loop
Attr_Value1 := In_Tree.Variable_Elements.
Table (Attribute1);
-- project. Check if it is declared in the project being
-- extended.
- Attribute2 :=
- In_Tree.Projects.Table
- (Processed_Data.Extends).Decl.Attributes;
+ Attribute2 := Project.Extends.Decl.Attributes;
while Attribute2 /= No_Variable loop
Attr_Value2 := In_Tree.Variable_Elements.
Table (Attribute2);
(In_Tree.Variable_Elements);
Attribute1 := Variable_Element_Table.Last
(In_Tree.Variable_Elements);
- Attr_Value1.Next := Processed_Data.Decl.Attributes;
- Processed_Data.Decl.Attributes := Attribute1;
+ Attr_Value1.Next := Project.Decl.Attributes;
+ Project.Decl.Attributes := Attribute1;
end if;
Attr_Value1.Name := Snames.Name_Languages;
end if;
end if;
end;
-
- In_Tree.Projects.Table (Project) := Processed_Data;
end if;
Process_Imported_Projects (Imported, Limited_With => True);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
is
pragma Assert (Project /= No_Project);
- The_Packages : constant Package_Id :=
- In_Tree.Projects.Table (Project).Decl.Packages;
+ The_Packages : constant Package_Id := Project.Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
Executable_Suffix_Name : Name_Id := No_Name;
- Naming : constant Naming_Data := In_Tree.Projects.Table (Project).Naming;
+ Naming : constant Naming_Data := Project.Naming;
Spec_Suffix : Name_Id := No_Name;
Body_Suffix : Name_Id := No_Name;
if Builder_Package /= No_Package then
if Get_Mode = Multi_Language then
- Executable_Suffix_Name :=
- In_Tree.Projects.Table (Project).Config.Executable_Suffix;
+ Executable_Suffix_Name := Project.Config.Executable_Suffix;
else
Executable_Suffix := Prj.Util.Value_Of
Result : File_Name_Type;
begin
- if In_Tree.Projects.Table (Project).Config.Executable_Suffix /=
- No_Name
- then
+ if Project.Config.Executable_Suffix /= No_Name then
Executable_Extension_On_Target :=
- In_Tree.Projects.Table (Project).Config.Executable_Suffix;
+ Project.Config.Executable_Suffix;
end if;
Result := Executable_Name (Name_Find);
-- Table to store the path name of all the created temporary files, so that
-- they can be deleted at the end, or when the program is interrupted.
- procedure Free (Project : in out Project_Data; Reset_Only : Boolean);
+ procedure Free (Project : in out Project_Id; Reset_Only : Boolean);
-- Free memory allocated for Project
procedure Free_List (Languages : in out Language_Ptr);
procedure Free_List (Source : in out Source_Id);
- procedure Free_List (List : in out Project_List);
procedure Free_List (Languages : in out Language_List);
-- Free memory allocated for the list of languages or sources
procedure Project_Changed (Iter : in out Source_Iterator) is
begin
- Iter.Language := Iter.In_Tree.Projects.Table (Iter.Project).Languages;
+ Iter.Language := Iter.Project.Project.Languages;
Language_Changed (Iter);
end Project_Changed;
if Iter.Language = No_Language_Index then
if Iter.All_Projects then
- Iter.Project := Iter.Project + 1;
+ Iter.Project := Iter.Project.Next;
- if Iter.Project > Project_Table.Last (Iter.In_Tree.Projects) then
- Iter.Project := No_Project;
- else
+ if Iter.Project /= null then
Project_Changed (Iter);
end if;
else
- Iter.Project := No_Project;
+ Iter.Project := null;
end if;
else
begin
Iter := Source_Iterator'
(In_Tree => In_Tree,
- Project => Project,
+ Project => In_Tree.Projects,
All_Projects => Project = No_Project,
Language_Name => Language,
Language => No_Language_Index,
Current => No_Source);
- if Iter.Project = No_Project then
- Iter.Project := Project_Table.First;
+ if Project /= null then
+ while Iter.Project /= null
+ and then Iter.Project.Project /= Project
+ loop
+ Iter.Project := Iter.Project.Next;
+ end loop;
end if;
Project_Changed (Iter);
procedure For_Every_Project_Imported
(By : Project_Id;
- In_Tree : Project_Tree_Ref;
With_State : in out State;
Imported_First : Boolean := False)
is
---------------------
procedure Recursive_Check (Project : Project_Id) is
- Data : Project_Data renames In_Tree.Projects.Table (Project);
List : Project_List;
begin
-- Visited all extended projects
- if Data.Extends /= No_Project then
- Recursive_Check (Data.Extends);
+ if Project.Extends /= No_Project then
+ Recursive_Check (Project.Extends);
end if;
-- Visited all imported projects
- List := Data.Imported_Projects;
+ List := Project.Imported_Projects;
while List /= null loop
Recursive_Check (List.Project);
List := List.Next;
function Hash (Project : Project_Id) return Header_Num is
begin
- return Header_Num (Project mod Max_Header_Num);
+ if Project = No_Project then
+ return Header_Num'First;
+ else
+ return Hash (Get_Name_String (Project.Name));
+ end if;
end Hash;
-----------
-------------------
function Is_A_Language
- (Data : Project_Data;
+ (Project : Project_Id;
Language_Name : Name_Id) return Boolean
is
Lang_Ind : Language_Ptr;
begin
- Lang_Ind := Data.Languages;
+ Lang_Ind := Project.Languages;
while Lang_Ind /= No_Language_Index loop
if Lang_Ind.Name = Language_Name then
return True;
function Is_Extending
(Extending : Project_Id;
- Extended : Project_Id;
- In_Tree : Project_Tree_Ref) return Boolean
+ Extended : Project_Id) return Boolean
is
Proj : Project_Id;
return True;
end if;
- Proj := In_Tree.Projects.Table (Proj).Extends;
+ Proj := Proj.Extends;
end loop;
return False;
-- Free --
----------
- procedure Free (Project : in out Project_Data; Reset_Only : Boolean) is
+ procedure Free (Project : in out Project_Id; Reset_Only : Boolean) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Project_Data, Project_Id);
begin
- Free (Project.Include_Path);
- Free (Project.Ada_Include_Path);
- Free (Project.Objects_Path);
- Free (Project.Ada_Objects_Path);
+ if Project /= null then
+ Free (Project.Include_Path);
+ Free (Project.Ada_Include_Path);
+ Free (Project.Objects_Path);
+ Free (Project.Ada_Objects_Path);
- Free_List (Project.Imported_Projects);
- Free_List (Project.All_Imported_Projects);
+ Free_List (Project.Imported_Projects, Free_Project => False);
+ Free_List (Project.All_Imported_Projects, Free_Project => False);
- if not Reset_Only then
- Free_List (Project.Languages);
+ if not Reset_Only then
+ Free_List (Project.Languages);
+ end if;
+
+ Unchecked_Free (Project);
end if;
end Free;
-- Free_List --
---------------
- procedure Free_List (List : in out Project_List) is
+ procedure Free_List
+ (List : in out Project_List;
+ Free_Project : Boolean;
+ Reset_Only : Boolean := True)
+ is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_List_Element, Project_List);
Tmp : Project_List;
begin
while List /= null loop
Tmp := List.Next;
+ if Free_Project then
+ Free (List.Project, Reset_Only => Reset_Only);
+ end if;
+
Unchecked_Free (List);
List := Tmp;
end loop;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
- for P in Project_Table.First ..
- Project_Table.Last (Tree.Projects)
- loop
- Free (Tree.Projects.Table (P), Reset_Only => False);
- end loop;
-
- Project_Table.Free (Tree.Projects);
+ Free_List (Tree.Projects, Free_Project => True, Reset_Only => False);
-- Private part
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
- if not Project_Table."=" (Tree.Projects.Table, null) then
- for P in Project_Table.First ..
- Project_Table.Last (Tree.Projects)
- loop
- Free (Tree.Projects.Table (P), Reset_Only => True);
- end loop;
- end if;
-
- Project_Table.Init (Tree.Projects);
+ Free_List (Tree.Projects, Free_Project => True, Reset_Only => True);
-- Private part table
-- Has_Ada_Sources --
---------------------
- function Has_Ada_Sources (Data : Project_Data) return Boolean is
+ function Has_Ada_Sources (Data : Project_Id) return Boolean is
Lang : Language_Ptr;
begin
-- Has_Foreign_Sources --
-------------------------
- function Has_Foreign_Sources (Data : Project_Data) return Boolean is
+ function Has_Foreign_Sources (Data : Project_Id) return Boolean is
Lang : Language_Ptr;
begin
--------------------------
function Get_Object_Directory
- (In_Tree : Project_Tree_Ref;
- Project : Project_Id;
+ (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)
+ if (Project.Library and Including_Libraries)
or else
- (Data.Object_Directory /= No_Path_Information
- and then (not Including_Libraries or else not Data.Library))
+ (Project.Object_Directory /= No_Path_Information
+ and then (not Including_Libraries or else not Project.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)
+ if Project.Library then
+ if Project.Object_Directory = No_Path_Information
+ or else Contains_ALI_Files (Project.Library_ALI_Dir.Name)
then
- return Data.Library_ALI_Dir.Name;
+ return Project.Library_ALI_Dir.Name;
else
- return Data.Object_Directory.Name;
+ return Project.Object_Directory.Name;
end if;
-- For a non-library project, add object directory if it is not a
-- adding the object directory could disrupt the order of the
-- object dirs in the path.
- elsif not Data.Virtual then
+ elsif not Project.Virtual then
declare
Add_Object_Dir : Boolean;
Prj : Project_Id;
Add_Object_Dir := not Only_If_Ada;
Prj := Project;
while not Add_Object_Dir and then Prj /= No_Project loop
- if Has_Ada_Sources (In_Tree.Projects.Table (Prj)) then
+ if Has_Ada_Sources (Prj) then
Add_Object_Dir := True;
else
- Prj := In_Tree.Projects.Table (Prj).Extends;
+ Prj := Prj.Extends;
end if;
end loop;
if Add_Object_Dir then
- return Data.Object_Directory.Name;
+ return Project.Object_Directory.Name;
end if;
end;
end if;
-----------------------------------
function Ultimate_Extending_Project_Of
- (Proj : Project_Id;
- In_Tree : Project_Tree_Ref) return Project_Id
+ (Proj : Project_Id) return Project_Id
is
Prj : Project_Id;
begin
Prj := Proj;
- while In_Tree.Projects.Table (Prj).Extended_By /= No_Project loop
- Prj := In_Tree.Projects.Table (Prj).Extended_By;
+ while Prj.Extended_By /= No_Project loop
+ Prj := Prj.Extended_By;
end loop;
return Prj;
-- Compute_All_Imported_Projects --
-----------------------------------
- procedure Compute_All_Imported_Projects
- (Project : Project_Id; In_Tree : Project_Tree_Ref)
- is
- Data : Project_Data renames In_Tree.Projects.Table (Project);
-
+ procedure Compute_All_Imported_Projects (Project : Project_Id) is
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
-- A project is not importing itself
if Project /= Prj then
- Prj2 := Ultimate_Extending_Project_Of (Prj, In_Tree);
+ Prj2 := Ultimate_Extending_Project_Of (Prj);
-- 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 := Data.All_Imported_Projects;
+ List := Project.All_Imported_Projects;
while List /= null loop
if List.Project = Prj2 then
return;
-- Add it to the list
- Data.All_Imported_Projects :=
+ Project.All_Imported_Projects :=
new Project_List_Element'
(Project => Prj2,
- Next => Data.All_Imported_Projects);
+ Next => Project.All_Imported_Projects);
end if;
end Recursive_Add;
Dummy : Boolean := False;
begin
- Free_List (Data.All_Imported_Projects);
- For_All_Projects (Project, In_Tree, Dummy);
+ Free_List (Project.All_Imported_Projects, Free_Project => False);
+ For_All_Projects (Project, Dummy);
end Compute_All_Imported_Projects;
begin
No_Path_Information : constant Path_Information := (No_Path, No_Path);
- type Project_Id is new Nat;
- No_Project : constant Project_Id := 0;
+ type Project_Data;
+ type Project_Id is access Project_Data;
+ No_Project : constant Project_Id := null;
-- Id of a Project File
type String_List_Id is new Nat;
function Hash (Name : Name_Id) return Header_Num;
function Hash (Name : File_Name_Type) return Header_Num;
function Hash (Name : Path_Name_Type) return Header_Num;
- -- Used for computing hash values for names put into above hash table
-
function Hash (Project : Project_Id) return Header_Num;
- -- Used for hash tables where Project_Id is the Key
+ -- Used for computing hash values for names put into above hash table
type Language_Kind is (File_Based, Unit_Based);
-- Type for the kind of language. All languages are file based, except Ada
Suffix : File_Name_Type);
function Get_Object_Directory
- (In_Tree : Project_Tree_Ref;
- Project : Project_Id;
+ (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
-- 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);
+ procedure Compute_All_Imported_Projects (Project : Project_Id);
-- 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;
+ (Proj : Project_Id) return Project_Id;
-- Returns the ultimate extending project of project Proj. If project Proj
-- is not extended, returns Proj.
end record;
-- A list of projects
+ procedure Free_List
+ (List : in out Project_List;
+ Free_Project : Boolean;
+ Reset_Only : Boolean := True);
+ -- Free the list of projects. If Free_Project, each project is also freed.
+ -- When Free_Project is True, Reset_Only indicates whether the specific
+ -- languages should also be freed.
+
type Response_File_Format is
(None,
GNU,
function Is_Extending
(Extending : Project_Id;
- Extended : Project_Id;
- In_Tree : Project_Tree_Ref) return Boolean;
- -- ??? needs comment
+ Extended : Project_Id) return Boolean;
+ -- Return True if Extending is extending the Extended project.
function Is_A_Language
- (Data : Project_Data;
+ (Project : Project_Id;
Language_Name : Name_Id) return Boolean;
-- Return True when Language_Name (which must be lower case) is one of the
-- languages used for the project.
- function Has_Ada_Sources (Data : Project_Data) return Boolean;
+ function Has_Ada_Sources (Data : Project_Id) return Boolean;
-- Return True if the project has Ada sources
- function Has_Foreign_Sources (Data : Project_Data) return Boolean;
+ function Has_Foreign_Sources (Data : Project_Id) return Boolean;
-- Return True if the project has foreign sources
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
- package Project_Table is new GNAT.Dynamic_Tables (
- Table_Component_Type => Project_Data,
- Table_Index_Type => Project_Id,
- Table_Low_Bound => 1,
- Table_Initial => 100,
- Table_Increment => 100);
- -- The set of all project files
-
type Spec_Or_Body is (Specification, Body_Part);
type File_Name_Data is record
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
- Projects : Project_Table.Instance;
+ Projects : Project_List;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
- In_Tree : Project_Tree_Ref;
With_State : in out State;
Imported_First : Boolean := False);
-- Call Action for each project imported directly or indirectly by project
type Source_Iterator is record
In_Tree : Project_Tree_Ref;
- Project : Project_Id;
+ Project : Project_List;
All_Projects : Boolean;
-- Current project and whether we should move on to the next
begin
-- Nothing to do if name is not an identifier or a selected component
- -- whose selector_name is not an identifier.
+ -- whose selector_name is an identifier.
if Nkind (Nam) = N_Identifier then
Chrs := Chars (Nam);
Load_RTU
(To_Load,
Use_Setting => In_Use (Cunit_Entity (U)));
- Set_Is_Visible_Child_Unit
- (RT_Unit_Table (To_Load).Entity);
+ Set_Is_Visible_Child_Unit (RT_Unit_Table (To_Load).Entity);
+
+ -- Prevent creation of an implicit 'with' from (for example)
+ -- Ada.Wide_Text_IO.Integer_IO to Ada.Text_IO.Integer_IO,
+ -- because these could create cycles. First check whether the
+ -- simple names match ("integer_io" = "integer_io"), and then
+ -- check whether the parent is indeed one of the
+ -- [[Wide_]Wide_]Text_IO packages.
+
+ if Chrs = Chars (Cunit_Entity (Current_Sem_Unit)) then
+ declare
+ Parent_Name : constant Unit_Name_Type
+ := Get_Parent_Spec_Name (Unit_Name (Current_Sem_Unit));
+ begin
+ if Parent_Name /= No_Unit_Name then
+ Get_Name_String (Parent_Name);
+
+ declare
+ P : String renames Name_Buffer (1 .. Name_Len);
+ begin
+ if P = "ada.text_io%s"
+ or else P = "ada.wide_text_io%s"
+ or else P = "ada.wide_wide_text_io%s"
+ then
+ goto Continue;
+ end if;
+ end;
+ end if;
+ end;
+ end if;
+
+ -- Add an implicit with clause from the current unit to the
+ -- [[Wide_]Wide_]Text_IO child (if necessary).
+
Maybe_Add_With (RT_Unit_Table (To_Load));
end if;
Write_Unit_Info (Unit_Num, Item, Withs => True);
end if;
- -- Main unit should come last
+ -- Main unit should come last (except in the case where we
+ -- skipped System_Aux_Id, in which case we missed the things it
+ -- depends on).
- pragma Assert (not Done (Main_Unit));
+ pragma Assert
+ (not Done (Main_Unit) or else Present (System_Aux_Id));
-- We shouldn't do the same thing twice
-- loaded. In that case a missing body is acceptable.
procedure Inherit_Context (Gen_Decl : Node_Id; Inst : Node_Id);
- -- Add the context clause of the unit containing a generic unit to an
- -- instantiation that is a compilation unit.
+ -- Add the context clause of the unit containing a generic unit to a
+ -- compilation unit that is, or contains, an instantiation.
function Get_Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed copy
Item := First (Context_Items (Parent (Gen_Decl)));
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
- New_I := New_Copy (Item);
- Set_Implicit_With (New_I, True);
- Append (New_I, Current_Context);
+
+ -- Take care to prevent direct cyclic with's, which can happen
+ -- if the generic body with's the current unit. Such a case
+ -- would result in binder errors (or run-time errors if the
+ -- -gnatE switch is in effect), but we want to prevent it here,
+ -- because Sem.Walk_Library_Items doesn't like cycles. Note
+ -- that we don't bother to detect indirect cycles.
+
+ if Library_Unit (Item) /= Current_Unit then
+ New_I := New_Copy (Item);
+ Set_Implicit_With (New_I, True);
+ Append (New_I, Current_Context);
+ end if;
end if;
Next (Item);
projects / thirdparty / gcc.git / commitdiff
