Skip to content

R
riscv-gcc-1
Commit 5a66a766 by Emmanuel Briot Committed by Arnaud Charlet
Options

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

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
parent 852dba80
Showing with 433 additions and 492 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/clean.adb
......@@ -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;
-- Compare with source file names of the project
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
for Index in
1 .. Unit_Table.Last (Project_Tree.Units)
loop
Unit := Project_Tree.Units.Table (Index);
-- Compare with source file names of the project
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;
......
gcc/ada/gnatcmd.adb
......@@ -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;
......
gcc/ada/make.adb
......@@ -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,12 +4388,9 @@ 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
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
if Unit.Name /= No_Name then
-- If there is a body, put it in the mapping
......@@ -4528,7 +4517,8 @@ package body Make is
end;
end if;
end if;
end;
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;
......
gcc/ada/mlib-prj.adb
......@@ -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;
......
gcc/ada/prj-env.adb
......@@ -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);
begin
if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Naming_Exception
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 (Unit.Name,
Unit.File_Names (Spec).File,
Put (Current_Unit.Name,
Current_Unit.File_Names (Spec).File,
Spec,
Unit.File_Names (Spec).Index);
Current_Unit.File_Names (Spec).Index);
end if;
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Naming_Exception
if Current_Unit.File_Names (Impl) /= null
and then Current_Unit.File_Names (Impl).Naming_Exception
then
Put (Unit.Name,
Unit.File_Names (Impl).File,
Put (Current_Unit.Name,
Current_Unit.File_Names (Impl).File,
Impl,
Unit.File_Names (Impl).Index);
Current_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
......
gcc/ada/prj-nmsc.adb
......@@ -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,29 +698,45 @@ 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;
-- 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.Dependency := Lang_Id.Config.Dependency_Kind;
Id.Dep_Name := Dependency_Name (File_Name, Id.Dependency);
Id.Dep_Name := Dependency_Name
(File_Name, Lang_Id.Config.Dependency_Kind);
Id.Naming_Exception := Naming_Exception;
if Id.Compiled and then Id.Object_Exists then
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;
......@@ -731,13 +746,6 @@ package body Prj.Nmsc is
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);
end if;
-- Add the source to the language list
Id.Next_In_Lang := Lang_Id.First_Source;
......@@ -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,37 +7713,37 @@ 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.
begin
while Excluded /= No_File_Found loop
OK := False;
-------------
-- Exclude --
-------------
-- ??? 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;
procedure Exclude
(Extended : Project_Id;
Index : Unit_Index;
Kind : Spec_Or_Body)
is
begin
if Extended = Project
or else Is_Extending (Project, Extended)
if Source.File = Excluded.File then
if Source.Project = Project
or else Is_Extending (Project, Source.Project)
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;
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;
-- ??? Should we simply set (can be done from the
-- source)
-- Index.File_Names (Source.Kind) := null;
end if;
end if;
if Source /= No_Source then
......@@ -7789,46 +7764,7 @@ package body Prj.Nmsc is
"cannot remove a source from another project",
Excluded.Location);
end if;
end Exclude;
-- Start of processing for Mark_Excluded_Sources
begin
while Excluded /= No_File_Found loop
OK := False;
case Get_Mode is
when Ada_Only =>
-- ??? 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).
For_Each_Unit :
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Index);
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;
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.File = Excluded.File then
Exclude (Source.Project, No_Unit_Index, Spec);
exit;
end if;
......@@ -7836,7 +7772,6 @@ package body Prj.Nmsc is
end loop;
OK := OK or Excluded.Found;
end case;
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
(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))
(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;
......
gcc/ada/prj-proc.adb
......@@ -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
......
gcc/ada/prj.adb
......@@ -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.
......
gcc/ada/prj.ads
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment