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

gnatcmd.adb, [...] (Units_Table): Removed, since no longer useful.

Browse Source 
2009-06-24  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
	prj-nmsc.adb, prj-env.adb, prj-proc.adb (Units_Table): Removed, since
	no longer useful.
	(Source_Data.Lang_Kind): Removed, since it duplicates information
	already available through Language.Config.
	(Source_Data.Compile): Removed, since information is already available
	through the language.
	(Is_Compilable): New subprogram.
	(Source_Data.Dependency): Removed, since already available through
	the language.
	(Source_Data.Object_Exist, Object_Linked): Removed since available
	through the language already.
	(Unit_Data.File_Names): Is now also set in multi_language mode, to
	bring the two modes closer in the resulting data structures.
	(Source_Data.Unit): Now a direct pointer to the unit data, rather than
	just the name that would point into a hash table.
	(Get_Language_From_Name): New subprogram.

From-SVN: r148901
This commit is contained in:
Emmanuel Briot 2009-06-24 09:27:21 +00:00 committed by Arnaud Charlet
parent 852dba8059
commit 5a66a7661d
10 changed files with 580 additions and 639 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2009-06-24 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
prj-nmsc.adb, prj-env.adb, prj-proc.adb (Units_Table): Removed, since
no longer useful.
(Source_Data.Lang_Kind): Removed, since it duplicates information
already available through Language.Config.
(Source_Data.Compile): Removed, since information is already available
through the language.
(Is_Compilable): New subprogram.
(Source_Data.Dependency): Removed, since already available through
the language.
(Source_Data.Object_Exist, Object_Linked): Removed since available
through the language already.
(Unit_Data.File_Names): Is now also set in multi_language mode, to
bring the two modes closer in the resulting data structures.
(Source_Data.Unit): Now a direct pointer to the unit data, rather than
just the name that would point into a hash table.
(Get_Language_From_Name): New subprogram.
2009-06-24 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are

58
gcc/ada/clean.adb
View File

@ -540,7 +540,7 @@ package body Clean is
Last : Natural;
Delete_File : Boolean;
Unit : Unit_Data;
Unit : Unit_Index;
begin
if Project.Library
@ -570,13 +570,11 @@ package body Clean is
Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False;
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
-- Compare with source file names of the project
for Index in
1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = Project
@ -599,6 +597,8 @@ package body Clean is
Delete_File := True;
exit;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
if Delete_File then
@ -733,15 +733,13 @@ package body Clean is
if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
-- Compare with ALI file names of the project
for
Index in 1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
Unit := Units_Htable.Get_First
(Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
No_Project
@ -781,6 +779,9 @@ package body Clean is
exit;
end if;
end if;
Unit := Units_Htable.Get_Next
(Project_Tree.Units_HT);
end loop;
end;
end if;
@ -817,7 +818,7 @@ package body Clean is
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
U_Data : Unit_Data;
Unit : Unit_Index;
File_Name1 : File_Name_Type;
Index1 : Int;
File_Name2 : File_Name_Type;
@ -879,10 +880,8 @@ package body Clean is
if Has_Ada_Sources (Project)
or else Project.Extends /= No_Project
then
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
File_Name1 := No_File;
File_Name2 := No_File;
@ -890,29 +889,26 @@ package body Clean is
-- project, check for the corresponding ALI file in the
-- object directory.
if (U_Data.File_Names (Impl) /= null
if (Unit.File_Names (Impl) /= null
and then
In_Extension_Chain
(U_Data.File_Names (Impl).Project, Project))
(Unit.File_Names (Impl).Project, Project))
or else
(U_Data.File_Names (Spec) /= null
(Unit.File_Names (Spec) /= null
and then In_Extension_Chain
(U_Data.File_Names
(Spec).Project, Project))
(Unit.File_Names (Spec).Project, Project))
then
if U_Data.File_Names (Impl) /= null then
File_Name1 := U_Data.File_Names (Impl).File;
Index1 := U_Data.File_Names (Impl).Index;
if Unit.File_Names (Impl) /= null then
File_Name1 := Unit.File_Names (Impl).File;
Index1 := Unit.File_Names (Impl).Index;
else
File_Name1 := No_File;
Index1 := 0;
end if;
if U_Data.File_Names (Spec) /= null then
File_Name2 :=
U_Data.File_Names (Spec).File;
Index2 :=
U_Data.File_Names (Spec).Index;
if Unit.File_Names (Spec) /= null then
File_Name2 := Unit.File_Names (Spec).File;
Index2 := Unit.File_Names (Spec).Index;
else
File_Name2 := No_File;
Index2 := 0;
@ -1031,6 +1027,8 @@ package body Clean is
end if;
end;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end if;

92
gcc/ada/gnatcmd.adb
View File

@ -306,7 +306,7 @@ procedure GNATCmd is
procedure Check_Files is
Add_Sources : Boolean := True;
Unit_Data : Prj.Unit_Data;
Unit : Prj.Unit_Index;
Subunit : Boolean := False;
FD : File_Descriptor := Invalid_FD;
Status : Integer;
@ -409,27 +409,24 @@ procedure GNATCmd is
end loop;
end if;
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
Unit_Data := Project_Tree.Units.Table (Unit);
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
-- For gnatls, we only need to put the library units, body or
-- spec, but not the subunits.
if The_Command = List then
if Unit_Data.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
-- There is a body, check if it is for this project
if All_Projects or else
Unit_Data.File_Names (Impl).Project = Project
Unit.File_Names (Impl).Project = Project
then
Subunit := False;
if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash
if Unit.File_Names (Spec) = null
or else Unit.File_Names (Spec).Path.Name = Slash
then
-- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain
@ -439,7 +436,7 @@ procedure GNATCmd is
Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Impl).Path.Name));
begin
Subunit :=
@ -452,25 +449,25 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Impl).Display_File));
end if;
end if;
elsif Unit_Data.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
then
-- We have a spec with no body. Check if it is for this
-- project.
if All_Projects or else
Unit_Data.File_Names (Spec).Project = Project
Unit.File_Names (Spec).Project = Project
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Spec).Display_File));
end if;
end if;
@ -481,19 +478,19 @@ procedure GNATCmd is
-- but not the subunits.
elsif The_Command = Stack then
if Unit_Data.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
-- There is a body. Check if .ci files for this project
-- must be added.
if Check_Project
(Unit_Data.File_Names (Impl).Project, Project)
(Unit.File_Names (Impl).Project, Project)
then
Subunit := False;
if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash
if Unit.File_Names (Spec) = null
or else Unit.File_Names (Spec).Path.Name = Slash
then
-- We have a body with no spec: we need to check
-- if this is a subunit, because .ci files are not
@ -503,7 +500,7 @@ procedure GNATCmd is
Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Impl).Path.Name));
begin
Subunit :=
@ -516,38 +513,38 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Impl).Project.
Object_Directory.Name) &
Directory_Separator &
MLib.Fil.Ext_To
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Impl).Display_File),
"ci"));
end if;
end if;
elsif Unit_Data.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
then
-- We have a spec with no body. Check if it is for this
-- project.
if Check_Project
(Unit_Data.File_Names (Spec).Project, Project)
(Unit.File_Names (Spec).Project, Project)
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Spec).Project.
Object_Directory.Name) &
Dir_Separator &
MLib.Fil.Ext_To
(Get_Name_String
(Unit_Data.File_Names (Spec).File),
(Unit.File_Names (Spec).File),
"ci"));
end if;
end if;
@ -558,13 +555,13 @@ procedure GNATCmd is
-- specified.
for Kind in Spec_Or_Body loop
if Unit_Data.File_Names (Kind) /= null
if Unit.File_Names (Kind) /= null
and then Check_Project
(Unit_Data.File_Names (Kind).Project, Project)
and then Unit_Data.File_Names (Kind).Path.Name /= Slash
(Unit.File_Names (Kind).Project, Project)
and then Unit.File_Names (Kind).Path.Name /= Slash
then
Get_Name_String
(Unit_Data.File_Names (Kind).Path.Display_Name);
(Unit.File_Names (Kind).Path.Display_Name);
if FD /= Invalid_FD then
Name_Len := Name_Len + 1;
@ -581,12 +578,14 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Unit.File_Names
(Kind).Path.Display_Name));
end if;
end if;
end loop;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end;
@ -758,7 +757,7 @@ procedure GNATCmd is
-- Used to read file if there is an error, it is good enough to display
-- just 250 characters if the first line of the file is very long.
Udata : Unit_Data;
Unit : Unit_Index;
Path : Path_Name_Type;
begin
@ -817,27 +816,26 @@ procedure GNATCmd is
Get_Line (File, Line, Last);
Path := No_Path;
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
Udata := Project_Tree.Units.Table (Unit);
if Udata.File_Names (Spec) /= null
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Spec) /= null
and then
Get_Name_String (Udata.File_Names (Spec).File) =
Get_Name_String (Unit.File_Names (Spec).File) =
Line (1 .. Last)
then
Path := Udata.File_Names (Spec).Path.Name;
Path := Unit.File_Names (Spec).Path.Name;
exit;
elsif Udata.File_Names (Impl) /= null
elsif Unit.File_Names (Impl) /= null
and then
Get_Name_String (Udata.File_Names (Impl).File) =
Get_Name_String (Unit.File_Names (Impl).File) =
Line (1 .. Last)
then
Path := Udata.File_Names (Impl).Path.Name;
Path := Unit.File_Names (Impl).Path.Name;
exit;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
Last_Switches.Increment_Last;

313
gcc/ada/make.adb
View File

@ -1465,19 +1465,16 @@ package body Make is
Sfile : File_Name_Type) return Boolean
is
UID : Prj.Unit_Index;
U_Data : Unit_Data;
begin
UID := Units_Htable.Get (Project_Tree.Units_HT, Uname);
if UID /= Prj.No_Unit_Index then
U_Data := Project_Tree.Units.Table (UID);
if (U_Data.File_Names (Impl) = null
or else U_Data.File_Names (Impl).File /= Sfile)
if (UID.File_Names (Impl) = null
or else UID.File_Names (Impl).File /= Sfile)
and then
(U_Data.File_Names (Spec) = null
or else U_Data.File_Names (Spec).File /= Sfile)
(UID.File_Names (Spec) = null
or else UID.File_Names (Spec).File /= Sfile)
then
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True;
@ -1942,12 +1939,11 @@ package body Make is
ALI_Project := No_Project;
declare
Udata : Prj.Unit_Data;
Udata : Prj.Unit_Index;
begin
for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop
Udata := Project_Tree.Units.Table (U);
Udata := Units_Htable.Get_First (Project_Tree.Units_HT);
while Udata /= No_Unit_Index loop
if Udata.File_Names (Impl) /= null
and then Udata.File_Names (Impl).File = Source_File
then
@ -1962,6 +1958,8 @@ package body Make is
Udata.File_Names (Spec).Project;
exit;
end if;
Udata := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end;
@ -2035,6 +2033,7 @@ package body Make is
Projects : array (1 .. Num_Ext) of Project_Id;
Dep : Sdep_Record;
OK : Boolean := True;
UID : Unit_Index;
begin
Proj := ALI_Project;
@ -2051,28 +2050,20 @@ package body Make is
ALIs.Table (ALI).Last_Sdep
loop
Dep := Sdep.Table (D);
UID := Units_Htable.Get_First (Project_Tree.Units_HT);
Proj := No_Project;
Unit_Loop :
for
UID in 1 .. Unit_Table.Last (Project_Tree.Units)
loop
if Project_Tree.Units.Table (UID).
File_Names (Impl) /= null
and then Project_Tree.Units.Table (UID).
File_Names (Impl).File = Dep.Sfile
while UID /= null loop
if UID.File_Names (Impl) /= null
and then UID.File_Names (Impl).File = Dep.Sfile
then
Proj := Project_Tree.Units.Table (UID).
File_Names (Impl).Project;
Proj := UID.File_Names (Impl).Project;
elsif Project_Tree.Units.Table (UID).
File_Names (Spec) /= null
and then Project_Tree.Units.Table (UID).
File_Names (Spec).File = Dep.Sfile
elsif UID.File_Names (Spec) /= null
and then UID.File_Names (Spec).File = Dep.Sfile
then
Proj := Project_Tree.Units.Table (UID).
File_Names (Spec).Project;
Proj := UID.File_Names (Spec).Project;
end if;
-- If a source is in a project, check if it is one
@ -2088,6 +2079,9 @@ package body Make is
exit Unit_Loop;
end if;
UID :=
Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop Unit_Loop;
end loop D_Chk;
@ -3605,7 +3599,6 @@ package body Make is
declare
Unit_Name : Name_Id;
Uid : Prj.Unit_Index;
Udata : Unit_Data;
begin
Get_Name_String (Uname);
@ -3616,26 +3609,24 @@ package body Make is
(Project_Tree.Units_HT, Unit_Name);
if Uid /= Prj.No_Unit_Index then
Udata := Project_Tree.Units.Table (Uid);
if Udata.File_Names (Impl) /= null
if Uid.File_Names (Impl) /= null
and then
Udata.File_Names (Impl).Path.Name /=
Uid.File_Names (Impl).Path.Name /=
Slash
then
Sfile := Udata.File_Names (Impl).File;
Sfile := Uid.File_Names (Impl).File;
Source_Index :=
Udata.File_Names (Impl).Index;
Uid.File_Names (Impl).Index;
elsif Udata.File_Names (Spec) /= null
elsif Uid.File_Names (Spec) /= null
and then
Udata.File_Names
Uid.File_Names
(Spec).Path.Name /= Slash
then
Sfile :=
Udata.File_Names (Spec).File;
Uid.File_Names (Spec).File;
Source_Index :=
Udata.File_Names (Spec).Index;
Uid.File_Names (Spec).Index;
end if;
end if;
end;
@ -4384,6 +4375,7 @@ package body Make is
Bytes : Integer;
OK : Boolean := True;
Unit : Unit_Index;
Status : Boolean;
-- For call to Close
@ -4396,139 +4388,137 @@ package body Make is
-- Traverse all units
for J in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
declare
Unit : constant Unit_Data := Project_Tree.Units.Table (J);
begin
if Unit.Name /= No_Name then
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
-- If there is a body, put it in the mapping
while Unit /= No_Unit_Index loop
if Unit.Name /= No_Name then
if Unit.File_Names (Impl) /= No_Source
and then Unit.File_Names (Impl).Project /=
No_Project
then
Get_Name_String (Unit.Name);
Add_Str_To_Name_Buffer ("%b");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Impl).Display_File);
ALI_Project := Unit.File_Names (Impl).Project;
-- If there is a body, put it in the mapping
-- Otherwise, if there is a spec, put it in the
-- mapping.
if Unit.File_Names (Impl) /= No_Source
and then Unit.File_Names (Impl).Project /=
No_Project
then
Get_Name_String (Unit.Name);
Add_Str_To_Name_Buffer ("%b");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Impl).Display_File);
ALI_Project := Unit.File_Names (Impl).Project;
elsif Unit.File_Names (Spec) /= No_Source
and then Unit.File_Names (Spec).Project /=
No_Project
then
Get_Name_String (Unit.Name);
Add_Str_To_Name_Buffer ("%s");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Spec).Display_File);
ALI_Project := Unit.File_Names (Spec).Project;
-- Otherwise, if there is a spec, put it in the
-- mapping.
else
ALI_Name := No_File;
end if;
elsif Unit.File_Names (Spec) /= No_Source
and then Unit.File_Names (Spec).Project /=
No_Project
then
Get_Name_String (Unit.Name);
Add_Str_To_Name_Buffer ("%s");
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Spec).Display_File);
ALI_Project := Unit.File_Names (Spec).Project;
-- If we have something to put in the mapping then do it
-- now. However, if the project is extended, we don't put
-- anything in the mapping file, because we do not know
-- where the ALI file is: it might be in the extended
-- project obj dir as well as in the extending project
-- obj dir.
else
ALI_Name := No_File;
end if;
if ALI_Name /= No_File
and then ALI_Project.Extended_By = No_Project
and then ALI_Project.Extends = No_Project
then
-- First check if the ALI file exists. If it does not,
-- do not put the unit in the mapping file.
-- If we have something to put in the mapping then do it
-- now. However, if the project is extended, we don't put
-- anything in the mapping file, because we do not know
-- where the ALI file is: it might be in the extended
-- project obj dir as well as in the extending project
-- obj dir.
if ALI_Name /= No_File
and then ALI_Project.Extended_By = No_Project
and then ALI_Project.Extends = No_Project
then
-- First check if the ALI file exists. If it does not,
-- do not put the unit in the mapping file.
declare
ALI : constant String := Get_Name_String (ALI_Name);
begin
-- For library projects, use the library directory,
-- for other projects, use the object directory.
if ALI_Project.Library then
Get_Name_String (ALI_Project.Library_Dir.Name);
else
Get_Name_String
(ALI_Project.Object_Directory.Name);
end if;
if Name_Buffer (Name_Len) /=
Directory_Separator
then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer (ALI);
Add_Char_To_Name_Buffer (ASCII.LF);
declare
ALI : constant String := Get_Name_String (ALI_Name);
ALI_Path_Name : constant String :=
Name_Buffer (1 .. Name_Len);
begin
-- For library projects, use the library directory,
-- for other projects, use the object directory.
if ALI_Project.Library then
Get_Name_String (ALI_Project.Library_Dir.Name);
else
Get_Name_String
(ALI_Project.Object_Directory.Name);
end if;
if Name_Buffer (Name_Len) /=
Directory_Separator
if Is_Regular_File
(ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
then
Add_Char_To_Name_Buffer (Directory_Separator);
-- First line is the unit name
Get_Name_String (ALI_Unit);
Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Second line it the ALI file name
Get_Name_String (ALI_Name);
Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Third line it the ALI path name
Bytes :=
Write
(Mapping_FD,
ALI_Path_Name (1)'Address,
ALI_Path_Name'Length);
OK := Bytes = ALI_Path_Name'Length;
-- If OK is False, it means we were unable
-- to write a line. No point in continuing
-- with the other units.
exit when not OK;
end if;
Add_Str_To_Name_Buffer (ALI);
Add_Char_To_Name_Buffer (ASCII.LF);
declare
ALI_Path_Name : constant String :=
Name_Buffer (1 .. Name_Len);
begin
if Is_Regular_File
(ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
then
-- First line is the unit name
Get_Name_String (ALI_Unit);
Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Second line it the ALI file name
Get_Name_String (ALI_Name);
Add_Char_To_Name_Buffer (ASCII.LF);
Bytes :=
Write
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
OK := Bytes = Name_Len;
exit when not OK;
-- Third line it the ALI path name
Bytes :=
Write
(Mapping_FD,
ALI_Path_Name (1)'Address,
ALI_Path_Name'Length);
OK := Bytes = ALI_Path_Name'Length;
-- If OK is False, it means we were unable
-- to write a line. No point in continuing
-- with the other units.
exit when not OK;
end if;
end;
end;
end if;
end;
end if;
end;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
Close (Mapping_FD, Status);
@ -6968,7 +6958,7 @@ package body Make is
Into_Q : Boolean)
is
Put_In_Q : Boolean := Into_Q;
Unit : Unit_Data;
Unit : Unit_Index;
Sfile : File_Name_Type;
Index : Int;
@ -7010,10 +7000,9 @@ package body Make is
begin
-- For all the sources in the project files,
for Id in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Id);
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= null loop
Sfile := No_File;
Index := 0;
@ -7126,6 +7115,8 @@ package body Make is
Init_Q;
end if;
end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end Insert_Project_Sources;

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

@ -936,18 +936,16 @@ package body MLib.Prj is
-- Bind is False, so that First_ALI is set.
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Source);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
@ -988,6 +986,8 @@ package body MLib.Prj is
Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end;
@ -1406,6 +1406,7 @@ package body MLib.Prj is
B_Start.all);
Fname : File_Name_Type;
Proj : Project_Id;
Index : Unit_Index;
begin
if Is_Regular_File (ALI_Path) then
@ -1417,35 +1418,26 @@ package body MLib.Prj is
-- the library.
if not Add_It then
for Index in
1 .. Unit_Table.Last
(In_Tree.Units)
loop
if In_Tree.Units.Table
(Index).File_Names
(Impl) /= null
Index := Units_Htable.Get_First
(In_Tree.Units_HT);
while Index /= null loop
if Index.File_Names (Impl) /=
null
then
Proj :=
In_Tree.Units.Table (Index).
File_Names
(Impl).Project;
Index.File_Names (Impl)
.Project;
Fname :=
In_Tree.Units.Table (Index).
File_Names (Impl).File;
Index.File_Names (Impl).File;
elsif
In_Tree.Units.Table
(Index).File_Names
(Spec) /= null
elsif Index.File_Names (Spec) /=
null
then
Proj :=
In_Tree.Units.Table
(Index).File_Names
(Spec).Project;
Index.File_Names (Spec)
.Project;
Fname :=
In_Tree.Units.Table
(Index).File_Names
(Spec).File;
Index.File_Names (Spec).File;
else
Proj := No_Project;
@ -1478,6 +1470,9 @@ package body MLib.Prj is
end if;
exit when Add_It;
Index := Units_Htable.Get_Next
(In_Tree.Units_HT);
end loop;
end if;
@ -1830,16 +1825,13 @@ package body MLib.Prj is
and then Name (Last - 3 .. Last) = ".ali"
then
declare
Unit : Unit_Data;
Unit : Unit_Index;
begin
-- Compare with ALI file names of the project
for Index in
1 .. Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Index);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
No_Project
@ -1880,6 +1872,8 @@ package body MLib.Prj is
exit;
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end;
end if;
@ -1959,7 +1953,7 @@ package body MLib.Prj is
declare
Dir : Dir_Type;
Delete : Boolean := False;
Unit : Unit_Data;
Unit : Unit_Index;
Name : String (1 .. 200);
Last : Natural;
@ -1980,9 +1974,8 @@ package body MLib.Prj is
-- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = For_Project
@ -2007,6 +2000,8 @@ package body MLib.Prj is
Delete := True;
exit;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end if;
@ -2163,7 +2158,7 @@ package body MLib.Prj is
First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id;
Data : Unit_Data;
Data : Unit_Index;
Copy_Subunits : Boolean := False;
-- When True, indicates that subunits, if any, need to be copied too
@ -2186,12 +2181,10 @@ package body MLib.Prj is
pragma Warnings (Off, Success);
begin
Unit_Loop :
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Data := In_Tree.Units.Table (Index);
Data := Units_Htable.Get_First (In_Tree.Units_HT);
Unit_Loop :
while Data /= No_Unit_Index loop
-- Find and copy the immediate or inherited source
for J in Data.File_Names'Range loop
@ -2209,6 +2202,8 @@ package body MLib.Prj is
exit Unit_Loop;
end if;
end loop;
Data := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop Unit_Loop;
end Copy;

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

@ -397,7 +397,7 @@ package body Prj.Env is
File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
Current_Unit : Unit_Index := Unit_Table.First;
Current_Unit : Unit_Index := Units_Htable.Get_First (In_Tree.Units_HT);
First_Project : Project_List;
@ -673,34 +673,26 @@ package body Prj.Env is
-- Visit all the units and process those that need an SFN pragma
while
Current_Unit <= Unit_Table.Last (In_Tree.Units)
loop
declare
Unit : constant Unit_Data :=
In_Tree.Units.Table (Current_Unit);
while Current_Unit /= No_Unit_Index loop
if Current_Unit.File_Names (Spec) /= null
and then Current_Unit.File_Names (Spec).Naming_Exception
then
Put (Current_Unit.Name,
Current_Unit.File_Names (Spec).File,
Spec,
Current_Unit.File_Names (Spec).Index);
end if;
begin
if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Naming_Exception
then
Put (Unit.Name,
Unit.File_Names (Spec).File,
Spec,
Unit.File_Names (Spec).Index);
end if;
if Current_Unit.File_Names (Impl) /= null
and then Current_Unit.File_Names (Impl).Naming_Exception
then
Put (Current_Unit.Name,
Current_Unit.File_Names (Impl).File,
Impl,
Current_Unit.File_Names (Impl).Index);
end if;
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Naming_Exception
then
Put (Unit.Name,
Unit.File_Names (Impl).File,
Impl,
Unit.File_Names (Impl).Index);
end if;
Current_Unit := Current_Unit + 1;
end;
Current_Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
-- If there are no non standard naming scheme, issue the GNAT
@ -746,19 +738,19 @@ package body Prj.Env is
--------------------
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
The_Unit_Data : Unit_Data;
Unit : Unit_Index;
Data : Source_Id;
begin
Fmap.Reset_Tables;
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
The_Unit_Data := In_Tree.Units.Table (Unit);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
-- Process only if the unit has a valid name
if The_Unit_Data.Name /= No_Name then
Data := The_Unit_Data.File_Names (Spec);
if Unit.Name /= No_Name then
Data := Unit.File_Names (Spec);
-- If there is a spec, put it in the mapping
@ -767,13 +759,13 @@ package body Prj.Env is
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (The_Unit_Data.Name),
(Unit_Name => Unit_Name_Type (Unit.Name),
File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name));
end if;
end if;
Data := The_Unit_Data.File_Names (Impl);
Data := Unit.File_Names (Impl);
-- If there is a body (or subunit) put it in the mapping
@ -782,12 +774,14 @@ package body Prj.Env is
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
(Unit_Name => Unit_Name_Type (The_Unit_Data.Name),
(Unit_Name => Unit_Name_Type (Unit.Name),
File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name));
end if;
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end Create_Mapping;
@ -810,7 +804,7 @@ package body Prj.Env is
Source : Source_Id;
Suffix : File_Name_Type;
The_Unit_Data : Unit_Data;
Unit : Unit_Index;
Data : Source_Id;
Iter : Source_Iterator;
@ -850,7 +844,7 @@ package body Prj.Env is
begin
-- Line with the unit name
Get_Name_String (The_Unit_Data.Name);
Get_Name_String (Unit.Name);
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '%';
Name_Len := Name_Len + 1;
@ -926,13 +920,12 @@ package body Prj.Env is
if Language = No_Name then
if In_Tree.Private_Part.Fill_Mapping_File then
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
The_Unit_Data := In_Tree.Units.Table (Unit);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= null loop
-- Case of unit has a valid name
if The_Unit_Data.Name /= No_Name then
Data := The_Unit_Data.File_Names (Spec);
if Unit.Name /= No_Name then
Data := Unit.File_Names (Spec);
-- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project.
@ -943,7 +936,7 @@ package body Prj.Env is
Put_Data (Spec => True);
end if;
Data := The_Unit_Data.File_Names (Impl);
Data := Unit.File_Names (Impl);
-- If there is a body (or subunit) put its mapping in the
-- file if it is from a project in the closure of Project.
@ -954,6 +947,8 @@ package body Prj.Env is
Put_Data (Spec => False);
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end if;
@ -980,8 +975,8 @@ package body Prj.Env is
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.Unit /= No_Unit_Index then
Get_Name_String (Source.Unit.Name);
if Source.Kind = Spec then
Suffix :=
@ -1111,8 +1106,7 @@ package body Prj.Env is
Name &
Body_Suffix_Of (In_Tree, "ada", Project.Naming);
Unit : Unit_Data;
Unit : Unit_Index;
The_Original_Name : Name_Id;
The_Spec_Name : Name_Id;
The_Body_Name : Name_Id;
@ -1154,13 +1148,9 @@ package body Prj.Env is
loop
-- Loop through units
-- Should have comment explaining reverse ???
for Current in reverse Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Current);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= null loop
-- Check for body
if not Main_Project_Only
@ -1290,6 +1280,8 @@ package body Prj.Env is
end if;
end;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
-- If we are not in an extending project, give up
@ -1405,16 +1397,13 @@ package body Prj.Env is
declare
Original_Name : String := Source_File_Name;
Unit : Unit_Data;
Unit : Unit_Index;
begin
Canonical_Case_File_Name (Original_Name);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
for Id in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Id);
while Unit /= null loop
if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).File /= No_File
and then
@ -1460,6 +1449,8 @@ package body Prj.Env is
return;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
end;
@ -1490,15 +1481,14 @@ package body Prj.Env is
-- Could use some comments in this body ???
procedure Print_Sources (In_Tree : Project_Tree_Ref) is
Unit : Unit_Data;
Unit : Unit_Index;
begin
Write_Line ("List of Sources:");
for Id in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Id);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= No_Unit_Index loop
Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name));
@ -1534,6 +1524,8 @@ package body Prj.Env is
Write_Line
(Namet.Get_Name_String (Unit.File_Names (Impl).File));
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
Write_Line ("end of List of Sources.");
@ -1557,7 +1549,7 @@ package body Prj.Env is
Extended_Body_Name : String :=
Name & Body_Suffix_Of (In_Tree, "ada", Main_Project.Naming);
Unit : Unit_Data;
Unit : Unit_Index;
Current_Name : File_Name_Type;
The_Original_Name : File_Name_Type;
@ -1580,11 +1572,9 @@ package body Prj.Env is
Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
The_Body_Name := Name_Find;
for Current in reverse Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Current);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= null loop
-- Case of a body present
if Unit.File_Names (Impl) /= null then
@ -1618,6 +1608,8 @@ package body Prj.Env is
exit;
end if;
end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop;
-- Get the ultimate extending project

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

@ -233,7 +233,6 @@ package body Prj.Nmsc is
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
@ -665,7 +664,6 @@ package body Prj.Nmsc is
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
@ -675,6 +673,7 @@ package body Prj.Nmsc is
Source_To_Replace : Source_Id := No_Source)
is
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
begin
Id := new Source_Data;
@ -683,7 +682,7 @@ package body Prj.Nmsc is
Write_Str ("Adding source File: ");
Write_Str (Get_Name_String (File_Name));
if Lang_Kind = Unit_Based then
if Lang_Id.Config.Kind = Unit_Based then
Write_Str (" Unit: ");
-- ??? in gprclean, it seems we sometimes pass an empty Unit name
-- (see test extended_projects)
@ -699,43 +698,52 @@ package body Prj.Nmsc is
Id.Project := Project;
Id.Language := Lang_Id;
Id.Lang_Kind := Lang_Kind;
Id.Compiled := Lang_Id.Config.Compiler_Driver /=
Empty_File_Name;
Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages;
Id.Other_Part := Other_Part;
Id.Object_Exists := Config.Object_Generated;
Id.Object_Linked := Config.Objects_Linked;
if Other_Part /= No_Source then
Other_Part.Other_Part := Id;
end if;
Id.Unit := Unit;
Id.Index := Index;
Id.File := File_Name;
Id.Display_File := Display_File;
Id.Dependency := Lang_Id.Config.Dependency_Kind;
Id.Dep_Name := Dependency_Name (File_Name, Id.Dependency);
Id.Naming_Exception := Naming_Exception;
if Id.Compiled and then Id.Object_Exists then
Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name);
end if;
if Path /= No_Path_Information then
Id.Path := Path;
Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id);
end if;
-- Add the source id to the Unit_Sources_HT hash table, if the unit name
-- is not null.
if Unit /= No_Name then
Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
-- ??? Record_Unit has already fetched that earlier, so this isn't
-- the most efficient way. But we can't really pass a parameter since
-- Process_Exceptions_Unit_Based and Check_File haven't looked it up.
UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
Units_Htable.Set (In_Tree.Units_HT, Unit, UData);
end if;
UData.File_Names (Kind) := Id;
Id.Unit := UData;
end if;
Id.Index := Index;
Id.File := File_Name;
Id.Display_File := Display_File;
Id.Dep_Name := Dependency_Name
(File_Name, Lang_Id.Config.Dependency_Kind);
Id.Naming_Exception := Naming_Exception;
if Is_Compilable (Id)
and then Config.Object_Generated
then
Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name);
end if;
if Path /= No_Path_Information then
Id.Path := Path;
Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id);
end if;
-- Add the source to the language list
@ -1152,13 +1160,6 @@ package body Prj.Nmsc is
Prev_Index : Language_Ptr := No_Language_Index;
-- The index of the previous language
Current_Language : Name_Id := No_Name;
-- The name of the language
procedure Get_Language_Index_Of (Language : Name_Id);
-- Get the language index of Language, if Language is one of the
-- languages of the project.
procedure Process_Project_Level_Simple_Attributes;
-- Process the simple attributes at the project level
@ -1168,35 +1169,6 @@ package body Prj.Nmsc is
procedure Process_Packages;
-- Read the packages of the project
---------------------------
-- Get_Language_Index_Of --
---------------------------
procedure Get_Language_Index_Of (Language : Name_Id) is
Real_Language : Name_Id;
begin
Get_Name_String (Language);
To_Lower (Name_Buffer (1 .. Name_Len));
Real_Language := Name_Find;
-- Nothing to do if the language is the same as the current language
if Current_Language /= Real_Language then
Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
exit when Lang_Index.Name = Real_Language;
Lang_Index := Lang_Index.Next;
end loop;
if Lang_Index = No_Language_Index then
Current_Language := No_Name;
else
Current_Language := Real_Language;
end if;
end if;
end Get_Language_Index_Of;
----------------------
-- Process_Packages --
----------------------
@ -1249,7 +1221,8 @@ package body Prj.Nmsc is
-- Get the name of the language
Get_Language_Index_Of (Element.Index);
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
@ -1357,7 +1330,8 @@ package body Prj.Nmsc is
-- Get the name of the language
Get_Language_Index_Of (Element.Index);
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
@ -1698,7 +1672,8 @@ package body Prj.Nmsc is
-- Get the name of the language
Get_Language_Index_Of (Element.Index);
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
@ -2215,7 +2190,8 @@ package body Prj.Nmsc is
-- Get the name of the language
Get_Language_Index_Of (Element.Index);
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
@ -2370,8 +2346,6 @@ package body Prj.Nmsc is
Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop
Current_Language := Lang_Index.Display_Name;
-- For all languages, Compiler_Driver needs to be specified. This is
-- only necessary if we do intend to compiler (not in GPS for
-- instance)
@ -2379,7 +2353,7 @@ package body Prj.Nmsc is
if Compiler_Driver_Mandatory
and then Lang_Index.Config.Compiler_Driver = No_File
then
Error_Msg_Name_1 := Current_Language;
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Project,
In_Tree,
@ -2432,7 +2406,7 @@ package body Prj.Nmsc is
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then
Lang_Index.Config.Naming_Data.Body_Suffix = No_File
then
Error_Msg_Name_1 := Current_Language;
Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg
(Project,
In_Tree,
@ -2900,8 +2874,7 @@ package body Prj.Nmsc is
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
Naming_Exception => True,
Lang_Kind => File_Based);
Naming_Exception => True);
else
-- Check if the file name is already recorded for another
@ -3011,6 +2984,8 @@ package body Prj.Nmsc is
if Unit /= No_Name then
-- Check if the source already exists
-- ??? In Ada_Only mode (Record_Unit), we use a htable for
-- efficiency
Source_To_Replace := No_Source;
Iter := For_Each_Source (In_Tree);
@ -3018,7 +2993,9 @@ package body Prj.Nmsc is
loop
Source := Prj.Element (Iter);
exit when Source = No_Source
or else (Source.Unit = Unit and then Source.Index = Index);
or else (Source.Unit /= null
and then Source.Unit.Name = Unit
and then Source.Index = Index);
Next (Iter);
end loop;
@ -3030,8 +3007,10 @@ package body Prj.Nmsc is
Next (Iter);
Source := Prj.Element (Iter);
exit when Source = No_Source or else
(Source.Unit = Unit and then Source.Index = Index);
exit when Source = No_Source
or else (Source.Unit /= null
and then Source.Unit.Name = Unit
and then Source.Index = Index);
end loop;
end if;
@ -3067,7 +3046,6 @@ package body Prj.Nmsc is
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value.Value),
Lang_Kind => Unit_Based,
Other_Part => Other_Part,
Unit => Unit,
Index => Index,
@ -3426,7 +3404,7 @@ package body Prj.Nmsc is
loop
Src_Id := Prj.Element (Iter);
exit when Src_Id = No_Source
or else Src_Id.Lang_Kind /= File_Based
or else Src_Id.Language.Config.Kind /= File_Based
or else Src_Id.Kind /= Spec;
Next (Iter);
end loop;
@ -4451,8 +4429,7 @@ package body Prj.Nmsc is
Interfaces : String_List_Id := Lib_Interfaces.Values;
Interface_ALIs : String_List_Id := Nil_String;
Unit : Name_Id;
The_Unit_Id : Unit_Index;
UData : Unit_Data;
UData : Unit_Index;
procedure Add_ALI_For (Source : File_Name_Type);
-- Add an ALI file name to the list of Interface ALIs
@ -4526,10 +4503,9 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Unit;
if Get_Mode = Ada_Only then
The_Unit_Id :=
Units_Htable.Get (In_Tree.Units_HT, Unit);
UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
if The_Unit_Id = No_Unit_Index then
if UData = No_Unit_Index then
Error_Msg
(Project, In_Tree,
"unknown unit %%",
@ -4539,12 +4515,8 @@ package body Prj.Nmsc is
else
-- Check that the unit is part of the project
UData := In_Tree.Units.Table (The_Unit_Id);
if UData.File_Names (Impl) /= null
and then
UData.File_Names (Impl).Path.Name /=
Slash
and then UData.File_Names (Impl).Path.Name /= Slash
then
if Check_Project
(UData.File_Names (Impl).Project,
@ -4625,8 +4597,10 @@ package body Prj.Nmsc is
Iter := For_Each_Source (In_Tree, Project);
loop
while Prj.Element (Iter) /= No_Source and then
Prj.Element (Iter).Unit /= Unit
while Prj.Element (Iter) /= No_Source
and then
(Prj.Element (Iter).Unit = null
or else Prj.Element (Iter).Unit.Name /= Unit)
loop
Next (Iter);
end loop;
@ -6928,9 +6902,9 @@ package body Prj.Nmsc is
if Source.Naming_Exception
and then Source.Path = No_Path_Information
then
if Source.Unit /= No_Name then
if Source.Unit /= No_Unit_Index then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Name_Id (Source.Unit);
Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
Error_Msg
(Project, In_Tree,
"source file %% for unit %% not found",
@ -7360,7 +7334,7 @@ package body Prj.Nmsc is
-- Check if this is a subunit
if Name_Loc.Source.Unit /= No_Name
if Name_Loc.Source.Unit /= No_Unit_Index
and then Name_Loc.Source.Kind = Impl
then
Src_Ind := Sinput.P.Load_Project_File
@ -7411,7 +7385,8 @@ package body Prj.Nmsc is
exit when Source = No_Source;
if Unit /= No_Name
and then Source.Unit = Unit
and then Source.Unit /= No_Unit_Index
and then Source.Unit.Name = Unit
and then
((Source.Kind = Spec and then Kind = Impl)
or else
@ -7420,7 +7395,8 @@ package body Prj.Nmsc is
Other_Part := Source;
elsif (Unit /= No_Name
and then Source.Unit = Unit
and then Source.Unit /= No_Unit_Index
and then Source.Unit.Name = Unit
and then
(Source.Kind = Kind
or else
@ -7494,7 +7470,6 @@ package body Prj.Nmsc is
In_Tree => In_Tree,
Project => Project,
Lang_Id => Language,
Lang_Kind => Lang_Kind,
Kind => Kind,
Alternate_Languages => Alternate_Languages,
File_Name => File_Name,
@ -7687,18 +7662,18 @@ package body Prj.Nmsc is
(Name => Source.File,
Location => No_Location,
Source => Source,
Except => Source.Unit /= No_Name,
Except => Source.Unit /= No_Unit_Index,
Found => False));
-- If this is an Ada exception, record in table Unit_Exceptions
if Source.Unit /= No_Name then
if Source.Unit /= No_Unit_Index then
declare
Unit_Except : Unit_Exception :=
Unit_Exceptions.Get (Source.Unit);
Unit_Exceptions.Get (Source.Unit.Name);
begin
Unit_Except.Name := Source.Unit;
Unit_Except.Name := Source.Unit.Name;
if Source.Kind = Spec then
Unit_Except.Spec := Source.File;
@ -7706,7 +7681,7 @@ package body Prj.Nmsc is
Unit_Except.Impl := Source.File;
end if;
Unit_Exceptions.Set (Source.Unit, Unit_Except);
Unit_Exceptions.Set (Source.Unit.Name, Unit_Except);
end;
end if;
@ -7738,105 +7713,65 @@ package body Prj.Nmsc is
procedure Mark_Excluded_Sources is
Source : Source_Id := No_Source;
OK : Boolean;
Unit : Unit_Data;
Excluded : File_Found := Excluded_Sources_Htable.Get_First;
procedure Exclude
(Extended : Project_Id;
Index : Unit_Index;
Kind : Spec_Or_Body);
-- If the current file (Excluded) belongs to the current project or
-- one that the current project extends, then mark this file/unit as
-- excluded. It is an error to locally remove a file from another
-- project.
-------------
-- Exclude --
-------------
procedure Exclude
(Extended : Project_Id;
Index : Unit_Index;
Kind : Spec_Or_Body)
is
begin
if Extended = Project
or else Is_Extending (Project, Extended)
then
OK := True;
if Index /= No_Unit_Index then
Unit.File_Names (Kind).Path.Name := Slash;
Unit.File_Names (Kind).Naming_Exception := False;
In_Tree.Units.Table (Index) := Unit;
end if;
if Source /= No_Source then
Source.Locally_Removed := True;
Source.In_Interfaces := False;
end if;
if Current_Verbosity = High then
Write_Str ("Removing file ");
Write_Line (Get_Name_String (Excluded.File));
end if;
Add_Forbidden_File_Name (Excluded.File);
else
Error_Msg
(Project, In_Tree,
"cannot remove a source from another project",
Excluded.Location);
end if;
end Exclude;
-- Start of processing for Mark_Excluded_Sources
Index : Unit_Index;
begin
while Excluded /= No_File_Found loop
OK := False;
case Get_Mode is
when Ada_Only =>
-- ??? Don't we have a hash table to map files to Source_Id ?
Iter := For_Each_Source (In_Tree);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
-- ??? This loop could be the same as for Multi_Language if
-- we were setting In_Tree.First_Source when we search for
-- Ada sources (basically once we have removed the use of
-- Project.Ada_Sources).
if Source.File = Excluded.File then
if Source.Project = Project
or else Is_Extending (Project, Source.Project)
then
OK := True;
For_Each_Unit :
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Index);
if Source.Unit /= No_Unit_Index then
Index :=
Units_Htable.Get
(In_Tree.Units_HT, Source.Unit.Name);
if Index.File_Names (Source.Kind) /= null then
Index.File_Names (Source.Kind).Path.Name := Slash;
Index.File_Names (Source.Kind).Naming_Exception :=
False;
for Kind in Spec_Or_Body'Range loop
if Unit.File_Names (Kind) /= null
and then Unit.File_Names (Kind).File = Excluded.File
then
Exclude (Unit.File_Names (Kind).Project, Index, Kind);
exit For_Each_Unit;
-- ??? Should we simply set (can be done from the
-- source)
-- Index.File_Names (Source.Kind) := null;
end if;
end if;
end loop;
end loop For_Each_Unit;
when Multi_Language =>
Iter := For_Each_Source (In_Tree);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
if Source /= No_Source then
Source.Locally_Removed := True;
Source.In_Interfaces := False;
end if;
if Source.File = Excluded.File then
Exclude (Source.Project, No_Unit_Index, Spec);
exit;
if Current_Verbosity = High then
Write_Str ("Removing file ");
Write_Line (Get_Name_String (Excluded.File));
end if;
Add_Forbidden_File_Name (Excluded.File);
else
Error_Msg
(Project, In_Tree,
"cannot remove a source from another project",
Excluded.Location);
end if;
Next (Iter);
end loop;
exit;
end if;
OK := OK or Excluded.Found;
end case;
Next (Iter);
end loop;
OK := OK or Excluded.Found;
if not OK then
Err_Vars.Error_Msg_File_1 := Excluded.File;
@ -7898,10 +7833,11 @@ package body Prj.Nmsc is
Src_Id := Prj.Element (Iter);
exit when Src_Id = No_Source;
if Src_Id.Compiled and then Src_Id.Object_Exists
if Is_Compilable (Src_Id)
and then Src_Id.Language.Config.Object_Generated
and then Is_Extending (Project, Src_Id.Project)
then
if Src_Id.Unit = No_Name then
if Src_Id.Unit = No_Unit_Index then
if Src_Id.Kind = Impl then
Check_Object (Src_Id);
end if;
@ -8081,10 +8017,9 @@ package body Prj.Nmsc is
Unit_Kind : Spec_Or_Body;
Needs_Pragma : Boolean)
is
The_Unit : Unit_Index :=
-- ??? Add_Source will look it up again, can we do that only once ?
UData : constant Unit_Index :=
Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
UData : Unit_Data;
Kind : Source_Kind;
Source : Source_Id;
To_Record : Boolean := False;
The_Location : Source_Ptr := Location;
@ -8101,16 +8036,13 @@ package body Prj.Nmsc is
-- unit kind (spec or body), or what is in the unit list is a unit of
-- a project we are extending.
if The_Unit /= No_Unit_Index then
UData := In_Tree.Units.Table (The_Unit);
if UData /= No_Unit_Index then
if UData.File_Names (Unit_Kind) = null
or else
((UData.File_Names (Unit_Kind).File = Canonical_File
and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).File = No_File
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project))
(UData.File_Names (Unit_Kind).File = Canonical_File
and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project)
then
if UData.File_Names (Unit_Kind) /= null
and then UData.File_Names (Unit_Kind).Path.Name = Slash
@ -8120,7 +8052,6 @@ package body Prj.Nmsc is
end if;
To_Record := True;
Source_Recorded := True;
-- If the same file is already in the list, do not add it again
@ -8180,43 +8111,26 @@ package body Prj.Nmsc is
Location);
else
UData.Name := Unit_Name;
Unit_Table.Increment_Last (In_Tree.Units);
The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
Source_Recorded := True;
To_Record := True;
end if;
end if;
if To_Record then
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
case Unit_Kind is
when Impl =>
Kind := Impl;
when Spec =>
Kind := Spec;
end case;
Add_Source
(Id => Source,
In_Tree => In_Tree,
Project => Project,
Lang_Id => Ada_Language,
Lang_Kind => Unit_Based,
File_Name => Canonical_File,
Display_File => File_Name,
Unit => Unit_Name,
Path => (Canonical_Path, Path_Name),
Naming_Exception => Needs_Pragma,
Kind => Kind,
Kind => Unit_Kind,
Index => Unit_Ind,
Other_Part => No_Source); -- ??? Can we find file ?
UData.File_Names (Unit_Kind) := Source;
In_Tree.Units.Table (The_Unit) := UData;
Source_Recorded := True;
end if;
end Record_Unit;
@ -8415,8 +8329,7 @@ package body Prj.Nmsc is
is
Conv : Array_Element_Id;
Unit : Name_Id;
The_Unit_Id : Unit_Index;
The_Unit_Data : Unit_Data;
The_Unit_Data : Unit_Index;
Location : Source_Ptr;
begin
@ -8427,14 +8340,13 @@ package body Prj.Nmsc is
Get_Name_String (Unit);
To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find;
The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
The_Unit_Data := Units_Htable.Get (In_Tree.Units_HT, Unit);
Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
if The_Unit_Id = No_Unit_Index then
if The_Unit_Data = No_Unit_Index then
Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
else
The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
Error_Msg_Name_2 :=
In_Tree.Array_Elements.Table (Conv).Value.Value;

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

@ -321,9 +321,8 @@ package body Prj.Proc is
Source1 := Prj.Element (Iter);
exit when Source1 = No_Source;
Name := Source1.Unit;
if Name /= No_Name then
if Source1.Unit /= No_Unit_Index then
Name := Source1.Unit.Name;
Source2 := Unit_Htable.Get (Name);
if Source2 = No_Source then

93
gcc/ada/prj.adb
View File

@ -149,6 +149,9 @@ package body Prj is
procedure Free_List (Languages : in out Language_List);
-- Free memory allocated for the list of languages or sources
procedure Free_Units (Table : in out Units_Htable.Instance);
-- Free memory allocated for unit information in the project
procedure Language_Changed (Iter : in out Source_Iterator);
procedure Project_Changed (Iter : in out Source_Iterator);
-- Called when a new project or language was selected for this iterator.
@ -638,21 +641,10 @@ package body Prj is
function Is_A_Language
(Project : Project_Id;
Language_Name : Name_Id) return Boolean
is
Lang_Ind : Language_Ptr;
Language_Name : Name_Id) return Boolean is
begin
Lang_Ind := Project.Languages;
while Lang_Ind /= No_Language_Index loop
if Lang_Ind.Name = Language_Name then
return True;
end if;
Lang_Ind := Lang_Ind.Next;
end loop;
return False;
return Get_Language_From_Name
(Project, Get_Name_String (Language_Name)) /= null;
end Is_A_Language;
------------------
@ -860,6 +852,11 @@ package body Prj is
while Source /= No_Source loop
Tmp := Source.Next_In_Lang;
Free_List (Source.Alternate_Languages);
if Source.Unit /= null then
Source.Unit.File_Names (Source.Kind) := null;
end if;
Unchecked_Free (Source);
Source := Tmp;
end loop;
@ -907,6 +904,32 @@ package body Prj is
end loop;
end Free_List;
----------------
-- Free_Units --
----------------
procedure Free_Units (Table : in out Units_Htable.Instance) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Unit_Data, Unit_Index);
Unit : Unit_Index;
begin
Unit := Units_Htable.Get_First (Table);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Spec) /= null then
Unit.File_Names (Spec).Unit := No_Unit_Index;
end if;
if Unit.File_Names (Impl) /= null then
Unit.File_Names (Impl).Unit := No_Unit_Index;
end if;
Unchecked_Free (Unit);
Unit := Units_Htable.Get_Next (Table);
end loop;
Units_Htable.Reset (Table);
end Free_Units;
----------
-- Free --
----------
@ -923,12 +946,11 @@ package body Prj is
Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages);
Unit_Table.Free (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part
@ -961,12 +983,11 @@ package body Prj is
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part table
@ -1427,6 +1448,42 @@ package body Prj is
For_All_Projects (Project, Dummy);
end Compute_All_Imported_Projects;
-------------------
-- Is_Compilable --
-------------------
function Is_Compilable (Source : Source_Id) return Boolean is
begin
return Source.Language.Config.Compiler_Driver /= Empty_File_Name;
end Is_Compilable;
----------------------------
-- Get_Language_From_Name --
----------------------------
function Get_Language_From_Name
(Project : Project_Id; Name : String) return Language_Ptr
is
N : Name_Id;
Result : Language_Ptr;
begin
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
To_Lower (Name_Buffer (1 .. Name_Len));
N := Name_Find;
Result := Project.Languages;
while Result /= No_Language_Index loop
if Result.Name = N then
return Result;
end if;
Result := Result.Next;
end loop;
return No_Language_Index;
end Get_Language_From_Name;
begin
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.

67
gcc/ada/prj.ads
View File

@ -307,6 +307,11 @@ package Prj is
No_Language_Index : constant Language_Ptr := null;
-- Constant indicating that there is no language data
function Get_Language_From_Name
(Project : Project_Id; Name : String) return Language_Ptr;
-- Get a language from a project. This might return null if no such
-- language exists in the project
Max_Header_Num : constant := 6150;
type Header_Num is range 0 .. Max_Header_Num;
-- Size for hash table below. The upper bound is an arbitrary value, the
@ -392,6 +397,11 @@ package Prj is
type Source_Data;
type Source_Id is access all Source_Data;
function Is_Compilable (Source : Source_Id) return Boolean;
pragma Inline (Is_Compilable);
-- Return True if we know how to compile Source (ie if a compiler is
-- defined). This doesn't indicate whether the source should be compiled
No_Source : constant Source_Id := null;
type Path_Syntax_Kind is
@ -615,6 +625,17 @@ package Prj is
end record;
type Source_Kind is (Spec, Impl, Sep);
subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
type Unit_Index is access Unit_Data;
No_Unit_Index : constant Unit_Index := null;
-- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s).
type Source_Data is record
Project : Project_Id := No_Project;
@ -624,13 +645,6 @@ package Prj is
-- Index of the language. This is an index into
-- Project_Tree.Languages_Data.
Lang_Kind : Language_Kind := File_Based;
-- Kind of the language
-- ??? Should be in Language itself
Compiled : Boolean := True;
-- False when there is no compiler for the language
In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute
-- Interfaces is declared.
@ -645,14 +659,11 @@ package Prj is
Kind : Source_Kind := Spec;
-- Kind of the source: spec, body or subunit
Dependency : Dependency_File_Kind := None;
-- Kind of dependency: none, Makefile fragment or ALI file
Other_Part : Source_Id := No_Source;
-- Source ID for the other part, if any: for a spec, indicates its body;
-- for a body, indicates its spec.
Unit : Name_Id := No_Name;
Unit : Unit_Index := No_Unit_Index;
-- Name of the unit, if language is unit based
Index : Int := 0;
@ -686,13 +697,6 @@ package Prj is
-- Project where the object file is. This might be different from
-- Project when using extending project files.
Object_Exists : Boolean := True;
-- True if an object file exists
Object_Linked : Boolean := True;
-- False if the object file is not use to link executables or included
-- in libraries.
Object : File_Name_Type := No_File;
-- File name of the object file
@ -737,15 +741,12 @@ package Prj is
No_Source_Data : constant Source_Data :=
(Project => No_Project,
Language => No_Language_Index,
Lang_Kind => File_Based,
Compiled => True,
In_Interfaces => True,
Declared_In_Interfaces => False,
Alternate_Languages => null,
Kind => Spec,
Dependency => None,
Other_Part => No_Source,
Unit => No_Name,
Unit => No_Unit_Index,
Index => 0,
Locally_Removed => False,
Get_Object => False,
@ -755,8 +756,6 @@ package Prj is
Path => No_Path_Information,
Source_TS => Empty_Time_Stamp,
Object_Project => No_Project,
Object_Exists => True,
Object_Linked => True,
Object => No_File,
Current_Object_Path => No_Path,
Object_Path => No_Path,
@ -1345,25 +1344,6 @@ package Prj is
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type Unit_Index is new Nat;
No_Unit_Index : constant Unit_Index := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
-- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s).
package Unit_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Index,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
-- Table of all units in a project tree
package Units_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Index,
@ -1417,7 +1397,6 @@ package Prj is
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Projects : Project_List;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
Unit_Sources_HT : Unit_Sources_Htable.Instance;