mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 01:20:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2009-04-29 11:22:32 +02:00
parent 059caa3e91
commit 66713d6286
21 changed files with 1450 additions and 1650 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
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

149
gcc/ada/clean.adb
View File

@ -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;

33
gcc/ada/exp_ch7.adb
View File

@ -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,

147
gcc/ada/gnatcmd.adb
View File

@ -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;
Proj := Root_Project;
while Proj.Extends /= No_Project loop
if Project = Proj.Extends then
return True;
end if;
begin
Data := Project_Tree.Projects.Table (Root_Project);
while Data.Extends /= No_Project loop
if Project = Data.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

660
gcc/ada/make.adb
View File

File diff suppressed because it is too large Load Diff

13
gcc/ada/makeutl.adb
View File

@ -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;

215
gcc/ada/mlib-prj.adb
View File

@ -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;

21
gcc/ada/mlib-tgt.adb
View File

@ -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;

3
gcc/ada/mlib-tgt.ads
View File

@ -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;

282
gcc/ada/prj-env.adb
View File

@ -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
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, Proj);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
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.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;
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;
Next (Iter);
end loop;
end if;
Get_Name_String (Source.Path.Name);
Put_Name_Buffer;
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;

4
gcc/ada/prj-env.ads
View File

@ -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.

992
gcc/ada/prj-nmsc.adb
View File

File diff suppressed because it is too large Load Diff

7
gcc/ada/prj-pp.adb
View File

@ -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;

3
gcc/ada/prj-pp.ads
View File

@ -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.
--

257
gcc/ada/prj-proc.adb
View File

@ -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);

16
gcc/ada/prj-util.adb
View File

@ -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);

156
gcc/ada/prj.adb
View File

@ -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

49
gcc/ada/prj.ads
View File

@ -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

38
gcc/ada/rtsfind.adb
View File

@ -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;

7
gcc/ada/sem.adb
View File

@ -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

20
gcc/ada/sem_ch12.adb
View File

@ -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);