Skip to content

R
riscv-gcc-1
Commit 66713d62 by Arnaud Charlet
Options

[multiple changes] 

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

From-SVN: r146931
parent 059caa3e
Showing with 982 additions and 1132 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/clean.adb
......@@ -336,8 +336,6 @@ package body Clean is
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
......@@ -346,7 +344,7 @@ package body Clean is
-- 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);
......@@ -356,10 +354,10 @@ package body Clean is
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);
......@@ -540,7 +538,6 @@ package body Clean is
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;
......@@ -551,10 +548,12 @@ package body Clean is
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);
......@@ -634,9 +633,8 @@ package body Clean is
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 :=
......@@ -652,22 +650,22 @@ package body Clean is
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);
......@@ -686,6 +684,7 @@ package body Clean is
declare
Filename : constant String := Name (1 .. Last);
begin
if Is_Regular_File (Filename)
or else Is_Symbolic_Link (Filename)
......@@ -693,15 +692,18 @@ package body Clean is
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);
......@@ -747,7 +749,7 @@ package body Clean is
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
......@@ -817,8 +819,6 @@ package body Clean is
-- 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;
......@@ -834,7 +834,7 @@ package body Clean is
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");
......@@ -842,17 +842,17 @@ package body Clean is
-- 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;
......@@ -861,11 +861,11 @@ package body Clean is
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);
......@@ -878,8 +878,8 @@ package body Clean is
-- Source_Dirs or Source_Files is specified as an empty list,
-- so always look for Ada units in extending projects.
if 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)
......@@ -1022,19 +1022,23 @@ package body Clean is
-- 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);
......@@ -1050,21 +1054,21 @@ package body Clean is
-- 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;
......@@ -1085,7 +1089,7 @@ package body Clean is
-- 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;
......@@ -1110,8 +1114,8 @@ package body Clean is
-- 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;
......@@ -1122,11 +1126,11 @@ package body Clean is
-- 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);
......@@ -1160,9 +1164,9 @@ package body Clean is
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;
......@@ -1391,7 +1395,7 @@ package body Clean is
-- 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;
......@@ -1402,9 +1406,8 @@ package body Clean is
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);
......@@ -1466,7 +1469,7 @@ package body Clean is
(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
......@@ -1477,24 +1480,22 @@ package body Clean is
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;
......@@ -1910,14 +1911,12 @@ package body Clean is
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;
......
gcc/ada/exp_ch7.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -442,6 +442,37 @@ package body Exp_Ch7 is
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,
......
gcc/ada/gnatcmd.adb
......@@ -327,20 +327,19 @@ procedure GNATCmd is
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
......@@ -349,7 +348,8 @@ procedure GNATCmd is
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
......@@ -367,7 +367,7 @@ procedure GNATCmd is
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
......@@ -375,10 +375,11 @@ procedure GNATCmd is
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
......@@ -388,6 +389,8 @@ procedure GNATCmd is
end if;
end;
end if;
Proj := Proj.Next;
end loop;
end if;
......@@ -516,9 +519,8 @@ procedure GNATCmd is
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
......@@ -546,9 +548,8 @@ procedure GNATCmd is
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
......@@ -646,6 +647,8 @@ procedure GNATCmd is
(Project : Project_Id;
Root_Project : Project_Id) return Boolean
is
Proj : Project_Id;
begin
if Project = No_Project then
return False;
......@@ -654,19 +657,14 @@ procedure GNATCmd is
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;
......@@ -690,8 +688,7 @@ procedure GNATCmd is
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;
......@@ -714,7 +711,7 @@ procedure GNATCmd is
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;
------------------------------
......@@ -723,6 +720,7 @@ procedure GNATCmd is
procedure Delete_Temp_Config_Files is
Success : Boolean;
Proj : Project_List;
pragma Warnings (Off, Success);
begin
......@@ -731,27 +729,22 @@ procedure GNATCmd is
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;
......@@ -946,7 +939,7 @@ procedure GNATCmd is
-- 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
......@@ -1129,9 +1122,7 @@ procedure GNATCmd is
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 &
......@@ -1154,8 +1145,7 @@ procedure GNATCmd is
-- 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;
......@@ -1210,9 +1200,7 @@ procedure GNATCmd is
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) &
......@@ -1240,39 +1228,30 @@ procedure GNATCmd is
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;
......@@ -1915,13 +1894,10 @@ begin
-- 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;
......@@ -2019,10 +1995,7 @@ begin
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
......@@ -2044,13 +2017,10 @@ begin
-- 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;
......@@ -2234,8 +2204,7 @@ begin
(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);
......@@ -2248,8 +2217,6 @@ begin
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;
......@@ -2269,7 +2236,7 @@ begin
-- 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
......@@ -2281,7 +2248,7 @@ begin
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) =
......@@ -2290,7 +2257,7 @@ begin
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");
......@@ -2334,18 +2301,14 @@ begin
-- 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
......
gcc/ada/make.adb
......@@ -64,6 +64,7 @@ with Ada.Exceptions; use Ada.Exceptions;
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;
......@@ -795,32 +796,41 @@ package body Make is
-- 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=
......@@ -830,7 +840,8 @@ package body Make is
-- 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
......@@ -1074,8 +1085,7 @@ package body Make 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;
......@@ -1126,8 +1136,7 @@ package body Make is
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;
......@@ -1265,8 +1274,7 @@ package body Make is
(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);
......@@ -1388,16 +1396,14 @@ package body Make is
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 ("""");
......@@ -1412,11 +1418,9 @@ package body Make is
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;
-----------
......@@ -1982,13 +1986,10 @@ package body Make is
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;
......@@ -2003,9 +2004,7 @@ package body Make is
-- 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;
......@@ -2019,7 +2018,7 @@ package body Make is
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;
......@@ -2034,7 +2033,7 @@ package body Make is
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;
......@@ -2328,7 +2327,6 @@ package body Make is
Get_Name_String (Source_File);
Compiler_Package : Prj.Package_Id;
Switches : Prj.Variable_Value;
Data : Project_Data;
begin
Prj.Env.
......@@ -2345,20 +2343,19 @@ package body Make is
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;
......@@ -2375,7 +2372,7 @@ package body Make is
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
......@@ -2389,7 +2386,7 @@ package body Make is
(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);
......@@ -2418,8 +2415,8 @@ package body Make is
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;
......@@ -2461,7 +2458,7 @@ package body Make is
(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
......@@ -2705,6 +2702,7 @@ package body Make is
is
Pid : Process_Id;
Project : Project_Id;
Data : Project_Compilation_Access;
begin
pragma Assert (Outstanding_Compiles > 0);
......@@ -2740,10 +2738,10 @@ package body Make is
-- 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;
......@@ -2853,33 +2851,23 @@ package body Make is
-- 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,
......@@ -2888,8 +2876,7 @@ package body Make is
-- 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;
......@@ -3130,18 +3117,22 @@ package body Make is
----------------------
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
......@@ -3150,9 +3141,7 @@ package body Make is
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;
-----------------------
......@@ -3355,8 +3344,7 @@ package body Make is
-- 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
......@@ -3748,9 +3736,7 @@ package body Make is
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) =
......@@ -3772,18 +3758,12 @@ package body Make is
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;
......@@ -3791,8 +3771,7 @@ package body Make is
-- 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,
......@@ -3835,8 +3814,7 @@ package body Make is
-- 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,
......@@ -3927,21 +3905,29 @@ package body Make is
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;
------------------------------
......@@ -3950,6 +3936,7 @@ package body Make is
procedure Delete_Temp_Config_Files is
Success : Boolean;
Proj : Project_List;
pragma Warnings (Off, Success);
begin
......@@ -3958,24 +3945,17 @@ package body Make is
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,
......@@ -3983,13 +3963,11 @@ package body Make is
-- 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;
......@@ -4247,8 +4225,6 @@ package body Make is
Proj : Project_Id := No_Project;
-- The project of the current main
Data : Project_Data;
Real_Path : String_Access;
begin
......@@ -4286,25 +4262,23 @@ package body Make is
-- 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
......@@ -4365,9 +4339,7 @@ package body Make is
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;
......@@ -4470,12 +4442,8 @@ package body Make is
-- 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.
......@@ -4483,17 +4451,16 @@ package body Make is
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) /=
......@@ -4623,7 +4590,7 @@ package body Make is
-- 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
......@@ -4664,7 +4631,7 @@ package body Make is
-- 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
......@@ -4691,8 +4658,7 @@ package body Make is
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,
......@@ -4701,8 +4667,7 @@ package body Make is
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.
......@@ -4740,13 +4705,10 @@ package body Make is
-- 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;
......@@ -4832,8 +4794,7 @@ package body Make is
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");
......@@ -4841,11 +4802,10 @@ package body Make is
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;
......@@ -4939,9 +4899,7 @@ package body Make is
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;
......@@ -4967,8 +4925,7 @@ package body Make is
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
......@@ -5316,51 +5273,52 @@ package body Make is
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
......@@ -5374,9 +5332,7 @@ package body Make is
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;
......@@ -5403,9 +5359,7 @@ package body Make is
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
......@@ -5525,29 +5479,40 @@ package body Make is
-- 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);
......@@ -5617,9 +5582,7 @@ package body Make is
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 :=
......@@ -5627,9 +5590,7 @@ package body Make is
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;
......@@ -5721,6 +5682,7 @@ package body Make is
declare
Depth : Natural;
Current : Natural;
Proj1 : Project_List;
procedure Add_To_Library_Projs (Proj : Project_Id);
-- Add project Project to table Library_Projs in
......@@ -5735,7 +5697,7 @@ package body Make is
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.
......@@ -5743,8 +5705,7 @@ package body Make is
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;
......@@ -5759,41 +5720,34 @@ package body Make is
-- 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;
......@@ -5801,24 +5755,17 @@ package body Make is
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;
......@@ -5829,22 +5776,22 @@ package body Make is
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;
......@@ -6051,6 +5998,8 @@ package body Make is
-- 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
......@@ -6060,17 +6009,16 @@ package body Make is
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;
......@@ -6157,6 +6105,7 @@ package body Make is
Current : Natural;
Proj2 : Project_Id;
Depth : Natural;
Proj1 : Project_List;
begin
if not Run_Path_Option then
......@@ -6173,17 +6122,15 @@ package body Make is
-- 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;
......@@ -6192,29 +6139,28 @@ package body Make is
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
......@@ -6225,9 +6171,8 @@ package body Make is
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
......@@ -6235,9 +6180,8 @@ package body Make is
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;
......@@ -6471,8 +6415,7 @@ package body Make is
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
......@@ -6572,8 +6515,7 @@ package body Make is
declare
Dir_Path : constant String :=
Get_Name_String
(Project_Tree.Projects.Table
(Main_Project).Directory.Name);
(Main_Project.Directory.Name);
begin
for
......@@ -6687,6 +6629,7 @@ package body Make is
procedure Init_Mapping_File
(Project : Project_Id;
Data : in out Project_Compilation_Data;
File_Index : in out Natural)
is
FD : File_Descriptor;
......@@ -6696,8 +6639,7 @@ package body Make is
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.
......@@ -6707,24 +6649,22 @@ package body Make is
(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);
......@@ -6736,7 +6676,7 @@ package body Make is
-- 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;
------------
......@@ -6958,18 +6898,22 @@ package body Make is
-- 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
......@@ -7015,9 +6959,7 @@ package body Make is
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
......@@ -7033,17 +6975,16 @@ package body Make is
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;
......@@ -7064,7 +7005,7 @@ package body Make is
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
......@@ -7074,7 +7015,7 @@ package body Make is
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
......@@ -7261,7 +7202,6 @@ package body Make is
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);
......@@ -7284,13 +7224,12 @@ package body Make is
-- 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;
......@@ -7482,10 +7421,7 @@ package body Make is
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
......@@ -7528,13 +7464,12 @@ package body Make is
-------------
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;
......@@ -7545,11 +7480,11 @@ package body Make is
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;
......@@ -7564,11 +7499,12 @@ package body Make is
-- 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);
......
gcc/ada/makeutl.adb
......@@ -373,7 +373,6 @@ package body Makeutl is
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;
......@@ -381,7 +380,7 @@ package body Makeutl is
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages,
In_Packages => Proj.Decl.Packages,
In_Tree => In_Tree);
Options :=
......@@ -412,20 +411,21 @@ package body Makeutl is
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);
......@@ -444,8 +444,7 @@ package body Makeutl is
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;
......
gcc/ada/mlib-prj.adb
......@@ -229,12 +229,6 @@ package body MLib.Prj is
-- 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 --
------------------
......@@ -309,9 +303,9 @@ package body MLib.Prj is
-- 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;
......@@ -323,11 +317,11 @@ package body MLib.Prj is
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;
......@@ -486,15 +480,14 @@ package body MLib.Prj is
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;
......@@ -542,8 +535,7 @@ package body MLib.Prj is
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;
......@@ -619,7 +611,7 @@ package body MLib.Prj is
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 ("""");
......@@ -678,20 +670,19 @@ package body MLib.Prj is
---------------------
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);
......@@ -702,22 +693,22 @@ package body MLib.Prj is
-- 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);
......@@ -755,10 +746,8 @@ package body MLib.Prj is
(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;
......@@ -770,10 +759,9 @@ package body MLib.Prj is
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;
......@@ -795,8 +783,7 @@ package body MLib.Prj is
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));
......@@ -807,11 +794,7 @@ package body MLib.Prj is
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;
......@@ -822,13 +805,13 @@ package body MLib.Prj is
-- 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;
......@@ -888,10 +871,11 @@ package body MLib.Prj is
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;
......@@ -902,7 +886,7 @@ package body MLib.Prj is
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
......@@ -1172,7 +1156,7 @@ package body MLib.Prj is
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;
......@@ -1204,7 +1188,8 @@ package body MLib.Prj is
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
......@@ -1264,7 +1249,7 @@ package body MLib.Prj is
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
......@@ -1280,15 +1265,15 @@ package body MLib.Prj is
-- 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
......@@ -1313,10 +1298,11 @@ package body MLib.Prj is
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;
......@@ -1334,9 +1320,9 @@ package body MLib.Prj is
-- 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
......@@ -1347,14 +1333,16 @@ package body MLib.Prj is
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;
......@@ -1527,15 +1515,15 @@ package body MLib.Prj is
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,
......@@ -1743,10 +1731,10 @@ package body MLib.Prj is
-- 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
......@@ -1761,7 +1749,7 @@ package body MLib.Prj is
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
......@@ -1803,8 +1791,7 @@ package body MLib.Prj is
-- 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
......@@ -1856,9 +1843,9 @@ package body MLib.Prj is
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);
......@@ -1873,9 +1860,9 @@ package body MLib.Prj is
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);
......@@ -1918,10 +1905,10 @@ package body MLib.Prj is
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
......@@ -1944,22 +1931,19 @@ package body MLib.Prj is
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
......@@ -1997,9 +1981,8 @@ package body MLib.Prj is
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) =
......@@ -2009,9 +1992,9 @@ package body MLib.Prj is
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) =
......@@ -2036,8 +2019,7 @@ package body MLib.Prj is
(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;
......@@ -2077,8 +2059,6 @@ package body MLib.Prj is
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;
......@@ -2086,19 +2066,19 @@ package body MLib.Prj is
-- 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;
......@@ -2112,7 +2092,8 @@ package body MLib.Prj is
-- 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
......@@ -2141,8 +2122,7 @@ package body MLib.Prj is
-- 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;
......@@ -2244,7 +2224,7 @@ package body MLib.Prj is
return True;
end if;
Ext := In_Tree.Projects.Table (Ext).Extends;
Ext := Ext.Extends;
end loop;
return False;
......@@ -2255,9 +2235,7 @@ package body MLib.Prj is
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
......@@ -2533,27 +2511,4 @@ package body MLib.Prj is
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;
gcc/ada/mlib-tgt.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2008, AdaCore --
-- Copyright (C) 2001-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -330,8 +330,9 @@ package body MLib.Tgt is
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;
......@@ -339,14 +340,12 @@ package body MLib.Tgt is
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));
......@@ -380,8 +379,9 @@ package body MLib.Tgt is
(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;
......@@ -389,11 +389,10 @@ package body MLib.Tgt is
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;
......
gcc/ada/mlib-tgt.ads
......@@ -238,8 +238,7 @@ private
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;
......
gcc/ada/prj-env.adb
......@@ -65,8 +65,7 @@ package body Prj.Env is
-- 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.
......@@ -88,7 +87,7 @@ package body Prj.Env is
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
......@@ -101,17 +100,17 @@ package body Prj.Env 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;
----------------------
......@@ -128,8 +127,7 @@ package body Prj.Env is
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);
......@@ -156,7 +154,7 @@ package body Prj.Env is
pragma Unreferenced (Dummy);
Path : constant Path_Name_Type :=
Get_Object_Directory
(In_Tree, Project,
(Project,
Including_Libraries => Including_Libraries,
Only_If_Ada => False);
begin
......@@ -175,17 +173,17 @@ package body Prj.Env is
-- 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;
------------------------
......@@ -435,13 +433,10 @@ package body Prj.Env is
-----------
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;
......@@ -469,7 +464,7 @@ package body Prj.Env is
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;
......@@ -481,7 +476,7 @@ package body Prj.Env is
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
......@@ -495,14 +490,14 @@ package body Prj.Env is
(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
......@@ -511,44 +506,44 @@ package body Prj.Env is
(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);
......@@ -666,9 +661,7 @@ package body Prj.Env is
-- 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
......@@ -738,13 +731,9 @@ package body Prj.Env is
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;
......@@ -811,8 +800,7 @@ package body Prj.Env is
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.
......@@ -893,16 +881,18 @@ package body Prj.Env is
-- 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;
......@@ -943,7 +933,9 @@ package body Prj.Env is
-- 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;
......@@ -952,7 +944,9 @@ package body Prj.Env is
-- 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;
......@@ -963,48 +957,56 @@ package body Prj.Env is
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);
......@@ -1017,6 +1019,8 @@ package body Prj.Env is
Prj.Com.Fail ("disk full, could not write mapping file");
end if;
Project_Boolean_Htable.Reset (Present);
end Create_Mapping_File;
--------------------------
......@@ -1092,16 +1096,14 @@ package body Prj.Env is
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;
......@@ -1281,12 +1283,12 @@ package body Prj.Env is
-- 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
......@@ -1298,10 +1300,7 @@ package body Prj.Env is
-- 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
......@@ -1311,15 +1310,12 @@ package body Prj.Env is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
pragma Unreferenced (Dummy);
Data : Project_Data renames In_Tree.Projects.Table (Prj);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ?
if Data.Object_Directory /= No_Path_Information then
Get_Name_String (Data.Object_Directory.Display_Name);
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;
......@@ -1331,7 +1327,7 @@ package body Prj.Env is
-- 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;
-------------------------
......@@ -1351,16 +1347,14 @@ package body Prj.Env is
procedure For_Project (Prj : Project_Id; Dummy : in out Integer) is
pragma Unreferenced (Dummy);
Data : Project_Data renames In_Tree.Projects.Table (Prj);
Current : String_List_Id := Data.Source_Dirs;
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));
......@@ -1376,7 +1370,7 @@ package body Prj.Env is
-- 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;
-------------------
......@@ -1422,8 +1416,7 @@ package body Prj.Env is
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
......@@ -1443,8 +1436,7 @@ package body Prj.Env is
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
......@@ -1503,8 +1495,7 @@ package body Prj.Env is
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;
......@@ -1521,8 +1512,7 @@ package body Prj.Env is
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;
......@@ -1549,15 +1539,10 @@ package body Prj.Env is
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;
......@@ -1629,10 +1614,8 @@ package body Prj.Env is
-- 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;
......@@ -1671,7 +1654,6 @@ package body Prj.Env is
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
......@@ -1682,14 +1664,14 @@ package body Prj.Env is
-- 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);
......@@ -1709,34 +1691,27 @@ package body Prj.Env is
-- 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;
......@@ -1746,7 +1721,7 @@ package body Prj.Env is
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
......@@ -1799,10 +1774,10 @@ package body Prj.Env is
-- 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));
......@@ -1811,11 +1786,10 @@ package body Prj.Env is
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
......@@ -1825,11 +1799,10 @@ package body Prj.Env is
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
......@@ -1871,14 +1844,13 @@ package body Prj.Env is
---------------------------
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;
......
gcc/ada/prj-env.ads
......@@ -166,9 +166,7 @@ package Prj.Env is
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.
......
gcc/ada/prj-nmsc.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/prj-pp.adb
......@@ -74,8 +74,7 @@ package body Prj.PP is
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
......@@ -339,7 +338,7 @@ package body Prj.PP is
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;
......@@ -372,7 +371,7 @@ package body Prj.PP is
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;
......
gcc/ada/prj-pp.ads
......@@ -53,8 +53,7 @@ package Prj.PP is
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.
--
......
gcc/ada/prj-proc.adb
......@@ -111,7 +111,6 @@ package body Prj.Proc is
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
......@@ -295,7 +294,7 @@ package body Prj.Proc is
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
......@@ -683,7 +682,6 @@ package body Prj.Proc is
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;
......@@ -693,8 +691,7 @@ package body Prj.Proc is
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
......@@ -767,13 +764,9 @@ package body Prj.Proc is
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
......@@ -811,9 +804,7 @@ package body Prj.Proc is
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
......@@ -1137,10 +1128,8 @@ package body Prj.Proc is
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;
......@@ -1148,25 +1137,25 @@ package body Prj.Proc is
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;
......@@ -1175,16 +1164,16 @@ package body Prj.Proc is
-- 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;
......@@ -1204,9 +1193,7 @@ package body Prj.Proc is
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
......@@ -1342,10 +1329,8 @@ package body Prj.Proc is
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) :=
......@@ -1364,7 +1349,7 @@ package body Prj.Proc is
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
......@@ -1398,9 +1383,8 @@ package body Prj.Proc is
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
......@@ -1488,6 +1472,8 @@ package body Prj.Proc is
-- 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.
......@@ -1497,8 +1483,7 @@ package body Prj.Proc is
(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
......@@ -1531,11 +1516,9 @@ package body Prj.Proc is
(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;
......@@ -1547,16 +1530,13 @@ package body Prj.Proc is
(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,
......@@ -1565,9 +1545,7 @@ package body Prj.Proc is
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
......@@ -1579,9 +1557,7 @@ package body Prj.Proc is
(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");
......@@ -1848,9 +1824,7 @@ package body Prj.Proc is
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
......@@ -1859,9 +1833,7 @@ package body Prj.Proc is
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;
......@@ -1911,14 +1883,10 @@ package body Prj.Proc is
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
......@@ -1986,8 +1954,7 @@ package body Prj.Proc is
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
......@@ -2025,11 +1992,9 @@ package body Prj.Proc is
(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
......@@ -2131,8 +2096,7 @@ package body Prj.Proc is
(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,
......@@ -2178,8 +2142,7 @@ package body Prj.Proc is
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
......@@ -2309,7 +2272,7 @@ package body Prj.Proc is
-- 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;
......@@ -2347,6 +2310,7 @@ package body Prj.Proc is
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
Extending2 : Project_Id;
Prj : Project_List;
-- Start of processing for Process_Project_Tree_Phase_2
......@@ -2368,16 +2332,14 @@ package body Prj.Proc is
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;
......@@ -2386,13 +2348,12 @@ package body Prj.Proc is
-- 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
......@@ -2402,20 +2363,17 @@ package body Prj.Proc is
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 """ &
......@@ -2426,18 +2384,16 @@ package body Prj.Proc is
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
......@@ -2455,10 +2411,11 @@ package body Prj.Proc is
-- 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;
......@@ -2479,8 +2436,7 @@ package body Prj.Proc is
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;
......@@ -2546,12 +2502,11 @@ package body Prj.Proc is
-- 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,
......@@ -2573,7 +2528,6 @@ package body Prj.Proc is
else
declare
Processed_Data : Project_Data := Empty_Project (In_Tree);
Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Tref : Source_Buffer_Ptr;
......@@ -2595,22 +2549,22 @@ package body Prj.Proc is
-- 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);
......@@ -2621,15 +2575,15 @@ package body Prj.Proc is
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
......@@ -2641,37 +2595,35 @@ package body Prj.Proc is
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 :=
......@@ -2680,7 +2632,7 @@ package body Prj.Proc is
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),
......@@ -2702,27 +2654,22 @@ package body Prj.Proc is
-- 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
......@@ -2741,8 +2688,8 @@ package body Prj.Proc is
(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 =>
......@@ -2759,7 +2706,7 @@ package body Prj.Proc is
-- 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);
......@@ -2774,9 +2721,7 @@ package body Prj.Proc is
-- 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);
......@@ -2796,8 +2741,8 @@ package body Prj.Proc is
(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;
......@@ -2807,8 +2752,6 @@ package body Prj.Proc is
end if;
end if;
end;
In_Tree.Projects.Table (Project) := Processed_Data;
end if;
Process_Imported_Projects (Imported, Limited_With => True);
......
gcc/ada/prj-util.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -114,8 +114,7 @@ package body Prj.Util is
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
......@@ -135,7 +134,7 @@ package body Prj.Util is
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;
......@@ -188,8 +187,7 @@ package body Prj.Util is
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
......@@ -330,11 +328,9 @@ package body Prj.Util is
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);
......
gcc/ada/prj.adb
......@@ -143,12 +143,11 @@ package body Prj is
-- 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
......@@ -396,7 +395,7 @@ package body Prj is
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;
......@@ -420,16 +419,14 @@ package body Prj is
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
......@@ -455,14 +452,18 @@ package body Prj is
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);
......@@ -498,7 +499,6 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State;
Imported_First : Boolean := False)
is
......@@ -514,7 +514,6 @@ package body Prj is
---------------------
procedure Recursive_Check (Project : Project_Id) is
Data : Project_Data renames In_Tree.Projects.Table (Project);
List : Project_List;
begin
......@@ -527,13 +526,13 @@ package body Prj is
-- 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;
......@@ -585,7 +584,11 @@ package body Prj is
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;
-----------
......@@ -645,13 +648,13 @@ package body Prj is
-------------------
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;
......@@ -669,8 +672,7 @@ package body Prj is
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;
......@@ -681,7 +683,7 @@ package body Prj is
return True;
end if;
Proj := In_Tree.Projects.Table (Proj).Extends;
Proj := Proj.Extends;
end loop;
return False;
......@@ -823,18 +825,24 @@ package body Prj is
-- 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;
......@@ -875,13 +883,21 @@ package body Prj is
-- 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;
......@@ -925,13 +941,7 @@ package body Prj is
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
......@@ -966,15 +976,7 @@ package body Prj is
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
......@@ -1235,7 +1237,7 @@ package body Prj is
-- 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
......@@ -1254,7 +1256,7 @@ package body Prj is
-- 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
......@@ -1317,30 +1319,27 @@ package body Prj is
--------------------------
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
......@@ -1349,7 +1348,7 @@ package body Prj is
-- 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;
......@@ -1358,15 +1357,15 @@ package body Prj is
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;
......@@ -1380,15 +1379,14 @@ package body Prj is
-----------------------------------
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;
......@@ -1398,11 +1396,7 @@ package body Prj is
-- 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.
......@@ -1420,13 +1414,13 @@ package body Prj is
-- 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;
......@@ -1436,10 +1430,10 @@ package body Prj is
-- 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;
......@@ -1448,8 +1442,8 @@ package body Prj is
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
......
gcc/ada/prj.ads
......@@ -160,8 +160,9 @@ package Prj is
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;
......@@ -323,10 +324,8 @@ package Prj is
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
......@@ -896,8 +895,7 @@ package Prj is
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
......@@ -908,13 +906,12 @@ package Prj is
-- 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.
......@@ -938,6 +935,14 @@ package Prj is
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,
......@@ -1317,33 +1322,24 @@ package Prj is
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
......@@ -1427,7 +1423,7 @@ package Prj is
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;
......@@ -1486,7 +1482,6 @@ package Prj is
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
......@@ -1560,7 +1555,7 @@ private
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
......
gcc/ada/rtsfind.adb
......@@ -1396,7 +1396,7 @@ package body Rtsfind is
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);
......@@ -1448,8 +1448,40 @@ package body Rtsfind is
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;
......
gcc/ada/sem.adb
......@@ -1618,9 +1618,12 @@ package body Sem is
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
......
gcc/ada/sem_ch12.adb
......@@ -634,8 +634,8 @@ package body Sem_Ch12 is
-- 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
......@@ -6935,9 +6935,19 @@ package body Sem_Ch12 is
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment