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> 2009-06-24 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are * exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are
......
gcc/ada/clean.adb
...@@ -540,7 +540,7 @@ package body Clean is ...@@ -540,7 +540,7 @@ package body Clean is
Last : Natural; Last : Natural;
Delete_File : Boolean; Delete_File : Boolean;
Unit : Unit_Data; Unit : Unit_Index;
begin begin
if Project.Library if Project.Library
...@@ -570,13 +570,11 @@ package body Clean is ...@@ -570,13 +570,11 @@ package body Clean is
Canonical_Case_File_Name (Name (1 .. Last)); Canonical_Case_File_Name (Name (1 .. Last));
Delete_File := False; Delete_File := False;
-- Compare with source file names of the project Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
for Index in -- Compare with source file names of the project
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 if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = Project (Unit.File_Names (Impl).Project) = Project
...@@ -599,6 +597,8 @@ package body Clean is ...@@ -599,6 +597,8 @@ package body Clean is
Delete_File := True; Delete_File := True;
exit; exit;
end if; end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
if Delete_File then if Delete_File then
...@@ -733,15 +733,13 @@ package body Clean is ...@@ -733,15 +733,13 @@ package body Clean is
if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
declare declare
Unit : Unit_Data; Unit : Unit_Index;
begin begin
-- Compare with ALI file names of the project -- Compare with ALI file names of the project
for Unit := Units_Htable.Get_First
Index in 1 .. Unit_Table.Last (Project_Tree.Units) (Project_Tree.Units_HT);
loop while Unit /= No_Unit_Index loop
Unit := Project_Tree.Units.Table (Index);
if Unit.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /= and then Unit.File_Names (Impl).Project /=
No_Project No_Project
...@@ -781,6 +779,9 @@ package body Clean is ...@@ -781,6 +779,9 @@ package body Clean is
exit; exit;
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next
(Project_Tree.Units_HT);
end loop; end loop;
end; end;
end if; end if;
...@@ -817,7 +818,7 @@ package body Clean is ...@@ -817,7 +818,7 @@ package body Clean is
-- Name of the executable file -- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir; Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
U_Data : Unit_Data; Unit : Unit_Index;
File_Name1 : File_Name_Type; File_Name1 : File_Name_Type;
Index1 : Int; Index1 : Int;
File_Name2 : File_Name_Type; File_Name2 : File_Name_Type;
...@@ -879,10 +880,8 @@ package body Clean is ...@@ -879,10 +880,8 @@ package body Clean is
if Has_Ada_Sources (Project) if Has_Ada_Sources (Project)
or else Project.Extends /= No_Project or else Project.Extends /= No_Project
then then
for Unit in Unit_Table.First .. Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
Unit_Table.Last (Project_Tree.Units) while Unit /= No_Unit_Index loop
loop
U_Data := Project_Tree.Units.Table (Unit);
File_Name1 := No_File; File_Name1 := No_File;
File_Name2 := No_File; File_Name2 := No_File;
...@@ -890,29 +889,26 @@ package body Clean is ...@@ -890,29 +889,26 @@ package body Clean is
-- project, check for the corresponding ALI file in the -- project, check for the corresponding ALI file in the
-- object directory. -- object directory.
if (U_Data.File_Names (Impl) /= null if (Unit.File_Names (Impl) /= null
and then and then
In_Extension_Chain In_Extension_Chain
(U_Data.File_Names (Impl).Project, Project)) (Unit.File_Names (Impl).Project, Project))
or else or else
(U_Data.File_Names (Spec) /= null (Unit.File_Names (Spec) /= null
and then In_Extension_Chain and then In_Extension_Chain
(U_Data.File_Names (Unit.File_Names (Spec).Project, Project))
(Spec).Project, Project))
then then
if U_Data.File_Names (Impl) /= null then if Unit.File_Names (Impl) /= null then
File_Name1 := U_Data.File_Names (Impl).File; File_Name1 := Unit.File_Names (Impl).File;
Index1 := U_Data.File_Names (Impl).Index; Index1 := Unit.File_Names (Impl).Index;
else else
File_Name1 := No_File; File_Name1 := No_File;
Index1 := 0; Index1 := 0;
end if; end if;
if U_Data.File_Names (Spec) /= null then if Unit.File_Names (Spec) /= null then
File_Name2 := File_Name2 := Unit.File_Names (Spec).File;
U_Data.File_Names (Spec).File; Index2 := Unit.File_Names (Spec).Index;
Index2 :=
U_Data.File_Names (Spec).Index;
else else
File_Name2 := No_File; File_Name2 := No_File;
Index2 := 0; Index2 := 0;
...@@ -1031,6 +1027,8 @@ package body Clean is ...@@ -1031,6 +1027,8 @@ package body Clean is
end if; end if;
end; end;
end if; end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
end if; end if;
......
gcc/ada/gnatcmd.adb
...@@ -306,7 +306,7 @@ procedure GNATCmd is ...@@ -306,7 +306,7 @@ procedure GNATCmd is
procedure Check_Files is procedure Check_Files is
Add_Sources : Boolean := True; Add_Sources : Boolean := True;
Unit_Data : Prj.Unit_Data; Unit : Prj.Unit_Index;
Subunit : Boolean := False; Subunit : Boolean := False;
FD : File_Descriptor := Invalid_FD; FD : File_Descriptor := Invalid_FD;
Status : Integer; Status : Integer;
...@@ -409,27 +409,24 @@ procedure GNATCmd is ...@@ -409,27 +409,24 @@ procedure GNATCmd is
end loop; end loop;
end if; end if;
for Unit in Unit_Table.First .. Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
Unit_Table.Last (Project_Tree.Units) while Unit /= No_Unit_Index loop
loop
Unit_Data := Project_Tree.Units.Table (Unit);
-- For gnatls, we only need to put the library units, body or -- For gnatls, we only need to put the library units, body or
-- spec, but not the subunits. -- spec, but not the subunits.
if The_Command = List then if The_Command = List then
if Unit_Data.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash and then Unit.File_Names (Impl).Path.Name /= Slash
then then
-- There is a body, check if it is for this project -- There is a body, check if it is for this project
if All_Projects or else if All_Projects or else
Unit_Data.File_Names (Impl).Project = Project Unit.File_Names (Impl).Project = Project
then then
Subunit := False; Subunit := False;
if Unit_Data.File_Names (Spec) = null if Unit.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash or else Unit.File_Names (Spec).Path.Name = Slash
then then
-- We have a body with no spec: we need to check if -- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain -- this is a subunit, because gnatls will complain
...@@ -439,7 +436,7 @@ procedure GNATCmd is ...@@ -439,7 +436,7 @@ procedure GNATCmd is
Src_Ind : constant Source_File_Index := Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Impl).Path.Name)); (Impl).Path.Name));
begin begin
Subunit := Subunit :=
...@@ -452,25 +449,25 @@ procedure GNATCmd is ...@@ -452,25 +449,25 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Impl).Display_File)); (Impl).Display_File));
end if; end if;
end if; end if;
elsif Unit_Data.File_Names (Spec) /= null elsif Unit.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash and then Unit.File_Names (Spec).Path.Name /= Slash
then then
-- We have a spec with no body. Check if it is for this -- We have a spec with no body. Check if it is for this
-- project. -- project.
if All_Projects or else if All_Projects or else
Unit_Data.File_Names (Spec).Project = Project Unit.File_Names (Spec).Project = Project
then then
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Spec).Display_File)); (Spec).Display_File));
end if; end if;
end if; end if;
...@@ -481,19 +478,19 @@ procedure GNATCmd is ...@@ -481,19 +478,19 @@ procedure GNATCmd is
-- but not the subunits. -- but not the subunits.
elsif The_Command = Stack then elsif The_Command = Stack then
if Unit_Data.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash and then Unit.File_Names (Impl).Path.Name /= Slash
then then
-- There is a body. Check if .ci files for this project -- There is a body. Check if .ci files for this project
-- must be added. -- must be added.
if Check_Project if Check_Project
(Unit_Data.File_Names (Impl).Project, Project) (Unit.File_Names (Impl).Project, Project)
then then
Subunit := False; Subunit := False;
if Unit_Data.File_Names (Spec) = null if Unit.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash or else Unit.File_Names (Spec).Path.Name = Slash
then then
-- We have a body with no spec: we need to check -- We have a body with no spec: we need to check
-- if this is a subunit, because .ci files are not -- if this is a subunit, because .ci files are not
...@@ -503,7 +500,7 @@ procedure GNATCmd is ...@@ -503,7 +500,7 @@ procedure GNATCmd is
Src_Ind : constant Source_File_Index := Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Impl).Path.Name)); (Impl).Path.Name));
begin begin
Subunit := Subunit :=
...@@ -516,38 +513,38 @@ procedure GNATCmd is ...@@ -516,38 +513,38 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Impl).Project. (Impl).Project.
Object_Directory.Name) & Object_Directory.Name) &
Directory_Separator & Directory_Separator &
MLib.Fil.Ext_To MLib.Fil.Ext_To
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Impl).Display_File), (Impl).Display_File),
"ci")); "ci"));
end if; end if;
end if; end if;
elsif Unit_Data.File_Names (Spec) /= null elsif Unit.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash and then Unit.File_Names (Spec).Path.Name /= Slash
then then
-- We have a spec with no body. Check if it is for this -- We have a spec with no body. Check if it is for this
-- project. -- project.
if Check_Project if Check_Project
(Unit_Data.File_Names (Spec).Project, Project) (Unit.File_Names (Spec).Project, Project)
then then
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Spec).Project. (Spec).Project.
Object_Directory.Name) & Object_Directory.Name) &
Dir_Separator & Dir_Separator &
MLib.Fil.Ext_To MLib.Fil.Ext_To
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Spec).File), (Unit.File_Names (Spec).File),
"ci")); "ci"));
end if; end if;
end if; end if;
...@@ -558,13 +555,13 @@ procedure GNATCmd is ...@@ -558,13 +555,13 @@ procedure GNATCmd is
-- specified. -- specified.
for Kind in Spec_Or_Body loop for Kind in Spec_Or_Body loop
if Unit_Data.File_Names (Kind) /= null if Unit.File_Names (Kind) /= null
and then Check_Project and then Check_Project
(Unit_Data.File_Names (Kind).Project, Project) (Unit.File_Names (Kind).Project, Project)
and then Unit_Data.File_Names (Kind).Path.Name /= Slash and then Unit.File_Names (Kind).Path.Name /= Slash
then then
Get_Name_String Get_Name_String
(Unit_Data.File_Names (Kind).Path.Display_Name); (Unit.File_Names (Kind).Path.Display_Name);
if FD /= Invalid_FD then if FD /= Invalid_FD then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -581,12 +578,14 @@ procedure GNATCmd is ...@@ -581,12 +578,14 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit.File_Names
(Kind).Path.Display_Name)); (Kind).Path.Display_Name));
end if; end if;
end if; end if;
end loop; end loop;
end if; end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
end; end;
...@@ -758,7 +757,7 @@ procedure GNATCmd is ...@@ -758,7 +757,7 @@ procedure GNATCmd is
-- Used to read file if there is an error, it is good enough to display -- 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. -- just 250 characters if the first line of the file is very long.
Udata : Unit_Data; Unit : Unit_Index;
Path : Path_Name_Type; Path : Path_Name_Type;
begin begin
...@@ -817,27 +816,26 @@ procedure GNATCmd is ...@@ -817,27 +816,26 @@ procedure GNATCmd is
Get_Line (File, Line, Last); Get_Line (File, Line, Last);
Path := No_Path; Path := No_Path;
for Unit in Unit_Table.First .. Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
Unit_Table.Last (Project_Tree.Units) while Unit /= No_Unit_Index loop
loop if Unit.File_Names (Spec) /= null
Udata := Project_Tree.Units.Table (Unit);
if Udata.File_Names (Spec) /= null
and then and then
Get_Name_String (Udata.File_Names (Spec).File) = Get_Name_String (Unit.File_Names (Spec).File) =
Line (1 .. Last) Line (1 .. Last)
then then
Path := Udata.File_Names (Spec).Path.Name; Path := Unit.File_Names (Spec).Path.Name;
exit; exit;
elsif Udata.File_Names (Impl) /= null elsif Unit.File_Names (Impl) /= null
and then and then
Get_Name_String (Udata.File_Names (Impl).File) = Get_Name_String (Unit.File_Names (Impl).File) =
Line (1 .. Last) Line (1 .. Last)
then then
Path := Udata.File_Names (Impl).Path.Name; Path := Unit.File_Names (Impl).Path.Name;
exit; exit;
end if; end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
......
gcc/ada/make.adb
...@@ -1465,19 +1465,16 @@ package body Make is ...@@ -1465,19 +1465,16 @@ package body Make is
Sfile : File_Name_Type) return Boolean Sfile : File_Name_Type) return Boolean
is is
UID : Prj.Unit_Index; UID : Prj.Unit_Index;
U_Data : Unit_Data;
begin begin
UID := Units_Htable.Get (Project_Tree.Units_HT, Uname); UID := Units_Htable.Get (Project_Tree.Units_HT, Uname);
if UID /= Prj.No_Unit_Index then if UID /= Prj.No_Unit_Index then
U_Data := Project_Tree.Units.Table (UID); if (UID.File_Names (Impl) = null
or else UID.File_Names (Impl).File /= Sfile)
if (U_Data.File_Names (Impl) = null
or else U_Data.File_Names (Impl).File /= Sfile)
and then and then
(U_Data.File_Names (Spec) = null (UID.File_Names (Spec) = null
or else U_Data.File_Names (Spec).File /= Sfile) or else UID.File_Names (Spec).File /= Sfile)
then then
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile)); Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True; return True;
...@@ -1942,12 +1939,11 @@ package body Make is ...@@ -1942,12 +1939,11 @@ package body Make is
ALI_Project := No_Project; ALI_Project := No_Project;
declare declare
Udata : Prj.Unit_Data; Udata : Prj.Unit_Index;
begin begin
for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop Udata := Units_Htable.Get_First (Project_Tree.Units_HT);
Udata := Project_Tree.Units.Table (U); while Udata /= No_Unit_Index loop
if Udata.File_Names (Impl) /= null if Udata.File_Names (Impl) /= null
and then Udata.File_Names (Impl).File = Source_File and then Udata.File_Names (Impl).File = Source_File
then then
...@@ -1962,6 +1958,8 @@ package body Make is ...@@ -1962,6 +1958,8 @@ package body Make is
Udata.File_Names (Spec).Project; Udata.File_Names (Spec).Project;
exit; exit;
end if; end if;
Udata := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
end; end;
...@@ -2035,6 +2033,7 @@ package body Make is ...@@ -2035,6 +2033,7 @@ package body Make is
Projects : array (1 .. Num_Ext) of Project_Id; Projects : array (1 .. Num_Ext) of Project_Id;
Dep : Sdep_Record; Dep : Sdep_Record;
OK : Boolean := True; OK : Boolean := True;
UID : Unit_Index;
begin begin
Proj := ALI_Project; Proj := ALI_Project;
...@@ -2051,28 +2050,20 @@ package body Make is ...@@ -2051,28 +2050,20 @@ package body Make is
ALIs.Table (ALI).Last_Sdep ALIs.Table (ALI).Last_Sdep
loop loop
Dep := Sdep.Table (D); Dep := Sdep.Table (D);
UID := Units_Htable.Get_First (Project_Tree.Units_HT);
Proj := No_Project; Proj := No_Project;
Unit_Loop : Unit_Loop :
for while UID /= null loop
UID in 1 .. Unit_Table.Last (Project_Tree.Units) if UID.File_Names (Impl) /= null
loop and then UID.File_Names (Impl).File = Dep.Sfile
if Project_Tree.Units.Table (UID).
File_Names (Impl) /= null
and then Project_Tree.Units.Table (UID).
File_Names (Impl).File = Dep.Sfile
then then
Proj := Project_Tree.Units.Table (UID). Proj := UID.File_Names (Impl).Project;
File_Names (Impl).Project;
elsif Project_Tree.Units.Table (UID). elsif UID.File_Names (Spec) /= null
File_Names (Spec) /= null and then UID.File_Names (Spec).File = Dep.Sfile
and then Project_Tree.Units.Table (UID).
File_Names (Spec).File = Dep.Sfile
then then
Proj := Project_Tree.Units.Table (UID). Proj := UID.File_Names (Spec).Project;
File_Names (Spec).Project;
end if; end if;
-- If a source is in a project, check if it is one -- If a source is in a project, check if it is one
...@@ -2088,6 +2079,9 @@ package body Make is ...@@ -2088,6 +2079,9 @@ package body Make is
exit Unit_Loop; exit Unit_Loop;
end if; end if;
UID :=
Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop Unit_Loop; end loop Unit_Loop;
end loop D_Chk; end loop D_Chk;
...@@ -3605,7 +3599,6 @@ package body Make is ...@@ -3605,7 +3599,6 @@ package body Make is
declare declare
Unit_Name : Name_Id; Unit_Name : Name_Id;
Uid : Prj.Unit_Index; Uid : Prj.Unit_Index;
Udata : Unit_Data;
begin begin
Get_Name_String (Uname); Get_Name_String (Uname);
...@@ -3616,26 +3609,24 @@ package body Make is ...@@ -3616,26 +3609,24 @@ package body Make is
(Project_Tree.Units_HT, Unit_Name); (Project_Tree.Units_HT, Unit_Name);
if Uid /= Prj.No_Unit_Index then if Uid /= Prj.No_Unit_Index then
Udata := Project_Tree.Units.Table (Uid); if Uid.File_Names (Impl) /= null
if Udata.File_Names (Impl) /= null
and then and then
Udata.File_Names (Impl).Path.Name /= Uid.File_Names (Impl).Path.Name /=
Slash Slash
then then
Sfile := Udata.File_Names (Impl).File; Sfile := Uid.File_Names (Impl).File;
Source_Index := 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 and then
Udata.File_Names Uid.File_Names
(Spec).Path.Name /= Slash (Spec).Path.Name /= Slash
then then
Sfile := Sfile :=
Udata.File_Names (Spec).File; Uid.File_Names (Spec).File;
Source_Index := Source_Index :=
Udata.File_Names (Spec).Index; Uid.File_Names (Spec).Index;
end if; end if;
end if; end if;
end; end;
...@@ -4384,6 +4375,7 @@ package body Make is ...@@ -4384,6 +4375,7 @@ package body Make is
Bytes : Integer; Bytes : Integer;
OK : Boolean := True; OK : Boolean := True;
Unit : Unit_Index;
Status : Boolean; Status : Boolean;
-- For call to Close -- For call to Close
...@@ -4396,12 +4388,9 @@ package body Make is ...@@ -4396,12 +4388,9 @@ package body Make is
-- Traverse all units -- Traverse all units
for J in Unit_Table.First .. Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
Unit_Table.Last (Project_Tree.Units)
loop while Unit /= No_Unit_Index loop
declare
Unit : constant Unit_Data := Project_Tree.Units.Table (J);
begin
if Unit.Name /= No_Name then if Unit.Name /= No_Name then
-- If there is a body, put it in the mapping -- If there is a body, put it in the mapping
...@@ -4528,7 +4517,8 @@ package body Make is ...@@ -4528,7 +4517,8 @@ package body Make is
end; end;
end if; end if;
end if; end if;
end;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
Close (Mapping_FD, Status); Close (Mapping_FD, Status);
...@@ -6968,7 +6958,7 @@ package body Make is ...@@ -6968,7 +6958,7 @@ package body Make is
Into_Q : Boolean) Into_Q : Boolean)
is is
Put_In_Q : Boolean := Into_Q; Put_In_Q : Boolean := Into_Q;
Unit : Unit_Data; Unit : Unit_Index;
Sfile : File_Name_Type; Sfile : File_Name_Type;
Index : Int; Index : Int;
...@@ -7010,10 +7000,9 @@ package body Make is ...@@ -7010,10 +7000,9 @@ package body Make is
begin begin
-- For all the sources in the project files, -- For all the sources in the project files,
for Id in Unit_Table.First .. Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
Unit_Table.Last (Project_Tree.Units)
loop while Unit /= null loop
Unit := Project_Tree.Units.Table (Id);
Sfile := No_File; Sfile := No_File;
Index := 0; Index := 0;
...@@ -7126,6 +7115,8 @@ package body Make is ...@@ -7126,6 +7115,8 @@ package body Make is
Init_Q; Init_Q;
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop; end loop;
end Insert_Project_Sources; end Insert_Project_Sources;
......
gcc/ada/mlib-prj.adb
...@@ -936,18 +936,16 @@ package body MLib.Prj is ...@@ -936,18 +936,16 @@ package body MLib.Prj is
-- Bind is False, so that First_ALI is set. -- Bind is False, so that First_ALI is set.
declare declare
Unit : Unit_Data; Unit : Unit_Index;
begin begin
Library_ALIs.Reset; Library_ALIs.Reset;
Interface_ALIs.Reset; Interface_ALIs.Reset;
Processed_ALIs.Reset; Processed_ALIs.Reset;
for Source in Unit_Table.First .. Unit := Units_Htable.Get_First (In_Tree.Units_HT);
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Source);
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash and then Unit.File_Names (Impl).Path.Name /= Slash
then then
...@@ -988,6 +986,8 @@ package body MLib.Prj is ...@@ -988,6 +986,8 @@ package body MLib.Prj is
Add_ALI_For (Unit.File_Names (Spec).File); Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind; exit when not Bind;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end; end;
...@@ -1406,6 +1406,7 @@ package body MLib.Prj is ...@@ -1406,6 +1406,7 @@ package body MLib.Prj is
B_Start.all); B_Start.all);
Fname : File_Name_Type; Fname : File_Name_Type;
Proj : Project_Id; Proj : Project_Id;
Index : Unit_Index;
begin begin
if Is_Regular_File (ALI_Path) then if Is_Regular_File (ALI_Path) then
...@@ -1417,35 +1418,26 @@ package body MLib.Prj is ...@@ -1417,35 +1418,26 @@ package body MLib.Prj is
-- the library. -- the library.
if not Add_It then if not Add_It then
for Index in Index := Units_Htable.Get_First
1 .. Unit_Table.Last (In_Tree.Units_HT);
(In_Tree.Units) while Index /= null loop
loop if Index.File_Names (Impl) /=
if In_Tree.Units.Table null
(Index).File_Names
(Impl) /= null
then then
Proj := Proj :=
In_Tree.Units.Table (Index). Index.File_Names (Impl)
File_Names .Project;
(Impl).Project;
Fname := Fname :=
In_Tree.Units.Table (Index). Index.File_Names (Impl).File;
File_Names (Impl).File;
elsif elsif Index.File_Names (Spec) /=
In_Tree.Units.Table null
(Index).File_Names
(Spec) /= null
then then
Proj := Proj :=
In_Tree.Units.Table Index.File_Names (Spec)
(Index).File_Names .Project;
(Spec).Project;
Fname := Fname :=
In_Tree.Units.Table Index.File_Names (Spec).File;
(Index).File_Names
(Spec).File;
else else
Proj := No_Project; Proj := No_Project;
...@@ -1478,6 +1470,9 @@ package body MLib.Prj is ...@@ -1478,6 +1470,9 @@ package body MLib.Prj is
end if; end if;
exit when Add_It; exit when Add_It;
Index := Units_Htable.Get_Next
(In_Tree.Units_HT);
end loop; end loop;
end if; end if;
...@@ -1830,16 +1825,13 @@ package body MLib.Prj is ...@@ -1830,16 +1825,13 @@ package body MLib.Prj is
and then Name (Last - 3 .. Last) = ".ali" and then Name (Last - 3 .. Last) = ".ali"
then then
declare declare
Unit : Unit_Data; Unit : Unit_Index;
begin begin
-- Compare with ALI file names of the project -- Compare with ALI file names of the project
for Index in Unit := Units_Htable.Get_First (In_Tree.Units_HT);
1 .. Unit_Table.Last (In_Tree.Units) while Unit /= No_Unit_Index loop
loop
Unit := In_Tree.Units.Table (Index);
if Unit.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /= and then Unit.File_Names (Impl).Project /=
No_Project No_Project
...@@ -1880,6 +1872,8 @@ package body MLib.Prj is ...@@ -1880,6 +1872,8 @@ package body MLib.Prj is
exit; exit;
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end; end;
end if; end if;
...@@ -1959,7 +1953,7 @@ package body MLib.Prj is ...@@ -1959,7 +1953,7 @@ package body MLib.Prj is
declare declare
Dir : Dir_Type; Dir : Dir_Type;
Delete : Boolean := False; Delete : Boolean := False;
Unit : Unit_Data; Unit : Unit_Index;
Name : String (1 .. 200); Name : String (1 .. 200);
Last : Natural; Last : Natural;
...@@ -1980,9 +1974,8 @@ package body MLib.Prj is ...@@ -1980,9 +1974,8 @@ package body MLib.Prj is
-- Compare with source file names of the project -- Compare with source file names of the project
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop Unit := Units_Htable.Get_First (In_Tree.Units_HT);
Unit := In_Tree.Units.Table (Index); while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = For_Project (Unit.File_Names (Impl).Project) = For_Project
...@@ -2007,6 +2000,8 @@ package body MLib.Prj is ...@@ -2007,6 +2000,8 @@ package body MLib.Prj is
Delete := True; Delete := True;
exit; exit;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end if; end if;
...@@ -2163,7 +2158,7 @@ package body MLib.Prj is ...@@ -2163,7 +2158,7 @@ package body MLib.Prj is
First_Unit : ALI.Unit_Id; First_Unit : ALI.Unit_Id;
Second_Unit : ALI.Unit_Id; Second_Unit : ALI.Unit_Id;
Data : Unit_Data; Data : Unit_Index;
Copy_Subunits : Boolean := False; Copy_Subunits : Boolean := False;
-- When True, indicates that subunits, if any, need to be copied too -- When True, indicates that subunits, if any, need to be copied too
...@@ -2186,12 +2181,10 @@ package body MLib.Prj is ...@@ -2186,12 +2181,10 @@ package body MLib.Prj is
pragma Warnings (Off, Success); pragma Warnings (Off, Success);
begin begin
Unit_Loop : Data := Units_Htable.Get_First (In_Tree.Units_HT);
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Data := In_Tree.Units.Table (Index);
Unit_Loop :
while Data /= No_Unit_Index loop
-- Find and copy the immediate or inherited source -- Find and copy the immediate or inherited source
for J in Data.File_Names'Range loop for J in Data.File_Names'Range loop
...@@ -2209,6 +2202,8 @@ package body MLib.Prj is ...@@ -2209,6 +2202,8 @@ package body MLib.Prj is
exit Unit_Loop; exit Unit_Loop;
end if; end if;
end loop; end loop;
Data := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop Unit_Loop; end loop Unit_Loop;
end Copy; end Copy;
......
gcc/ada/prj-env.adb
...@@ -397,7 +397,7 @@ package body Prj.Env is ...@@ -397,7 +397,7 @@ package body Prj.Env is
File_Name : Path_Name_Type := No_Path; File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD; 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; First_Project : Project_List;
...@@ -673,34 +673,26 @@ package body Prj.Env is ...@@ -673,34 +673,26 @@ package body Prj.Env is
-- Visit all the units and process those that need an SFN pragma -- Visit all the units and process those that need an SFN pragma
while while Current_Unit /= No_Unit_Index loop
Current_Unit <= Unit_Table.Last (In_Tree.Units) if Current_Unit.File_Names (Spec) /= null
loop and then Current_Unit.File_Names (Spec).Naming_Exception
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
then then
Put (Unit.Name, Put (Current_Unit.Name,
Unit.File_Names (Spec).File, Current_Unit.File_Names (Spec).File,
Spec, Spec,
Unit.File_Names (Spec).Index); Current_Unit.File_Names (Spec).Index);
end if; end if;
if Unit.File_Names (Impl) /= null if Current_Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Naming_Exception and then Current_Unit.File_Names (Impl).Naming_Exception
then then
Put (Unit.Name, Put (Current_Unit.Name,
Unit.File_Names (Impl).File, Current_Unit.File_Names (Impl).File,
Impl, Impl,
Unit.File_Names (Impl).Index); Current_Unit.File_Names (Impl).Index);
end if; end if;
Current_Unit := Current_Unit + 1; Current_Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end;
end loop; end loop;
-- If there are no non standard naming scheme, issue the GNAT -- If there are no non standard naming scheme, issue the GNAT
...@@ -746,19 +738,19 @@ package body Prj.Env is ...@@ -746,19 +738,19 @@ package body Prj.Env is
-------------------- --------------------
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
The_Unit_Data : Unit_Data; Unit : Unit_Index;
Data : Source_Id; Data : Source_Id;
begin begin
Fmap.Reset_Tables; Fmap.Reset_Tables;
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop Unit := Units_Htable.Get_First (In_Tree.Units_HT);
The_Unit_Data := In_Tree.Units.Table (Unit);
while Unit /= No_Unit_Index loop
-- Process only if the unit has a valid name -- Process only if the unit has a valid name
if The_Unit_Data.Name /= No_Name then if Unit.Name /= No_Name then
Data := The_Unit_Data.File_Names (Spec); Data := Unit.File_Names (Spec);
-- If there is a spec, put it in the mapping -- If there is a spec, put it in the mapping
...@@ -767,13 +759,13 @@ package body Prj.Env is ...@@ -767,13 +759,13 @@ package body Prj.Env is
Fmap.Add_Forbidden_File_Name (Data.File); Fmap.Add_Forbidden_File_Name (Data.File);
else else
Fmap.Add_To_File_Map 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, File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name)); Path_Name => File_Name_Type (Data.Path.Name));
end if; end if;
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 -- If there is a body (or subunit) put it in the mapping
...@@ -782,12 +774,14 @@ package body Prj.Env is ...@@ -782,12 +774,14 @@ package body Prj.Env is
Fmap.Add_Forbidden_File_Name (Data.File); Fmap.Add_Forbidden_File_Name (Data.File);
else else
Fmap.Add_To_File_Map 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, File_Name => Data.File,
Path_Name => File_Name_Type (Data.Path.Name)); Path_Name => File_Name_Type (Data.Path.Name));
end if; end if;
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end Create_Mapping; end Create_Mapping;
...@@ -810,7 +804,7 @@ package body Prj.Env is ...@@ -810,7 +804,7 @@ package body Prj.Env is
Source : Source_Id; Source : Source_Id;
Suffix : File_Name_Type; Suffix : File_Name_Type;
The_Unit_Data : Unit_Data; Unit : Unit_Index;
Data : Source_Id; Data : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
...@@ -850,7 +844,7 @@ package body Prj.Env is ...@@ -850,7 +844,7 @@ package body Prj.Env is
begin begin
-- Line with the unit name -- Line with the unit name
Get_Name_String (The_Unit_Data.Name); Get_Name_String (Unit.Name);
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := '%'; Name_Buffer (Name_Len) := '%';
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -926,13 +920,12 @@ package body Prj.Env is ...@@ -926,13 +920,12 @@ package body Prj.Env is
if Language = No_Name then if Language = No_Name then
if In_Tree.Private_Part.Fill_Mapping_File then if In_Tree.Private_Part.Fill_Mapping_File then
for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop Unit := Units_Htable.Get_First (In_Tree.Units_HT);
The_Unit_Data := In_Tree.Units.Table (Unit); while Unit /= null loop
-- Case of unit has a valid name -- Case of unit has a valid name
if The_Unit_Data.Name /= No_Name then if Unit.Name /= No_Name then
Data := The_Unit_Data.File_Names (Spec); Data := Unit.File_Names (Spec);
-- If there is a spec, put it mapping in the file if it is -- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project. -- from a project in the closure of Project.
...@@ -943,7 +936,7 @@ package body Prj.Env is ...@@ -943,7 +936,7 @@ package body Prj.Env is
Put_Data (Spec => True); Put_Data (Spec => True);
end if; 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 -- If there is a body (or subunit) put its mapping in the
-- file if it is from a project in the closure of Project. -- file if it is from a project in the closure of Project.
...@@ -954,6 +947,8 @@ package body Prj.Env is ...@@ -954,6 +947,8 @@ package body Prj.Env is
Put_Data (Spec => False); Put_Data (Spec => False);
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end if; end if;
...@@ -980,8 +975,8 @@ package body Prj.Env is ...@@ -980,8 +975,8 @@ package body Prj.Env is
and then Source.Replaced_By = No_Source and then Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path and then Source.Path.Name /= No_Path
then then
if Source.Unit /= No_Name then if Source.Unit /= No_Unit_Index then
Get_Name_String (Source.Unit); Get_Name_String (Source.Unit.Name);
if Source.Kind = Spec then if Source.Kind = Spec then
Suffix := Suffix :=
...@@ -1111,8 +1106,7 @@ package body Prj.Env is ...@@ -1111,8 +1106,7 @@ package body Prj.Env is
Name & Name &
Body_Suffix_Of (In_Tree, "ada", Project.Naming); Body_Suffix_Of (In_Tree, "ada", Project.Naming);
Unit : Unit_Data; Unit : Unit_Index;
The_Original_Name : Name_Id; The_Original_Name : Name_Id;
The_Spec_Name : Name_Id; The_Spec_Name : Name_Id;
The_Body_Name : Name_Id; The_Body_Name : Name_Id;
...@@ -1154,13 +1148,9 @@ package body Prj.Env is ...@@ -1154,13 +1148,9 @@ package body Prj.Env is
loop loop
-- Loop through units -- 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 -- Check for body
if not Main_Project_Only if not Main_Project_Only
...@@ -1290,6 +1280,8 @@ package body Prj.Env is ...@@ -1290,6 +1280,8 @@ package body Prj.Env is
end if; end if;
end; end;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
-- If we are not in an extending project, give up -- If we are not in an extending project, give up
...@@ -1405,16 +1397,13 @@ package body Prj.Env is ...@@ -1405,16 +1397,13 @@ package body Prj.Env is
declare declare
Original_Name : String := Source_File_Name; Original_Name : String := Source_File_Name;
Unit : Unit_Data; Unit : Unit_Index;
begin begin
Canonical_Case_File_Name (Original_Name); Canonical_Case_File_Name (Original_Name);
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
for Id in Unit_Table.First .. while Unit /= null loop
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Id);
if Unit.File_Names (Spec) /= null if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).File /= No_File and then Unit.File_Names (Spec).File /= No_File
and then and then
...@@ -1460,6 +1449,8 @@ package body Prj.Env is ...@@ -1460,6 +1449,8 @@ package body Prj.Env is
return; return;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
end; end;
...@@ -1490,15 +1481,14 @@ package body Prj.Env is ...@@ -1490,15 +1481,14 @@ package body Prj.Env is
-- Could use some comments in this body ??? -- Could use some comments in this body ???
procedure Print_Sources (In_Tree : Project_Tree_Ref) is procedure Print_Sources (In_Tree : Project_Tree_Ref) is
Unit : Unit_Data; Unit : Unit_Index;
begin begin
Write_Line ("List of Sources:"); Write_Line ("List of Sources:");
for Id in Unit_Table.First .. Unit := Units_Htable.Get_First (In_Tree.Units_HT);
Unit_Table.Last (In_Tree.Units)
loop while Unit /= No_Unit_Index loop
Unit := In_Tree.Units.Table (Id);
Write_Str (" "); Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name)); Write_Line (Namet.Get_Name_String (Unit.Name));
...@@ -1534,6 +1524,8 @@ package body Prj.Env is ...@@ -1534,6 +1524,8 @@ package body Prj.Env is
Write_Line Write_Line
(Namet.Get_Name_String (Unit.File_Names (Impl).File)); (Namet.Get_Name_String (Unit.File_Names (Impl).File));
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
Write_Line ("end of List of Sources."); Write_Line ("end of List of Sources.");
...@@ -1557,7 +1549,7 @@ package body Prj.Env is ...@@ -1557,7 +1549,7 @@ package body Prj.Env is
Extended_Body_Name : String := Extended_Body_Name : String :=
Name & Body_Suffix_Of (In_Tree, "ada", Main_Project.Naming); Name & Body_Suffix_Of (In_Tree, "ada", Main_Project.Naming);
Unit : Unit_Data; Unit : Unit_Index;
Current_Name : File_Name_Type; Current_Name : File_Name_Type;
The_Original_Name : File_Name_Type; The_Original_Name : File_Name_Type;
...@@ -1580,11 +1572,9 @@ package body Prj.Env is ...@@ -1580,11 +1572,9 @@ package body Prj.Env is
Name_Buffer (1 .. Name_Len) := Extended_Body_Name; Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
The_Body_Name := Name_Find; The_Body_Name := Name_Find;
for Current in reverse Unit_Table.First .. Unit := Units_Htable.Get_First (In_Tree.Units_HT);
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Current);
while Unit /= null loop
-- Case of a body present -- Case of a body present
if Unit.File_Names (Impl) /= null then if Unit.File_Names (Impl) /= null then
...@@ -1618,6 +1608,8 @@ package body Prj.Env is ...@@ -1618,6 +1608,8 @@ package body Prj.Env is
exit; exit;
end if; end if;
end if; end if;
Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
-- Get the ultimate extending project -- Get the ultimate extending project
......
gcc/ada/prj-nmsc.adb
...@@ -233,7 +233,6 @@ package body Prj.Nmsc is ...@@ -233,7 +233,6 @@ package body Prj.Nmsc is
Kind : Source_Kind; Kind : Source_Kind;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Display_File : File_Name_Type; Display_File : File_Name_Type;
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False; Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information; Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null; Alternate_Languages : Language_List := null;
...@@ -665,7 +664,6 @@ package body Prj.Nmsc is ...@@ -665,7 +664,6 @@ package body Prj.Nmsc is
Kind : Source_Kind; Kind : Source_Kind;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Display_File : File_Name_Type; Display_File : File_Name_Type;
Lang_Kind : Language_Kind;
Naming_Exception : Boolean := False; Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information; Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null; Alternate_Languages : Language_List := null;
...@@ -675,6 +673,7 @@ package body Prj.Nmsc is ...@@ -675,6 +673,7 @@ package body Prj.Nmsc is
Source_To_Replace : Source_Id := No_Source) Source_To_Replace : Source_Id := No_Source)
is is
Config : constant Language_Config := Lang_Id.Config; Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
begin begin
Id := new Source_Data; Id := new Source_Data;
...@@ -683,7 +682,7 @@ package body Prj.Nmsc is ...@@ -683,7 +682,7 @@ package body Prj.Nmsc is
Write_Str ("Adding source File: "); Write_Str ("Adding source File: ");
Write_Str (Get_Name_String (File_Name)); Write_Str (Get_Name_String (File_Name));
if Lang_Kind = Unit_Based then if Lang_Id.Config.Kind = Unit_Based then
Write_Str (" Unit: "); Write_Str (" Unit: ");
-- ??? in gprclean, it seems we sometimes pass an empty Unit name -- ??? in gprclean, it seems we sometimes pass an empty Unit name
-- (see test extended_projects) -- (see test extended_projects)
...@@ -699,29 +698,45 @@ package body Prj.Nmsc is ...@@ -699,29 +698,45 @@ package body Prj.Nmsc is
Id.Project := Project; Id.Project := Project;
Id.Language := Lang_Id; Id.Language := Lang_Id;
Id.Lang_Kind := Lang_Kind;
Id.Compiled := Lang_Id.Config.Compiler_Driver /=
Empty_File_Name;
Id.Kind := Kind; Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages; Id.Alternate_Languages := Alternate_Languages;
Id.Other_Part := Other_Part; Id.Other_Part := Other_Part;
Id.Object_Exists := Config.Object_Generated;
Id.Object_Linked := Config.Objects_Linked;
if Other_Part /= No_Source then if Other_Part /= No_Source then
Other_Part.Other_Part := Id; Other_Part.Other_Part := Id;
end if; 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.Index := Index;
Id.File := File_Name; Id.File := File_Name;
Id.Display_File := Display_File; Id.Display_File := Display_File;
Id.Dependency := Lang_Id.Config.Dependency_Kind; Id.Dep_Name := Dependency_Name
Id.Dep_Name := Dependency_Name (File_Name, Id.Dependency); (File_Name, Lang_Id.Config.Dependency_Kind);
Id.Naming_Exception := Naming_Exception; 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.Object := Object_Name (File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name); Id.Switches := Switches_Name (File_Name);
end if; end if;
...@@ -731,13 +746,6 @@ package body Prj.Nmsc is ...@@ -731,13 +746,6 @@ package body Prj.Nmsc is
Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id); Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id);
end if; 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 -- Add the source to the language list
Id.Next_In_Lang := Lang_Id.First_Source; Id.Next_In_Lang := Lang_Id.First_Source;
...@@ -1152,13 +1160,6 @@ package body Prj.Nmsc is ...@@ -1152,13 +1160,6 @@ package body Prj.Nmsc is
Prev_Index : Language_Ptr := No_Language_Index; Prev_Index : Language_Ptr := No_Language_Index;
-- The index of the previous language -- 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; procedure Process_Project_Level_Simple_Attributes;
-- Process the simple attributes at the project level -- Process the simple attributes at the project level
...@@ -1168,35 +1169,6 @@ package body Prj.Nmsc is ...@@ -1168,35 +1169,6 @@ package body Prj.Nmsc is
procedure Process_Packages; procedure Process_Packages;
-- Read the packages of the project -- 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 -- -- Process_Packages --
---------------------- ----------------------
...@@ -1249,7 +1221,8 @@ package body Prj.Nmsc is ...@@ -1249,7 +1221,8 @@ package body Prj.Nmsc is
-- Get the name of the language -- 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 if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
...@@ -1357,7 +1330,8 @@ package body Prj.Nmsc is ...@@ -1357,7 +1330,8 @@ package body Prj.Nmsc is
-- Get the name of the language -- 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 if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
...@@ -1698,7 +1672,8 @@ package body Prj.Nmsc is ...@@ -1698,7 +1672,8 @@ package body Prj.Nmsc is
-- Get the name of the language -- 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 if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
...@@ -2215,7 +2190,8 @@ package body Prj.Nmsc is ...@@ -2215,7 +2190,8 @@ package body Prj.Nmsc is
-- Get the name of the language -- 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 if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
...@@ -2370,8 +2346,6 @@ package body Prj.Nmsc is ...@@ -2370,8 +2346,6 @@ package body Prj.Nmsc is
Lang_Index := Project.Languages; Lang_Index := Project.Languages;
while Lang_Index /= No_Language_Index loop while Lang_Index /= No_Language_Index loop
Current_Language := Lang_Index.Display_Name;
-- For all languages, Compiler_Driver needs to be specified. This is -- For all languages, Compiler_Driver needs to be specified. This is
-- only necessary if we do intend to compiler (not in GPS for -- only necessary if we do intend to compiler (not in GPS for
-- instance) -- instance)
...@@ -2379,7 +2353,7 @@ package body Prj.Nmsc is ...@@ -2379,7 +2353,7 @@ package body Prj.Nmsc is
if Compiler_Driver_Mandatory if Compiler_Driver_Mandatory
and then Lang_Index.Config.Compiler_Driver = No_File and then Lang_Index.Config.Compiler_Driver = No_File
then then
Error_Msg_Name_1 := Current_Language; Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
...@@ -2432,7 +2406,7 @@ package body Prj.Nmsc is ...@@ -2432,7 +2406,7 @@ package body Prj.Nmsc is
if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then
Lang_Index.Config.Naming_Data.Body_Suffix = No_File Lang_Index.Config.Naming_Data.Body_Suffix = No_File
then then
Error_Msg_Name_1 := Current_Language; Error_Msg_Name_1 := Lang_Index.Display_Name;
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
...@@ -2900,8 +2874,7 @@ package body Prj.Nmsc is ...@@ -2900,8 +2874,7 @@ package body Prj.Nmsc is
Kind => Kind, Kind => Kind,
File_Name => File_Name, File_Name => File_Name,
Display_File => File_Name_Type (Element.Value), Display_File => File_Name_Type (Element.Value),
Naming_Exception => True, Naming_Exception => True);
Lang_Kind => File_Based);
else else
-- Check if the file name is already recorded for another -- Check if the file name is already recorded for another
...@@ -3011,6 +2984,8 @@ package body Prj.Nmsc is ...@@ -3011,6 +2984,8 @@ package body Prj.Nmsc is
if Unit /= No_Name then if Unit /= No_Name then
-- Check if the source already exists -- Check if the source already exists
-- ??? In Ada_Only mode (Record_Unit), we use a htable for
-- efficiency
Source_To_Replace := No_Source; Source_To_Replace := No_Source;
Iter := For_Each_Source (In_Tree); Iter := For_Each_Source (In_Tree);
...@@ -3018,7 +2993,9 @@ package body Prj.Nmsc is ...@@ -3018,7 +2993,9 @@ package body Prj.Nmsc is
loop loop
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
exit when Source = No_Source 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); Next (Iter);
end loop; end loop;
...@@ -3030,8 +3007,10 @@ package body Prj.Nmsc is ...@@ -3030,8 +3007,10 @@ package body Prj.Nmsc is
Next (Iter); Next (Iter);
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
exit when Source = No_Source or else exit when Source = No_Source
(Source.Unit = Unit and then Source.Index = Index); or else (Source.Unit /= null
and then Source.Unit.Name = Unit
and then Source.Index = Index);
end loop; end loop;
end if; end if;
...@@ -3067,7 +3046,6 @@ package body Prj.Nmsc is ...@@ -3067,7 +3046,6 @@ package body Prj.Nmsc is
Kind => Kind, Kind => Kind,
File_Name => File_Name, File_Name => File_Name,
Display_File => File_Name_Type (Element.Value.Value), Display_File => File_Name_Type (Element.Value.Value),
Lang_Kind => Unit_Based,
Other_Part => Other_Part, Other_Part => Other_Part,
Unit => Unit, Unit => Unit,
Index => Index, Index => Index,
...@@ -3426,7 +3404,7 @@ package body Prj.Nmsc is ...@@ -3426,7 +3404,7 @@ package body Prj.Nmsc is
loop loop
Src_Id := Prj.Element (Iter); Src_Id := Prj.Element (Iter);
exit when Src_Id = No_Source 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; or else Src_Id.Kind /= Spec;
Next (Iter); Next (Iter);
end loop; end loop;
...@@ -4451,8 +4429,7 @@ package body Prj.Nmsc is ...@@ -4451,8 +4429,7 @@ package body Prj.Nmsc is
Interfaces : String_List_Id := Lib_Interfaces.Values; Interfaces : String_List_Id := Lib_Interfaces.Values;
Interface_ALIs : String_List_Id := Nil_String; Interface_ALIs : String_List_Id := Nil_String;
Unit : Name_Id; Unit : Name_Id;
The_Unit_Id : Unit_Index; UData : Unit_Index;
UData : Unit_Data;
procedure Add_ALI_For (Source : File_Name_Type); procedure Add_ALI_For (Source : File_Name_Type);
-- Add an ALI file name to the list of Interface ALIs -- Add an ALI file name to the list of Interface ALIs
...@@ -4526,10 +4503,9 @@ package body Prj.Nmsc is ...@@ -4526,10 +4503,9 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
The_Unit_Id := UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
Units_Htable.Get (In_Tree.Units_HT, Unit);
if The_Unit_Id = No_Unit_Index then if UData = No_Unit_Index then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"unknown unit %%", "unknown unit %%",
...@@ -4539,12 +4515,8 @@ package body Prj.Nmsc is ...@@ -4539,12 +4515,8 @@ package body Prj.Nmsc is
else else
-- Check that the unit is part of the project -- Check that the unit is part of the project
UData := In_Tree.Units.Table (The_Unit_Id);
if UData.File_Names (Impl) /= null if UData.File_Names (Impl) /= null
and then and then UData.File_Names (Impl).Path.Name /= Slash
UData.File_Names (Impl).Path.Name /=
Slash
then then
if Check_Project if Check_Project
(UData.File_Names (Impl).Project, (UData.File_Names (Impl).Project,
...@@ -4625,8 +4597,10 @@ package body Prj.Nmsc is ...@@ -4625,8 +4597,10 @@ package body Prj.Nmsc is
Iter := For_Each_Source (In_Tree, Project); Iter := For_Each_Source (In_Tree, Project);
loop loop
while Prj.Element (Iter) /= No_Source and then while Prj.Element (Iter) /= No_Source
Prj.Element (Iter).Unit /= Unit and then
(Prj.Element (Iter).Unit = null
or else Prj.Element (Iter).Unit.Name /= Unit)
loop loop
Next (Iter); Next (Iter);
end loop; end loop;
...@@ -6928,9 +6902,9 @@ package body Prj.Nmsc is ...@@ -6928,9 +6902,9 @@ package body Prj.Nmsc is
if Source.Naming_Exception if Source.Naming_Exception
and then Source.Path = No_Path_Information and then Source.Path = No_Path_Information
then 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_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 Error_Msg
(Project, In_Tree, (Project, In_Tree,
"source file %% for unit %% not found", "source file %% for unit %% not found",
...@@ -7360,7 +7334,7 @@ package body Prj.Nmsc is ...@@ -7360,7 +7334,7 @@ package body Prj.Nmsc is
-- Check if this is a subunit -- 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 and then Name_Loc.Source.Kind = Impl
then then
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
...@@ -7411,7 +7385,8 @@ package body Prj.Nmsc is ...@@ -7411,7 +7385,8 @@ package body Prj.Nmsc is
exit when Source = No_Source; exit when Source = No_Source;
if Unit /= No_Name if Unit /= No_Name
and then Source.Unit = Unit and then Source.Unit /= No_Unit_Index
and then Source.Unit.Name = Unit
and then and then
((Source.Kind = Spec and then Kind = Impl) ((Source.Kind = Spec and then Kind = Impl)
or else or else
...@@ -7420,7 +7395,8 @@ package body Prj.Nmsc is ...@@ -7420,7 +7395,8 @@ package body Prj.Nmsc is
Other_Part := Source; Other_Part := Source;
elsif (Unit /= No_Name elsif (Unit /= No_Name
and then Source.Unit = Unit and then Source.Unit /= No_Unit_Index
and then Source.Unit.Name = Unit
and then and then
(Source.Kind = Kind (Source.Kind = Kind
or else or else
...@@ -7494,7 +7470,6 @@ package body Prj.Nmsc is ...@@ -7494,7 +7470,6 @@ package body Prj.Nmsc is
In_Tree => In_Tree, In_Tree => In_Tree,
Project => Project, Project => Project,
Lang_Id => Language, Lang_Id => Language,
Lang_Kind => Lang_Kind,
Kind => Kind, Kind => Kind,
Alternate_Languages => Alternate_Languages, Alternate_Languages => Alternate_Languages,
File_Name => File_Name, File_Name => File_Name,
...@@ -7687,18 +7662,18 @@ package body Prj.Nmsc is ...@@ -7687,18 +7662,18 @@ package body Prj.Nmsc is
(Name => Source.File, (Name => Source.File,
Location => No_Location, Location => No_Location,
Source => Source, Source => Source,
Except => Source.Unit /= No_Name, Except => Source.Unit /= No_Unit_Index,
Found => False)); Found => False));
-- If this is an Ada exception, record in table Unit_Exceptions -- 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 declare
Unit_Except : Unit_Exception := Unit_Except : Unit_Exception :=
Unit_Exceptions.Get (Source.Unit); Unit_Exceptions.Get (Source.Unit.Name);
begin begin
Unit_Except.Name := Source.Unit; Unit_Except.Name := Source.Unit.Name;
if Source.Kind = Spec then if Source.Kind = Spec then
Unit_Except.Spec := Source.File; Unit_Except.Spec := Source.File;
...@@ -7706,7 +7681,7 @@ package body Prj.Nmsc is ...@@ -7706,7 +7681,7 @@ package body Prj.Nmsc is
Unit_Except.Impl := Source.File; Unit_Except.Impl := Source.File;
end if; end if;
Unit_Exceptions.Set (Source.Unit, Unit_Except); Unit_Exceptions.Set (Source.Unit.Name, Unit_Except);
end; end;
end if; end if;
...@@ -7738,37 +7713,37 @@ package body Prj.Nmsc is ...@@ -7738,37 +7713,37 @@ package body Prj.Nmsc is
procedure Mark_Excluded_Sources is procedure Mark_Excluded_Sources is
Source : Source_Id := No_Source; Source : Source_Id := No_Source;
OK : Boolean; OK : Boolean;
Unit : Unit_Data;
Excluded : File_Found := Excluded_Sources_Htable.Get_First; Excluded : File_Found := Excluded_Sources_Htable.Get_First;
procedure Exclude
(Extended : Project_Id;
Index : Unit_Index; Index : Unit_Index;
Kind : Spec_Or_Body); begin
-- If the current file (Excluded) belongs to the current project or while Excluded /= No_File_Found loop
-- one that the current project extends, then mark this file/unit as OK := False;
-- excluded. It is an error to locally remove a file from another
-- project.
------------- -- ??? Don't we have a hash table to map files to Source_Id ?
-- Exclude -- Iter := For_Each_Source (In_Tree);
------------- loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
procedure Exclude if Source.File = Excluded.File then
(Extended : Project_Id; if Source.Project = Project
Index : Unit_Index; or else Is_Extending (Project, Source.Project)
Kind : Spec_Or_Body)
is
begin
if Extended = Project
or else Is_Extending (Project, Extended)
then then
OK := True; OK := True;
if Index /= No_Unit_Index then if Source.Unit /= No_Unit_Index then
Unit.File_Names (Kind).Path.Name := Slash; Index :=
Unit.File_Names (Kind).Naming_Exception := False; Units_Htable.Get
In_Tree.Units.Table (Index) := Unit; (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; end if;
if Source /= No_Source then if Source /= No_Source then
...@@ -7789,46 +7764,7 @@ package body Prj.Nmsc is ...@@ -7789,46 +7764,7 @@ package body Prj.Nmsc is
"cannot remove a source from another project", "cannot remove a source from another project",
Excluded.Location); Excluded.Location);
end if; 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; exit;
end if; end if;
...@@ -7836,7 +7772,6 @@ package body Prj.Nmsc is ...@@ -7836,7 +7772,6 @@ package body Prj.Nmsc is
end loop; end loop;
OK := OK or Excluded.Found; OK := OK or Excluded.Found;
end case;
if not OK then if not OK then
Err_Vars.Error_Msg_File_1 := Excluded.File; Err_Vars.Error_Msg_File_1 := Excluded.File;
...@@ -7898,10 +7833,11 @@ package body Prj.Nmsc is ...@@ -7898,10 +7833,11 @@ package body Prj.Nmsc is
Src_Id := Prj.Element (Iter); Src_Id := Prj.Element (Iter);
exit when Src_Id = No_Source; 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) and then Is_Extending (Project, Src_Id.Project)
then then
if Src_Id.Unit = No_Name then if Src_Id.Unit = No_Unit_Index then
if Src_Id.Kind = Impl then if Src_Id.Kind = Impl then
Check_Object (Src_Id); Check_Object (Src_Id);
end if; end if;
...@@ -8081,10 +8017,9 @@ package body Prj.Nmsc is ...@@ -8081,10 +8017,9 @@ package body Prj.Nmsc is
Unit_Kind : Spec_Or_Body; Unit_Kind : Spec_Or_Body;
Needs_Pragma : Boolean) Needs_Pragma : Boolean)
is 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); Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
UData : Unit_Data;
Kind : Source_Kind;
Source : Source_Id; Source : Source_Id;
To_Record : Boolean := False; To_Record : Boolean := False;
The_Location : Source_Ptr := Location; The_Location : Source_Ptr := Location;
...@@ -8101,16 +8036,13 @@ package body Prj.Nmsc is ...@@ -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 -- unit kind (spec or body), or what is in the unit list is a unit of
-- a project we are extending. -- a project we are extending.
if The_Unit /= No_Unit_Index then if UData /= No_Unit_Index then
UData := In_Tree.Units.Table (The_Unit);
if UData.File_Names (Unit_Kind) = null if UData.File_Names (Unit_Kind) = null
or else 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) and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).File = No_File
or else Is_Extending or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project)) (Project.Extends, UData.File_Names (Unit_Kind).Project)
then then
if UData.File_Names (Unit_Kind) /= null if UData.File_Names (Unit_Kind) /= null
and then UData.File_Names (Unit_Kind).Path.Name = Slash and then UData.File_Names (Unit_Kind).Path.Name = Slash
...@@ -8120,7 +8052,6 @@ package body Prj.Nmsc is ...@@ -8120,7 +8052,6 @@ package body Prj.Nmsc is
end if; end if;
To_Record := True; To_Record := True;
Source_Recorded := True;
-- If the same file is already in the list, do not add it again -- If the same file is already in the list, do not add it again
...@@ -8180,43 +8111,26 @@ package body Prj.Nmsc is ...@@ -8180,43 +8111,26 @@ package body Prj.Nmsc is
Location); Location);
else 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; To_Record := True;
end if; end if;
end if; end if;
if To_Record then if To_Record then
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); 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 Add_Source
(Id => Source, (Id => Source,
In_Tree => In_Tree, In_Tree => In_Tree,
Project => Project, Project => Project,
Lang_Id => Ada_Language, Lang_Id => Ada_Language,
Lang_Kind => Unit_Based,
File_Name => Canonical_File, File_Name => Canonical_File,
Display_File => File_Name, Display_File => File_Name,
Unit => Unit_Name, Unit => Unit_Name,
Path => (Canonical_Path, Path_Name), Path => (Canonical_Path, Path_Name),
Naming_Exception => Needs_Pragma, Naming_Exception => Needs_Pragma,
Kind => Kind, Kind => Unit_Kind,
Index => Unit_Ind, Index => Unit_Ind,
Other_Part => No_Source); -- ??? Can we find file ? Other_Part => No_Source); -- ??? Can we find file ?
Source_Recorded := True;
UData.File_Names (Unit_Kind) := Source;
In_Tree.Units.Table (The_Unit) := UData;
end if; end if;
end Record_Unit; end Record_Unit;
...@@ -8415,8 +8329,7 @@ package body Prj.Nmsc is ...@@ -8415,8 +8329,7 @@ package body Prj.Nmsc is
is is
Conv : Array_Element_Id; Conv : Array_Element_Id;
Unit : Name_Id; Unit : Name_Id;
The_Unit_Id : Unit_Index; The_Unit_Data : Unit_Index;
The_Unit_Data : Unit_Data;
Location : Source_Ptr; Location : Source_Ptr;
begin begin
...@@ -8427,14 +8340,13 @@ package body Prj.Nmsc is ...@@ -8427,14 +8340,13 @@ package body Prj.Nmsc is
Get_Name_String (Unit); Get_Name_String (Unit);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find; 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; 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); Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
else else
The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
Error_Msg_Name_2 := Error_Msg_Name_2 :=
In_Tree.Array_Elements.Table (Conv).Value.Value; In_Tree.Array_Elements.Table (Conv).Value.Value;
......
gcc/ada/prj-proc.adb
...@@ -321,9 +321,8 @@ package body Prj.Proc is ...@@ -321,9 +321,8 @@ package body Prj.Proc is
Source1 := Prj.Element (Iter); Source1 := Prj.Element (Iter);
exit when Source1 = No_Source; exit when Source1 = No_Source;
Name := Source1.Unit; if Source1.Unit /= No_Unit_Index then
Name := Source1.Unit.Name;
if Name /= No_Name then
Source2 := Unit_Htable.Get (Name); Source2 := Unit_Htable.Get (Name);
if Source2 = No_Source then if Source2 = No_Source then
......
gcc/ada/prj.adb
...@@ -149,6 +149,9 @@ package body Prj is ...@@ -149,6 +149,9 @@ package body Prj is
procedure Free_List (Languages : in out Language_List); procedure Free_List (Languages : in out Language_List);
-- Free memory allocated for the list of languages or sources -- 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 Language_Changed (Iter : in out Source_Iterator);
procedure Project_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. -- Called when a new project or language was selected for this iterator.
...@@ -638,21 +641,10 @@ package body Prj is ...@@ -638,21 +641,10 @@ package body Prj is
function Is_A_Language function Is_A_Language
(Project : Project_Id; (Project : Project_Id;
Language_Name : Name_Id) return Boolean Language_Name : Name_Id) return Boolean is
is
Lang_Ind : Language_Ptr;
begin begin
Lang_Ind := Project.Languages; return Get_Language_From_Name
while Lang_Ind /= No_Language_Index loop (Project, Get_Name_String (Language_Name)) /= null;
if Lang_Ind.Name = Language_Name then
return True;
end if;
Lang_Ind := Lang_Ind.Next;
end loop;
return False;
end Is_A_Language; end Is_A_Language;
------------------ ------------------
...@@ -860,6 +852,11 @@ package body Prj is ...@@ -860,6 +852,11 @@ package body Prj is
while Source /= No_Source loop while Source /= No_Source loop
Tmp := Source.Next_In_Lang; Tmp := Source.Next_In_Lang;
Free_List (Source.Alternate_Languages); Free_List (Source.Alternate_Languages);
if Source.Unit /= null then
Source.Unit.File_Names (Source.Kind) := null;
end if;
Unchecked_Free (Source); Unchecked_Free (Source);
Source := Tmp; Source := Tmp;
end loop; end loop;
...@@ -907,6 +904,32 @@ package body Prj is ...@@ -907,6 +904,32 @@ package body Prj is
end loop; end loop;
end Free_List; 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 -- -- Free --
---------- ----------
...@@ -923,12 +946,11 @@ package body Prj is ...@@ -923,12 +946,11 @@ package body Prj is
Array_Element_Table.Free (Tree.Array_Elements); Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays); Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages); Package_Table.Free (Tree.Packages);
Unit_Table.Free (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True); Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part -- Private part
...@@ -961,12 +983,11 @@ package body Prj is ...@@ -961,12 +983,11 @@ package body Prj is
Array_Element_Table.Init (Tree.Array_Elements); Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays); Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages); Package_Table.Init (Tree.Packages);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
Free_List (Tree.Projects, Free_Project => True); Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Private part table -- Private part table
...@@ -1427,6 +1448,42 @@ package body Prj is ...@@ -1427,6 +1448,42 @@ package body Prj is
For_All_Projects (Project, Dummy); For_All_Projects (Project, Dummy);
end Compute_All_Imported_Projects; 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 begin
-- Make sure that the standard config and user project file extensions are -- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming. -- compatible with canonical case file naming.
......
gcc/ada/prj.ads
...@@ -307,6 +307,11 @@ package Prj is ...@@ -307,6 +307,11 @@ package Prj is
No_Language_Index : constant Language_Ptr := null; No_Language_Index : constant Language_Ptr := null;
-- Constant indicating that there is no language data -- 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; Max_Header_Num : constant := 6150;
type Header_Num is range 0 .. Max_Header_Num; type Header_Num is range 0 .. Max_Header_Num;
-- Size for hash table below. The upper bound is an arbitrary value, the -- Size for hash table below. The upper bound is an arbitrary value, the
...@@ -392,6 +397,11 @@ package Prj is ...@@ -392,6 +397,11 @@ package Prj is
type Source_Data; type Source_Data;
type Source_Id is access all 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; No_Source : constant Source_Id := null;
type Path_Syntax_Kind is type Path_Syntax_Kind is
...@@ -615,6 +625,17 @@ package Prj is ...@@ -615,6 +625,17 @@ package Prj is
end record; end record;
type Source_Kind is (Spec, Impl, Sep); 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 type Source_Data is record
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
...@@ -624,13 +645,6 @@ package Prj is ...@@ -624,13 +645,6 @@ package Prj is
-- Index of the language. This is an index into -- Index of the language. This is an index into
-- Project_Tree.Languages_Data. -- 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; In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute -- False when the source is not included in interfaces, when attribute
-- Interfaces is declared. -- Interfaces is declared.
...@@ -645,14 +659,11 @@ package Prj is ...@@ -645,14 +659,11 @@ package Prj is
Kind : Source_Kind := Spec; Kind : Source_Kind := Spec;
-- Kind of the source: spec, body or subunit -- 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; Other_Part : Source_Id := No_Source;
-- Source ID for the other part, if any: for a spec, indicates its body; -- Source ID for the other part, if any: for a spec, indicates its body;
-- for a body, indicates its spec. -- 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 -- Name of the unit, if language is unit based
Index : Int := 0; Index : Int := 0;
...@@ -686,13 +697,6 @@ package Prj is ...@@ -686,13 +697,6 @@ package Prj is
-- Project where the object file is. This might be different from -- Project where the object file is. This might be different from
-- Project when using extending project files. -- 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; Object : File_Name_Type := No_File;
-- File name of the object file -- File name of the object file
...@@ -737,15 +741,12 @@ package Prj is ...@@ -737,15 +741,12 @@ package Prj is
No_Source_Data : constant Source_Data := No_Source_Data : constant Source_Data :=
(Project => No_Project, (Project => No_Project,
Language => No_Language_Index, Language => No_Language_Index,
Lang_Kind => File_Based,
Compiled => True,
In_Interfaces => True, In_Interfaces => True,
Declared_In_Interfaces => False, Declared_In_Interfaces => False,
Alternate_Languages => null, Alternate_Languages => null,
Kind => Spec, Kind => Spec,
Dependency => None,
Other_Part => No_Source, Other_Part => No_Source,
Unit => No_Name, Unit => No_Unit_Index,
Index => 0, Index => 0,
Locally_Removed => False, Locally_Removed => False,
Get_Object => False, Get_Object => False,
...@@ -755,8 +756,6 @@ package Prj is ...@@ -755,8 +756,6 @@ package Prj is
Path => No_Path_Information, Path => No_Path_Information,
Source_TS => Empty_Time_Stamp, Source_TS => Empty_Time_Stamp,
Object_Project => No_Project, Object_Project => No_Project,
Object_Exists => True,
Object_Linked => True,
Object => No_File, Object => No_File,
Current_Object_Path => No_Path, Current_Object_Path => No_Path,
Object_Path => No_Path, Object_Path => No_Path,
...@@ -1345,25 +1344,6 @@ package Prj is ...@@ -1345,25 +1344,6 @@ package Prj is
Project_Error : exception; Project_Error : exception;
-- Raised by some subprograms in Prj.Attr -- 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 package Units_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Unit_Index, Element => Unit_Index,
...@@ -1417,7 +1397,6 @@ package Prj is ...@@ -1417,7 +1397,6 @@ package Prj is
Arrays : Array_Table.Instance; Arrays : Array_Table.Instance;
Packages : Package_Table.Instance; Packages : Package_Table.Instance;
Projects : Project_List; Projects : Project_List;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance; Units_HT : Units_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance;
Unit_Sources_HT : Unit_Sources_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