Skip to content

R
riscv-gcc-1
Commit 852dba80 by Arnaud Charlet
Options

[multiple changes] 

2009-06-24  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are
	visible through limited-with context clauses. In addition, avoid an
	extra tag check that is not required when the class-wide
	designated types of the operand and target types are
	the same entity.
	(Tagged_Membership): Handle entities from the limited view.

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

	* gnatcmd.adb, make.adb, mlib-prj.adb, prj.ads, clean.adb,
	prj-nmsc.adb, prj-env.adb (File_Name_Data): removed
	(Spec_Or_Body): now a subtype of Source_Kind, to avoid using two
	different vocabularies for similar concepts (Impl/Body_Part and
	Spec/Specification).
	(Unit_Data): now points directly to a Source_Id, rather than duplicating
	some of the information in File_Name_Data. This also saves a bit of
	memory. However, since we are now using a pointer we need to test
	for null explicitly in several places of the code

From-SVN: r148900
parent 950d217a
Showing with 340 additions and 306 deletions
gcc/ada/ChangeLog
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
visible through limited-with context clauses. In addition, avoid an
extra tag check that is not required when the class-wide
designated types of the operand and target types are
the same entity.
(Tagged_Membership): Handle entities from the limited view.
2009-06-24 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.ads, clean.adb,
prj-nmsc.adb, prj-env.adb (File_Name_Data): removed
(Spec_Or_Body): now a subtype of Source_Kind, to avoid using two
different vocabularies for similar concepts (Impl/Body_Part and
Spec/Specification).
(Unit_Data): now points directly to a Source_Id, rather than duplicating
some of the information in File_Name_Data. This also saves a bit of
memory. However, since we are now using a pointer we need to test
for null explicitly in several places of the code
2009-06-24 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): return immediately * exp_ch4.adb (Expand_N_Type_Conversion): return immediately
from processing the type conversion when the node is from processing the type conversion when the node is
replaced by an N_Raise_Program_Error node. replaced by an N_Raise_Program_Error node.
......
gcc/ada/clean.adb
...@@ -577,22 +577,23 @@ package body Clean is ...@@ -577,22 +577,23 @@ package body Clean is
loop loop
Unit := Project_Tree.Units.Table (Index); Unit := Project_Tree.Units.Table (Index);
if Ultimate_Extending_Project_Of if Unit.File_Names (Impl) /= null
(Unit.File_Names (Body_Part).Project) = Project and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = Project
and then and then
Get_Name_String Get_Name_String (Unit.File_Names (Impl).File)
(Unit.File_Names (Body_Part).Name) = = Name (1 .. Last)
Name (1 .. Last)
then then
Delete_File := True; Delete_File := True;
exit; exit;
end if; end if;
if Ultimate_Extending_Project_Of if Unit.File_Names (Spec) /= null
(Unit.File_Names (Specification).Project) = Project and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) = Project
and then and then
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Name) = (Unit.File_Names (Spec).File) =
Name (1 .. Last) Name (1 .. Last)
then then
Delete_File := True; Delete_File := True;
...@@ -741,15 +742,16 @@ package body Clean is ...@@ -741,15 +742,16 @@ package body Clean is
loop loop
Unit := Project_Tree.Units.Table (Index); Unit := Project_Tree.Units.Table (Index);
if Unit.File_Names (Body_Part).Project /= if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
No_Project No_Project
then then
if Ultimate_Extending_Project_Of if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) = (Unit.File_Names (Impl).Project) =
Project Project
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Impl).File);
Name_Len := Name_Len - Name_Len := Name_Len -
File_Extension File_Extension
(Name (1 .. Name_Len))'Length; (Name (1 .. Name_Len))'Length;
...@@ -761,12 +763,13 @@ package body Clean is ...@@ -761,12 +763,13 @@ package body Clean is
end if; end if;
end if; end if;
elsif Ultimate_Extending_Project_Of elsif Unit.File_Names (Spec) /= null
(Unit.File_Names (Specification).Project) = and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) =
Project Project
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Name); (Unit.File_Names (Spec).File);
Name_Len := Name_Len - Name_Len := Name_Len -
File_Extension File_Extension
(Name (1 .. Name_Len))'Length; (Name (1 .. Name_Len))'Length;
...@@ -887,16 +890,33 @@ package body Clean is ...@@ -887,16 +890,33 @@ 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 In_Extension_Chain if (U_Data.File_Names (Impl) /= null
(U_Data.File_Names (Body_Part).Project, Project) and then
In_Extension_Chain
(U_Data.File_Names (Impl).Project, Project))
or else or else
In_Extension_Chain (U_Data.File_Names (Spec) /= null
(U_Data.File_Names (Specification).Project, Project) and then In_Extension_Chain
(U_Data.File_Names
(Spec).Project, Project))
then then
File_Name1 := U_Data.File_Names (Body_Part).Name; if U_Data.File_Names (Impl) /= null then
Index1 := U_Data.File_Names (Body_Part).Index; File_Name1 := U_Data.File_Names (Impl).File;
File_Name2 := U_Data.File_Names (Specification).Name; Index1 := U_Data.File_Names (Impl).Index;
Index2 := U_Data.File_Names (Specification).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;
else
File_Name2 := No_File;
Index2 := 0;
end if;
-- If there is no body file name, then there may be -- If there is no body file name, then there may be
-- only a spec. -- only a spec.
......
gcc/ada/exp_ch4.adb
...@@ -7955,9 +7955,13 @@ package body Exp_Ch4 is ...@@ -7955,9 +7955,13 @@ package body Exp_Ch4 is
begin begin
if Is_Access_Type (Target_Type) then if Is_Access_Type (Target_Type) then
Actual_Op_Typ := Designated_Type (Operand_Type);
Actual_Targ_Typ := Designated_Type (Target_Type);
-- Handle entities from the limited view
Actual_Op_Typ :=
Available_View (Designated_Type (Operand_Type));
Actual_Targ_Typ :=
Available_View (Designated_Type (Target_Type));
else else
Actual_Op_Typ := Operand_Type; Actual_Op_Typ := Operand_Type;
Actual_Targ_Typ := Target_Type; Actual_Targ_Typ := Target_Type;
...@@ -7978,6 +7982,7 @@ package body Exp_Ch4 is ...@@ -7978,6 +7982,7 @@ package body Exp_Ch4 is
-- conversion. -- conversion.
if Is_Class_Wide_Type (Actual_Op_Typ) if Is_Class_Wide_Type (Actual_Op_Typ)
and then Actual_Op_Typ /= Actual_Targ_Typ
and then Root_Op_Typ /= Actual_Targ_Typ and then Root_Op_Typ /= Actual_Targ_Typ
and then Is_Ancestor (Root_Op_Typ, Actual_Targ_Typ) and then Is_Ancestor (Root_Op_Typ, Actual_Targ_Typ)
then then
...@@ -9486,8 +9491,10 @@ package body Exp_Ch4 is ...@@ -9486,8 +9491,10 @@ package body Exp_Ch4 is
Obj_Tag : Node_Id; Obj_Tag : Node_Id;
begin begin
Left_Type := Etype (Left); -- Handle entities from the limited view
Right_Type := Etype (Right);
Left_Type := Available_View (Etype (Left));
Right_Type := Available_View (Etype (Right));
if Is_Class_Wide_Type (Left_Type) then if Is_Class_Wide_Type (Left_Type) then
Left_Type := Root_Type (Left_Type); Left_Type := Root_Type (Left_Type);
......
gcc/ada/gnatcmd.adb
...@@ -418,21 +418,18 @@ procedure GNATCmd is ...@@ -418,21 +418,18 @@ procedure GNATCmd is
-- spec, but not the subunits. -- spec, but not the subunits.
if The_Command = List then if The_Command = List then
if if Unit_Data.File_Names (Impl) /= null
Unit_Data.File_Names (Body_Part).Name /= No_File and then Unit_Data.File_Names (Impl).Path.Name /= Slash
and then
Unit_Data.File_Names (Body_Part).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 (Body_Part).Project = Project Unit_Data.File_Names (Impl).Project = Project
then then
Subunit := False; Subunit := False;
if Unit_Data.File_Names (Specification).Name = No_File if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names or else Unit_Data.File_Names (Spec).Path.Name = Slash
(Specification).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
...@@ -443,7 +440,7 @@ procedure GNATCmd is ...@@ -443,7 +440,7 @@ procedure GNATCmd is
Sinput.P.Load_Project_File Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit_Data.File_Names
(Body_Part).Path.Name)); (Impl).Path.Name));
begin begin
Subunit := Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind); Sinput.P.Source_File_Is_Subunit (Src_Ind);
...@@ -456,27 +453,25 @@ procedure GNATCmd is ...@@ -456,27 +453,25 @@ procedure GNATCmd is
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit_Data.File_Names
(Body_Part).Display_Name)); (Impl).Display_File));
end if; end if;
end if; end if;
elsif elsif Unit_Data.File_Names (Spec) /= null
Unit_Data.File_Names (Specification).Name /= No_File and then Unit_Data.File_Names (Spec).Path.Name /= Slash
and then
Unit_Data.File_Names (Specification).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 (Specification).Project = Project Unit_Data.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_Data.File_Names
(Specification).Display_Name)); (Spec).Display_File));
end if; end if;
end if; end if;
...@@ -486,21 +481,19 @@ procedure GNATCmd is ...@@ -486,21 +481,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 (Body_Part).Name /= No_File if Unit_Data.File_Names (Impl) /= null
and then and then Unit_Data.File_Names (Impl).Path.Name /= Slash
Unit_Data.File_Names (Body_Part).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 (Body_Part).Project, Project) (Unit_Data.File_Names (Impl).Project, Project)
then then
Subunit := False; Subunit := False;
if Unit_Data.File_Names (Specification).Name = No_File if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names or else Unit_Data.File_Names (Spec).Path.Name = Slash
(Specification).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
...@@ -511,7 +504,7 @@ procedure GNATCmd is ...@@ -511,7 +504,7 @@ procedure GNATCmd is
Sinput.P.Load_Project_File Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit_Data.File_Names
(Body_Part).Path.Name)); (Impl).Path.Name));
begin begin
Subunit := Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind); Sinput.P.Source_File_Is_Subunit (Src_Ind);
...@@ -524,40 +517,37 @@ procedure GNATCmd is ...@@ -524,40 +517,37 @@ procedure GNATCmd is
new String' new String'
(Get_Name_String (Get_Name_String
(Unit_Data.File_Names (Unit_Data.File_Names
(Body_Part).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_Data.File_Names
(Body_Part).Display_Name), (Impl).Display_File),
"ci")); "ci"));
end if; end if;
end if; end if;
elsif Unit_Data.File_Names (Specification).Name /= No_File elsif Unit_Data.File_Names (Spec) /= null
and then and then Unit_Data.File_Names (Spec).Path.Name /= Slash
Unit_Data.File_Names (Specification).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 (Specification).Project, (Unit_Data.File_Names (Spec).Project, 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_Data.File_Names
(Specification).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 (Unit_Data.File_Names (Spec).File),
(Specification).Name),
"ci")); "ci"));
end if; end if;
end if; end if;
...@@ -568,14 +558,13 @@ procedure GNATCmd is ...@@ -568,14 +558,13 @@ procedure GNATCmd is
-- specified. -- specified.
for Kind in Spec_Or_Body loop for Kind in Spec_Or_Body loop
if Check_Project if Unit_Data.File_Names (Kind) /= null
(Unit_Data.File_Names (Kind).Project, Project) and then Check_Project
and then Unit_Data.File_Names (Kind).Name /= No_File (Unit_Data.File_Names (Kind).Project, Project)
and then Unit_Data.File_Names (Kind).Path.Name /= Slash and then Unit_Data.File_Names (Kind).Path.Name /= Slash
then then
Get_Name_String Get_Name_String
(Unit_Data.File_Names (Unit_Data.File_Names (Kind).Path.Display_Name);
(Kind).Path.Display_Name);
if FD /= Invalid_FD then if FD /= Invalid_FD then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -833,20 +822,20 @@ procedure GNATCmd is ...@@ -833,20 +822,20 @@ procedure GNATCmd is
loop loop
Udata := Project_Tree.Units.Table (Unit); Udata := Project_Tree.Units.Table (Unit);
if Udata.File_Names (Specification).Name /= No_File if Udata.File_Names (Spec) /= null
and then and then
Get_Name_String (Udata.File_Names (Specification).Name) = Get_Name_String (Udata.File_Names (Spec).File) =
Line (1 .. Last) Line (1 .. Last)
then then
Path := Udata.File_Names (Specification).Path.Name; Path := Udata.File_Names (Spec).Path.Name;
exit; exit;
elsif Udata.File_Names (Body_Part).Name /= No_File elsif Udata.File_Names (Impl) /= null
and then and then
Get_Name_String (Udata.File_Names (Body_Part).Name) = Get_Name_String (Udata.File_Names (Impl).File) =
Line (1 .. Last) Line (1 .. Last)
then then
Path := Udata.File_Names (Body_Part).Path.Name; Path := Udata.File_Names (Impl).Path.Name;
exit; exit;
end if; end if;
end loop; end loop;
......
gcc/ada/make.adb
...@@ -1473,8 +1473,11 @@ package body Make is ...@@ -1473,8 +1473,11 @@ package body Make is
if UID /= Prj.No_Unit_Index then if UID /= Prj.No_Unit_Index then
U_Data := Project_Tree.Units.Table (UID); U_Data := Project_Tree.Units.Table (UID);
if U_Data.File_Names (Body_Part).Name /= Sfile if (U_Data.File_Names (Impl) = null
and then U_Data.File_Names (Specification).Name /= Sfile or else U_Data.File_Names (Impl).File /= Sfile)
and then
(U_Data.File_Names (Spec) = null
or else U_Data.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;
...@@ -1945,15 +1948,18 @@ package body Make is ...@@ -1945,15 +1948,18 @@ package body Make is
for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop
Udata := Project_Tree.Units.Table (U); Udata := Project_Tree.Units.Table (U);
if Udata.File_Names (Body_Part).Name = Source_File then if Udata.File_Names (Impl) /= null
ALI_Project := Udata.File_Names (Body_Part).Project; and then Udata.File_Names (Impl).File = Source_File
then
ALI_Project := Udata.File_Names (Impl).Project;
exit; exit;
elsif elsif Udata.File_Names (Spec) /= null
Udata.File_Names (Specification).Name = Source_File and then Udata.File_Names (Spec).File =
Source_File
then then
ALI_Project := ALI_Project :=
Udata.File_Names (Specification).Project; Udata.File_Names (Spec).Project;
exit; exit;
end if; end if;
end loop; end loop;
...@@ -2053,16 +2059,20 @@ package body Make is ...@@ -2053,16 +2059,20 @@ package body Make is
UID in 1 .. Unit_Table.Last (Project_Tree.Units) UID in 1 .. Unit_Table.Last (Project_Tree.Units)
loop loop
if Project_Tree.Units.Table (UID). if Project_Tree.Units.Table (UID).
File_Names (Body_Part).Name = Dep.Sfile 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 := Project_Tree.Units.Table (UID).
File_Names (Body_Part).Project; File_Names (Impl).Project;
elsif Project_Tree.Units.Table (UID). elsif Project_Tree.Units.Table (UID).
File_Names (Specification).Name = Dep.Sfile File_Names (Spec) /= null
and then Project_Tree.Units.Table (UID).
File_Names (Spec).File = Dep.Sfile
then then
Proj := Project_Tree.Units.Table (UID). Proj := Project_Tree.Units.Table (UID).
File_Names (Specification).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
...@@ -3608,28 +3618,24 @@ package body Make is ...@@ -3608,28 +3618,24 @@ package body Make is
if Uid /= Prj.No_Unit_Index then if Uid /= Prj.No_Unit_Index then
Udata := Project_Tree.Units.Table (Uid); Udata := Project_Tree.Units.Table (Uid);
if if Udata.File_Names (Impl) /= null
Udata.File_Names (Body_Part).Name /=
No_File
and then and then
Udata.File_Names (Body_Part).Path.Name /= Udata.File_Names (Impl).Path.Name /=
Slash Slash
then then
Sfile := Udata.File_Names (Body_Part).Name; Sfile := Udata.File_Names (Impl).File;
Source_Index := Source_Index :=
Udata.File_Names (Body_Part).Index; Udata.File_Names (Impl).Index;
elsif elsif Udata.File_Names (Spec) /= null
Udata.File_Names (Specification).Name /=
No_File
and then and then
Udata.File_Names Udata.File_Names
(Specification).Path.Name /= Slash (Spec).Path.Name /= Slash
then then
Sfile := Sfile :=
Udata.File_Names (Specification).Name; Udata.File_Names (Spec).File;
Source_Index := Source_Index :=
Udata.File_Names (Specification).Index; Udata.File_Names (Spec).Index;
end if; end if;
end if; end if;
end; end;
...@@ -4400,8 +4406,8 @@ package body Make is ...@@ -4400,8 +4406,8 @@ package body Make is
-- If there is a body, put it in the mapping -- If there is a body, put it in the mapping
if Unit.File_Names (Body_Part).Name /= No_File if Unit.File_Names (Impl) /= No_Source
and then Unit.File_Names (Body_Part).Project /= and then Unit.File_Names (Impl).Project /=
No_Project No_Project
then then
Get_Name_String (Unit.Name); Get_Name_String (Unit.Name);
...@@ -4409,14 +4415,14 @@ package body Make is ...@@ -4409,14 +4415,14 @@ package body Make is
ALI_Unit := Name_Find; ALI_Unit := Name_Find;
ALI_Name := ALI_Name :=
Lib_File_Name Lib_File_Name
(Unit.File_Names (Body_Part).Display_Name); (Unit.File_Names (Impl).Display_File);
ALI_Project := Unit.File_Names (Body_Part).Project; ALI_Project := Unit.File_Names (Impl).Project;
-- Otherwise, if there is a spec, put it in the -- Otherwise, if there is a spec, put it in the
-- mapping. -- mapping.
elsif Unit.File_Names (Specification).Name /= No_File elsif Unit.File_Names (Spec) /= No_Source
and then Unit.File_Names (Specification).Project /= and then Unit.File_Names (Spec).Project /=
No_Project No_Project
then then
Get_Name_String (Unit.Name); Get_Name_String (Unit.Name);
...@@ -4424,8 +4430,8 @@ package body Make is ...@@ -4424,8 +4430,8 @@ package body Make is
ALI_Unit := Name_Find; ALI_Unit := Name_Find;
ALI_Name := ALI_Name :=
Lib_File_Name Lib_File_Name
(Unit.File_Names (Specification).Display_Name); (Unit.File_Names (Spec).Display_File);
ALI_Project := Unit.File_Names (Specification).Project; ALI_Project := Unit.File_Names (Spec).Project;
else else
ALI_Name := No_File; ALI_Name := No_File;
...@@ -7014,17 +7020,17 @@ package body Make is ...@@ -7014,17 +7020,17 @@ package body Make is
-- If there is a source for the body, and the body has not been -- If there is a source for the body, and the body has not been
-- locally removed. -- locally removed.
if Unit.File_Names (Body_Part).Name /= No_File if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Body_Part).Path.Name /= Slash and then Unit.File_Names (Impl).Path.Name /= Slash
then then
-- And it is a source for the specified project -- And it is a source for the specified project
if Check_Project (Unit.File_Names (Body_Part).Project) then if Check_Project (Unit.File_Names (Impl).Project) then
-- If we don't have a spec, we cannot consider the source -- If we don't have a spec, we cannot consider the source
-- if it is a subunit. -- if it is a subunit.
if Unit.File_Names (Specification).Name = No_File then if Unit.File_Names (Spec) = null then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
...@@ -7042,7 +7048,7 @@ package body Make is ...@@ -7042,7 +7048,7 @@ package body Make is
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit.File_Names (Body_Part).Path.Name)); (Unit.File_Names (Impl).Path.Name));
-- If it is a subunit, discard it -- If it is a subunit, discard it
...@@ -7050,27 +7056,27 @@ package body Make is ...@@ -7050,27 +7056,27 @@ package body Make is
Sfile := No_File; Sfile := No_File;
Index := 0; Index := 0;
else else
Sfile := Unit.File_Names (Body_Part).Display_Name; Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Body_Part).Index; Index := Unit.File_Names (Impl).Index;
end if; end if;
end; end;
else else
Sfile := Unit.File_Names (Body_Part).Display_Name; Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Body_Part).Index; Index := Unit.File_Names (Impl).Index;
end if; end if;
end if; end if;
elsif Unit.File_Names (Specification).Name /= No_File elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Specification).Path.Name /= Slash and then Unit.File_Names (Spec).Path.Name /= Slash
and then Check_Project (Unit.File_Names (Specification).Project) and then Check_Project (Unit.File_Names (Spec).Project)
then then
-- If there is no source for the body, but there is a source -- If there is no source for the body, but there is a source
-- for the spec which has not been locally removed, then we take -- for the spec which has not been locally removed, then we take
-- this one. -- this one.
Sfile := Unit.File_Names (Specification).Display_Name; Sfile := Unit.File_Names (Spec).Display_File;
Index := Unit.File_Names (Specification).Index; Index := Unit.File_Names (Spec).Index;
end if; end if;
-- If Put_In_Q is True, we insert into the Q -- If Put_In_Q is True, we insert into the Q
......
gcc/ada/mlib-prj.adb
...@@ -948,21 +948,20 @@ package body MLib.Prj is ...@@ -948,21 +948,20 @@ package body MLib.Prj is
loop loop
Unit := In_Tree.Units.Table (Source); Unit := In_Tree.Units.Table (Source);
if Unit.File_Names (Body_Part).Name /= No_File if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Body_Part).Path.Name /= Slash and then Unit.File_Names (Impl).Path.Name /= Slash
then then
if if
Check_Project (Unit.File_Names (Body_Part).Project) Check_Project (Unit.File_Names (Impl).Project)
then then
if Unit.File_Names (Specification).Name = No_File then if Unit.File_Names (Spec) = null then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
begin begin
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(Unit.File_Names (Unit.File_Names (Impl).Path.Name));
(Body_Part).Path.Name));
-- Add the ALI file only if it is not a subunit -- Add the ALI file only if it is not a subunit
...@@ -970,23 +969,23 @@ package body MLib.Prj is ...@@ -970,23 +969,23 @@ package body MLib.Prj is
Sinput.P.Source_File_Is_Subunit (Src_Ind) Sinput.P.Source_File_Is_Subunit (Src_Ind)
then then
Add_ALI_For Add_ALI_For
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Impl).File);
exit when not Bind; exit when not Bind;
end if; end if;
end; end;
else else
Add_ALI_For (Unit.File_Names (Body_Part).Name); Add_ALI_For (Unit.File_Names (Impl).File);
exit when not Bind; exit when not Bind;
end if; end if;
end if; end if;
elsif Unit.File_Names (Specification).Name /= No_File elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Specification).Path.Name /= Slash and then Unit.File_Names (Spec).Path.Name /= Slash
and then Check_Project and then Check_Project
(Unit.File_Names (Specification).Project) (Unit.File_Names (Spec).Project)
then then
Add_ALI_For (Unit.File_Names (Specification).Name); Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind; exit when not Bind;
end if; end if;
end loop; end loop;
...@@ -1424,30 +1423,29 @@ package body MLib.Prj is ...@@ -1424,30 +1423,29 @@ package body MLib.Prj is
loop loop
if In_Tree.Units.Table if In_Tree.Units.Table
(Index).File_Names (Index).File_Names
(Body_Part).Name /= No_File (Impl) /= null
then then
Proj := Proj :=
In_Tree.Units.Table (Index). In_Tree.Units.Table (Index).
File_Names File_Names
(Body_Part).Project; (Impl).Project;
Fname := Fname :=
In_Tree.Units.Table (Index). In_Tree.Units.Table (Index).
File_Names (Body_Part).Name; File_Names (Impl).File;
elsif elsif
In_Tree.Units.Table In_Tree.Units.Table
(Index).File_Names (Index).File_Names
(Specification).Name /= (Spec) /= null
No_File
then then
Proj := Proj :=
In_Tree.Units.Table In_Tree.Units.Table
(Index).File_Names (Index).File_Names
(Specification).Project; (Spec).Project;
Fname := Fname :=
In_Tree.Units.Table In_Tree.Units.Table
(Index).File_Names (Index).File_Names
(Specification).Name; (Spec).File;
else else
Proj := No_Project; Proj := No_Project;
...@@ -1842,15 +1840,16 @@ package body MLib.Prj is ...@@ -1842,15 +1840,16 @@ package body MLib.Prj is
loop loop
Unit := In_Tree.Units.Table (Index); Unit := In_Tree.Units.Table (Index);
if Unit.File_Names (Body_Part).Project /= if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
No_Project No_Project
then then
if Ultimate_Extending_Project_Of if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) = (Unit.File_Names (Impl).Project) =
For_Project For_Project
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Impl).File);
Name_Len := Name_Len - Name_Len := Name_Len -
File_Extension File_Extension
(Name (1 .. Name_Len))'Length; (Name (1 .. Name_Len))'Length;
...@@ -1862,12 +1861,13 @@ package body MLib.Prj is ...@@ -1862,12 +1861,13 @@ package body MLib.Prj is
end if; end if;
end if; end if;
elsif Ultimate_Extending_Project_Of elsif Unit.File_Names (Spec) /= null
(Unit.File_Names (Specification).Project) = and then Ultimate_Extending_Project_Of
For_Project (Unit.File_Names (Spec).Project) =
For_Project
then then
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Name); (Unit.File_Names (Spec).File);
Name_Len := Name_Len :=
Name_Len - Name_Len -
File_Extension File_Extension
...@@ -1983,23 +1983,25 @@ package body MLib.Prj is ...@@ -1983,23 +1983,25 @@ package body MLib.Prj is
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index); Unit := In_Tree.Units.Table (Index);
if Ultimate_Extending_Project_Of if Unit.File_Names (Impl) /= null
(Unit.File_Names (Body_Part).Project) = For_Project and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = For_Project
and then and then
Get_Name_String Get_Name_String
(Unit.File_Names (Body_Part).Name) = (Unit.File_Names (Impl).File) =
Name (1 .. Last) Name (1 .. Last)
then then
Delete := True; Delete := True;
exit; exit;
end if; end if;
if Ultimate_Extending_Project_Of if Unit.File_Names (Spec) /= null
(Unit.File_Names (Specification).Project) = and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) =
For_Project For_Project
and then and then
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Name) = (Unit.File_Names (Spec).File) =
Name (1 .. Last) Name (1 .. Last)
then then
Delete := True; Delete := True;
...@@ -2193,9 +2195,10 @@ package body MLib.Prj is ...@@ -2193,9 +2195,10 @@ package body MLib.Prj is
-- 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
if Is_Same_Or_Extension if Data.File_Names (J) /= null
(For_Project, Data.File_Names (J).Project) and then Is_Same_Or_Extension
and then Data.File_Names (J).Name = File_Name (For_Project, Data.File_Names (J).Project)
and then Data.File_Names (J).File = File_Name
then then
Copy_File Copy_File
(Get_Name_String (Data.File_Names (J).Path.Name), (Get_Name_String (Data.File_Names (J).Path.Name),
......
gcc/ada/prj-env.adb
...@@ -598,7 +598,7 @@ package body Prj.Env is ...@@ -598,7 +598,7 @@ package body Prj.Env is
Put (File, "pragma Source_File_Name_Project ("); Put (File, "pragma Source_File_Name_Project (");
Put (File, Namet.Get_Name_String (Unit_Name)); Put (File, Namet.Get_Name_String (Unit_Name));
if Unit_Kind = Specification then if Unit_Kind = Spec then
Put (File, ", Spec_File_Name => """); Put (File, ", Spec_File_Name => """);
else else
Put (File, ", Body_File_Name => """); Put (File, ", Body_File_Name => """);
...@@ -681,18 +681,22 @@ package body Prj.Env is ...@@ -681,18 +681,22 @@ package body Prj.Env is
In_Tree.Units.Table (Current_Unit); In_Tree.Units.Table (Current_Unit);
begin begin
if Unit.File_Names (Specification).Needs_Pragma then if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Naming_Exception
then
Put (Unit.Name, Put (Unit.Name,
Unit.File_Names (Specification).Name, Unit.File_Names (Spec).File,
Specification, Spec,
Unit.File_Names (Specification).Index); Unit.File_Names (Spec).Index);
end if; end if;
if Unit.File_Names (Body_Part).Needs_Pragma then if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Naming_Exception
then
Put (Unit.Name, Put (Unit.Name,
Unit.File_Names (Body_Part).Name, Unit.File_Names (Impl).File,
Body_Part, Impl,
Unit.File_Names (Body_Part).Index); Unit.File_Names (Impl).Index);
end if; end if;
Current_Unit := Current_Unit + 1; Current_Unit := Current_Unit + 1;
...@@ -743,7 +747,7 @@ package body Prj.Env is ...@@ -743,7 +747,7 @@ 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; The_Unit_Data : Unit_Data;
Data : File_Name_Data; Data : Source_Id;
begin begin
Fmap.Reset_Tables; Fmap.Reset_Tables;
...@@ -754,32 +758,32 @@ package body Prj.Env is ...@@ -754,32 +758,32 @@ package body Prj.Env is
-- 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 The_Unit_Data.Name /= No_Name then
Data := The_Unit_Data.File_Names (Specification); Data := The_Unit_Data.File_Names (Spec);
-- If there is a spec, put it in the mapping -- If there is a spec, put it in the mapping
if Data.Name /= No_File then if Data /= null then
if Data.Path.Name = Slash then if Data.Path.Name = Slash then
Fmap.Add_Forbidden_File_Name (Data.Name); 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 (The_Unit_Data.Name),
File_Name => Data.Name, 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 (Body_Part); Data := The_Unit_Data.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
if Data.Name /= No_File then if Data /= null then
if Data.Path.Name = Slash then if Data.Path.Name = Slash then
Fmap.Add_Forbidden_File_Name (Data.Name); 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 (The_Unit_Data.Name),
File_Name => Data.Name, 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;
...@@ -807,7 +811,7 @@ package body Prj.Env is ...@@ -807,7 +811,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; The_Unit_Data : Unit_Data;
Data : File_Name_Data; Data : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
procedure Put_Name_Buffer; procedure Put_Name_Buffer;
...@@ -861,7 +865,7 @@ package body Prj.Env is ...@@ -861,7 +865,7 @@ package body Prj.Env is
-- Line with the file name -- Line with the file name
Get_Name_String (Data.Name); Get_Name_String (Data.File);
Put_Name_Buffer; Put_Name_Buffer;
-- Line with the path name -- Line with the path name
...@@ -928,23 +932,23 @@ package body Prj.Env is ...@@ -928,23 +932,23 @@ package body Prj.Env is
-- Case of unit has a valid name -- Case of unit has a valid name
if The_Unit_Data.Name /= No_Name then if The_Unit_Data.Name /= No_Name then
Data := The_Unit_Data.File_Names (Specification); Data := The_Unit_Data.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.
if Data.Name /= No_File if Data /= No_Source
and then Project_Boolean_Htable.Get (Present, Data.Project) and then Project_Boolean_Htable.Get (Present, Data.Project)
then then
Put_Data (Spec => True); Put_Data (Spec => True);
end if; end if;
Data := The_Unit_Data.File_Names (Body_Part); Data := The_Unit_Data.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.
if Data.Name /= No_File if Data /= No_Source
and then Project_Boolean_Htable.Get (Present, Data.Project) and then Project_Boolean_Htable.Get (Present, Data.Project)
then then
Put_Data (Spec => False); Put_Data (Spec => False);
...@@ -1160,16 +1164,18 @@ package body Prj.Env is ...@@ -1160,16 +1164,18 @@ package body Prj.Env is
-- Check for body -- Check for body
if not Main_Project_Only if not Main_Project_Only
or else Unit.File_Names (Body_Part).Project = The_Project or else
(Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project = The_Project)
then then
declare declare
Current_Name : constant File_Name_Type := Current_Name : File_Name_Type;
Unit.File_Names (Body_Part).Name;
begin begin
-- Case of a body present -- Case of a body present
if Current_Name /= No_File then if Unit.File_Names (Impl) /= null then
Current_Name := Unit.File_Names (Impl).File;
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Comparing with """); Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name)); Write_Str (Get_Name_String (Current_Name));
...@@ -1190,7 +1196,7 @@ package body Prj.Env is ...@@ -1190,7 +1196,7 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Body_Part).Path.Name); (Unit.File_Names (Impl).Path.Name);
else else
return Get_Name_String (Current_Name); return Get_Name_String (Current_Name);
...@@ -1206,7 +1212,7 @@ package body Prj.Env is ...@@ -1206,7 +1212,7 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Body_Part).Path.Name); (Unit.File_Names (Impl).Path.Name);
else else
return Extended_Body_Name; return Extended_Body_Name;
...@@ -1224,16 +1230,19 @@ package body Prj.Env is ...@@ -1224,16 +1230,19 @@ package body Prj.Env is
-- Check for spec -- Check for spec
if not Main_Project_Only if not Main_Project_Only
or else Unit.File_Names (Specification).Project = The_Project or else
(Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Project =
The_Project)
then then
declare declare
Current_Name : constant File_Name_Type := Current_Name : File_Name_Type;
Unit.File_Names (Specification).Name;
begin begin
-- Case of spec present -- Case of spec present
if Current_Name /= No_File then if Unit.File_Names (Spec) /= null then
Current_Name := Unit.File_Names (Spec).File;
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Comparing with """); Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name)); Write_Str (Get_Name_String (Current_Name));
...@@ -1253,7 +1262,7 @@ package body Prj.Env is ...@@ -1253,7 +1262,7 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Specification).Path.Name); (Unit.File_Names (Spec).Path.Name);
else else
return Get_Name_String (Current_Name); return Get_Name_String (Current_Name);
end if; end if;
...@@ -1268,7 +1277,7 @@ package body Prj.Env is ...@@ -1268,7 +1277,7 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Specification).Path.Name); (Unit.File_Names (Spec).Path.Name);
else else
return Extended_Spec_Name; return Extended_Spec_Name;
end if; end if;
...@@ -1406,40 +1415,43 @@ package body Prj.Env is ...@@ -1406,40 +1415,43 @@ package body Prj.Env is
loop loop
Unit := In_Tree.Units.Table (Id); Unit := In_Tree.Units.Table (Id);
if (Unit.File_Names (Specification).Name /= No_File if Unit.File_Names (Spec) /= null
and then and then Unit.File_Names (Spec).File /= No_File
Namet.Get_Name_String and then
(Unit.File_Names (Specification).Name) = Original_Name) (Namet.Get_Name_String
or else (Unit.File_Names (Specification).Path /= (Unit.File_Names (Spec).File) = Original_Name
No_Path_Information or else (Unit.File_Names (Spec).Path /=
and then No_Path_Information
Namet.Get_Name_String and then
(Unit.File_Names (Specification).Path.Name) = Namet.Get_Name_String
Original_Name) (Unit.File_Names (Spec).Path.Name) =
Original_Name))
then then
Project := Ultimate_Extension_Of Project := Ultimate_Extension_Of
(Project => Unit.File_Names (Specification).Project); (Project => Unit.File_Names (Spec).Project);
Path := Unit.File_Names (Specification).Path.Display_Name; Path := Unit.File_Names (Spec).Path.Display_Name;
if Current_Verbosity > Default then if Current_Verbosity > Default then
Write_Str ("Done: Specification."); Write_Str ("Done: Spec.");
Write_Eol; Write_Eol;
end if; end if;
return; return;
elsif (Unit.File_Names (Body_Part).Name /= No_File elsif Unit.File_Names (Impl) /= null
and then and then Unit.File_Names (Impl).File /= No_File
Namet.Get_Name_String and then
(Unit.File_Names (Body_Part).Name) = Original_Name) (Namet.Get_Name_String
or else (Unit.File_Names (Body_Part).Path /= No_Path_Information (Unit.File_Names (Impl).File) = Original_Name
and then Namet.Get_Name_String or else (Unit.File_Names (Impl).Path /=
(Unit.File_Names (Body_Part).Path.Name) = No_Path_Information
Original_Name) and then Namet.Get_Name_String
(Unit.File_Names (Impl).Path.Name) =
Original_Name))
then then
Project := Ultimate_Extension_Of Project := Ultimate_Extension_Of
(Project => Unit.File_Names (Body_Part).Project); (Project => Unit.File_Names (Impl).Project);
Path := Unit.File_Names (Body_Part).Path.Display_Name; Path := Unit.File_Names (Impl).Path.Display_Name;
if Current_Verbosity > Default then if Current_Verbosity > Default then
Write_Str ("Done: Body."); Write_Str ("Done: Body.");
...@@ -1490,38 +1502,37 @@ package body Prj.Env is ...@@ -1490,38 +1502,37 @@ package body Prj.Env is
Write_Str (" "); Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name)); Write_Line (Namet.Get_Name_String (Unit.Name));
if Unit.File_Names (Specification).Name /= No_File then if Unit.File_Names (Spec).File /= No_File then
if Unit.File_Names (Specification).Project = No_Project then if Unit.File_Names (Spec).Project = No_Project then
Write_Line (" No project"); Write_Line (" No project");
else else
Write_Str (" Project: "); Write_Str (" Project: ");
Get_Name_String Get_Name_String
(Unit.File_Names (Specification).Project.Path.Name); (Unit.File_Names (Spec).Project.Path.Name);
Write_Line (Name_Buffer (1 .. Name_Len)); Write_Line (Name_Buffer (1 .. Name_Len));
end if; end if;
Write_Str (" spec: "); Write_Str (" spec: ");
Write_Line Write_Line
(Namet.Get_Name_String (Namet.Get_Name_String
(Unit.File_Names (Specification).Name)); (Unit.File_Names (Spec).File));
end if; end if;
if Unit.File_Names (Body_Part).Name /= No_File then if Unit.File_Names (Impl).File /= No_File then
if Unit.File_Names (Body_Part).Project = No_Project then if Unit.File_Names (Impl).Project = No_Project then
Write_Line (" No project"); Write_Line (" No project");
else else
Write_Str (" Project: "); Write_Str (" Project: ");
Get_Name_String Get_Name_String
(Unit.File_Names (Body_Part).Project.Path.Name); (Unit.File_Names (Impl).Project.Path.Name);
Write_Line (Name_Buffer (1 .. Name_Len)); Write_Line (Name_Buffer (1 .. Name_Len));
end if; end if;
Write_Str (" body: "); Write_Str (" body: ");
Write_Line Write_Line
(Namet.Get_Name_String (Namet.Get_Name_String (Unit.File_Names (Impl).File));
(Unit.File_Names (Body_Part).Name));
end if; end if;
end loop; end loop;
...@@ -1574,13 +1585,10 @@ package body Prj.Env is ...@@ -1574,13 +1585,10 @@ package body Prj.Env is
loop loop
Unit := In_Tree.Units.Table (Current); Unit := In_Tree.Units.Table (Current);
-- Check for body
Current_Name := Unit.File_Names (Body_Part).Name;
-- Case of a body present -- Case of a body present
if Current_Name /= No_File then if Unit.File_Names (Impl) /= null then
Current_Name := Unit.File_Names (Impl).File;
-- If it has the name of the original name or the body name, -- If it has the name of the original name or the body name,
-- we have found the project. -- we have found the project.
...@@ -1589,16 +1597,15 @@ package body Prj.Env is ...@@ -1589,16 +1597,15 @@ package body Prj.Env is
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name or else Current_Name = The_Body_Name
then then
Result := Unit.File_Names (Body_Part).Project; Result := Unit.File_Names (Impl).Project;
exit; exit;
end if; end if;
end if; end if;
-- Check for spec -- Check for spec
Current_Name := Unit.File_Names (Specification).Name; if Unit.File_Names (Spec) /= null then
Current_Name := Unit.File_Names (Spec).File;
if Current_Name /= No_File then
-- If name same as the original name, or the spec name, we have -- If name same as the original name, or the spec name, we have
-- found the project. -- found the project.
...@@ -1607,7 +1614,7 @@ package body Prj.Env is ...@@ -1607,7 +1614,7 @@ package body Prj.Env is
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name or else Current_Name = The_Spec_Name
then then
Result := Unit.File_Names (Specification).Project; Result := Unit.File_Names (Spec).Project;
exit; exit;
end if; end if;
end if; end if;
......
gcc/ada/prj-nmsc.adb
...@@ -850,9 +850,9 @@ package body Prj.Nmsc is ...@@ -850,9 +850,9 @@ package body Prj.Nmsc is
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
Prepare_Ada_Naming_Exceptions Prepare_Ada_Naming_Exceptions
(Project.Naming.Bodies, In_Tree, Body_Part); (Project.Naming.Bodies, In_Tree, Impl);
Prepare_Ada_Naming_Exceptions Prepare_Ada_Naming_Exceptions
(Project.Naming.Specs, In_Tree, Specification); (Project.Naming.Specs, In_Tree, Spec);
end if; end if;
-- Find the sources -- Find the sources
...@@ -1702,7 +1702,7 @@ package body Prj.Nmsc is ...@@ -1702,7 +1702,7 @@ package body Prj.Nmsc is
if Lang_Index /= No_Language_Index then if Lang_Index /= No_Language_Index then
case Current_Array.Name is case Current_Array.Name is
when Name_Specification_Suffix | Name_Spec_Suffix => when Name_Spec_Suffix | Name_Specification_Suffix =>
-- Attribute Spec_Suffix (<language>) -- Attribute Spec_Suffix (<language>)
...@@ -2978,7 +2978,7 @@ package body Prj.Nmsc is ...@@ -2978,7 +2978,7 @@ package body Prj.Nmsc is
if Exceptions = No_Array_Element then if Exceptions = No_Array_Element then
Exceptions := Value_Of Exceptions := Value_Of
(Name_Specification, (Name_Spec,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end if;
...@@ -3282,7 +3282,7 @@ package body Prj.Nmsc is ...@@ -3282,7 +3282,7 @@ package body Prj.Nmsc is
if Suffix = Nil_Variable_Value then if Suffix = Nil_Variable_Value then
Suffix := Value_Of Suffix := Value_Of
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Specification_Suffix, Attribute_Or_Array_Name => Name_Spec_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end if;
...@@ -4133,7 +4133,7 @@ package body Prj.Nmsc is ...@@ -4133,7 +4133,7 @@ package body Prj.Nmsc is
Suffix := Element.Next; Suffix := Element.Next;
end loop; end loop;
-- Put the resulting array as the specification suffixes -- Put the resulting array as the Spec suffixes
Project.Naming.Spec_Suffix := Spec_Suffixs; Project.Naming.Spec_Suffix := Spec_Suffixs;
end if; end if;
...@@ -4541,22 +4541,20 @@ package body Prj.Nmsc is ...@@ -4541,22 +4541,20 @@ package body Prj.Nmsc is
UData := In_Tree.Units.Table (The_Unit_Id); UData := In_Tree.Units.Table (The_Unit_Id);
if UData.File_Names (Body_Part).Name /= No_File if UData.File_Names (Impl) /= null
and then and then
UData.File_Names (Body_Part).Path.Name /= UData.File_Names (Impl).Path.Name /=
Slash Slash
then then
if Check_Project if Check_Project
(UData.File_Names (Body_Part).Project, (UData.File_Names (Impl).Project,
Project, Extending) Project, Extending)
then then
-- There is a body for this unit. -- There is a body for this unit.
-- If there is no spec, we need to check that it -- If there is no spec, we need to check that it
-- is not a subunit. -- is not a subunit.
if UData.File_Names (Specification).Name = if UData.File_Names (Spec) = null then
No_File
then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
...@@ -4564,7 +4562,7 @@ package body Prj.Nmsc is ...@@ -4564,7 +4562,7 @@ package body Prj.Nmsc is
Src_Ind := Sinput.P.Load_Project_File Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String (Get_Name_String
(UData.File_Names (UData.File_Names
(Body_Part).Path.Name)); (Impl).Path.Name));
if Sinput.P.Source_File_Is_Subunit if Sinput.P.Source_File_Is_Subunit
(Src_Ind) (Src_Ind)
...@@ -4584,7 +4582,7 @@ package body Prj.Nmsc is ...@@ -4584,7 +4582,7 @@ package body Prj.Nmsc is
-- ALI file for its body to the Interface ALIs. -- ALI file for its body to the Interface ALIs.
Add_ALI_For Add_ALI_For
(UData.File_Names (Body_Part).Name); (UData.File_Names (Impl).File);
else else
Error_Msg Error_Msg
...@@ -4594,13 +4592,12 @@ package body Prj.Nmsc is ...@@ -4594,13 +4592,12 @@ package body Prj.Nmsc is
(Interfaces).Location); (Interfaces).Location);
end if; end if;
elsif UData.File_Names (Specification).Name /= elsif UData.File_Names (Spec) /= null
No_File
and then UData.File_Names and then UData.File_Names
(Specification).Path.Name /= Slash (Spec).Path.Name /= Slash
and then Check_Project and then Check_Project
(UData.File_Names (UData.File_Names
(Specification).Project, (Spec).Project,
Project, Extending) Project, Extending)
then then
...@@ -4609,7 +4606,7 @@ package body Prj.Nmsc is ...@@ -4609,7 +4606,7 @@ package body Prj.Nmsc is
-- Interface ALIs. -- Interface ALIs.
Add_ALI_For Add_ALI_For
(UData.File_Names (Specification).Name); (UData.File_Names (Spec).File);
else else
Error_Msg Error_Msg
...@@ -6360,7 +6357,7 @@ package body Prj.Nmsc is ...@@ -6360,7 +6357,7 @@ package body Prj.Nmsc is
if Info_Id /= No_Ada_Naming_Exception then if Info_Id /= No_Ada_Naming_Exception then
Exception_Id := Info_Id; Exception_Id := Info_Id;
Unit_Name := No_Name; Unit_Name := No_Name;
Unit_Kind := Specification; Unit_Kind := Spec;
else else
Exception_Id := No_Ada_Naming_Exception; Exception_Id := No_Ada_Naming_Exception;
...@@ -6376,8 +6373,8 @@ package body Prj.Nmsc is ...@@ -6376,8 +6373,8 @@ package body Prj.Nmsc is
In_Tree => In_Tree); In_Tree => In_Tree);
case Kind is case Kind is
when Spec => Unit_Kind := Specification; when Spec => Unit_Kind := Spec;
when Impl | Sep => Unit_Kind := Body_Part; when Impl | Sep => Unit_Kind := Impl;
end case; end case;
end if; end if;
end Get_Unit; end Get_Unit;
...@@ -7770,7 +7767,7 @@ package body Prj.Nmsc is ...@@ -7770,7 +7767,7 @@ package body Prj.Nmsc is
if Index /= No_Unit_Index then if Index /= No_Unit_Index then
Unit.File_Names (Kind).Path.Name := Slash; Unit.File_Names (Kind).Path.Name := Slash;
Unit.File_Names (Kind).Needs_Pragma := False; Unit.File_Names (Kind).Naming_Exception := False;
In_Tree.Units.Table (Index) := Unit; In_Tree.Units.Table (Index) := Unit;
end if; end if;
...@@ -7815,7 +7812,9 @@ package body Prj.Nmsc is ...@@ -7815,7 +7812,9 @@ package body Prj.Nmsc is
Unit := In_Tree.Units.Table (Index); Unit := In_Tree.Units.Table (Index);
for Kind in Spec_Or_Body'Range loop for Kind in Spec_Or_Body'Range loop
if Unit.File_Names (Kind).Name = Excluded.File then if Unit.File_Names (Kind) /= null
and then Unit.File_Names (Kind).File = Excluded.File
then
Exclude (Unit.File_Names (Kind).Project, Index, Kind); Exclude (Unit.File_Names (Kind).Project, Index, Kind);
exit For_Each_Unit; exit For_Each_Unit;
end if; end if;
...@@ -7829,7 +7828,7 @@ package body Prj.Nmsc is ...@@ -7829,7 +7828,7 @@ package body Prj.Nmsc is
exit when Source = No_Source; exit when Source = No_Source;
if Source.File = Excluded.File then if Source.File = Excluded.File then
Exclude (Source.Project, No_Unit_Index, Specification); Exclude (Source.Project, No_Unit_Index, Spec);
exit; exit;
end if; end if;
...@@ -8105,29 +8104,21 @@ package body Prj.Nmsc is ...@@ -8105,29 +8104,21 @@ package body Prj.Nmsc is
if The_Unit /= No_Unit_Index then if The_Unit /= No_Unit_Index then
UData := In_Tree.Units.Table (The_Unit); UData := In_Tree.Units.Table (The_Unit);
if (UData.File_Names (Unit_Kind).Name = Canonical_File if UData.File_Names (Unit_Kind) = null
and then UData.File_Names (Unit_Kind).Path.Name = Slash) or else
or else UData.File_Names (Unit_Kind).Name = No_File ((UData.File_Names (Unit_Kind).File = Canonical_File
or else Is_Extending and then UData.File_Names (Unit_Kind).Path.Name = Slash)
(Project.Extends, UData.File_Names (Unit_Kind).Project) or else UData.File_Names (Unit_Kind).File = No_File
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project))
then then
if UData.File_Names (Unit_Kind).Path.Name = Slash then if UData.File_Names (Unit_Kind) /= null
and then UData.File_Names (Unit_Kind).Path.Name = Slash
then
Remove_Forbidden_File_Name Remove_Forbidden_File_Name
(UData.File_Names (Unit_Kind).Name); (UData.File_Names (Unit_Kind).File);
end if; end if;
-- Record the file name in the hash table Files_Htable
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
UData.File_Names (Unit_Kind) :=
(Name => Canonical_File,
Index => Unit_Ind,
Display_Name => File_Name,
Path => (Canonical_Path, Path_Name),
Project => Project,
Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := UData;
To_Record := True; To_Record := True;
Source_Recorded := True; Source_Recorded := True;
...@@ -8189,31 +8180,24 @@ package body Prj.Nmsc is ...@@ -8189,31 +8180,24 @@ package body Prj.Nmsc is
Location); Location);
else else
UData.Name := Unit_Name;
Unit_Table.Increment_Last (In_Tree.Units); Unit_Table.Increment_Last (In_Tree.Units);
The_Unit := Unit_Table.Last (In_Tree.Units); The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit); Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
UData.Name := Unit_Name;
UData.File_Names (Unit_Kind) :=
(Name => Canonical_File,
Index => Unit_Ind,
Display_Name => File_Name,
Path => (Canonical_Path, Path_Name),
Project => Project,
Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := UData;
Source_Recorded := True; 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);
case Unit_Kind is case Unit_Kind is
when Body_Part => Kind := Impl; when Impl =>
when Specification => Kind := Spec; Kind := Impl;
when Spec =>
Kind := Spec;
end case; end case;
Add_Source Add_Source
...@@ -8226,8 +8210,13 @@ package body Prj.Nmsc is ...@@ -8226,8 +8210,13 @@ package body Prj.Nmsc is
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,
Kind => Kind, Kind => Kind,
Index => Unit_Ind,
Other_Part => No_Source); -- ??? Can we find file ? Other_Part => No_Source); -- ??? Can we find file ?
UData.File_Names (Unit_Kind) := Source;
In_Tree.Units.Table (The_Unit) := UData;
end if; end if;
end Record_Unit; end Record_Unit;
...@@ -8451,7 +8440,7 @@ package body Prj.Nmsc is ...@@ -8451,7 +8440,7 @@ package body Prj.Nmsc is
if Specs then if Specs then
if not Check_Project if not Check_Project
(The_Unit_Data.File_Names (Specification).Project, (The_Unit_Data.File_Names (Spec).Project,
Project, Extending) Project, Extending)
then then
Error_Msg Error_Msg
...@@ -8462,9 +8451,10 @@ package body Prj.Nmsc is ...@@ -8462,9 +8451,10 @@ package body Prj.Nmsc is
end if; end if;
else else
if not Check_Project if The_Unit_Data.File_Names (Impl) = null
(The_Unit_Data.File_Names (Body_Part).Project, or else not Check_Project
Project, Extending) (The_Unit_Data.File_Names (Impl).Project,
Project, Extending)
then then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
......
gcc/ada/prj.ads
...@@ -626,6 +626,7 @@ package Prj is ...@@ -626,6 +626,7 @@ package Prj is
Lang_Kind : Language_Kind := File_Based; Lang_Kind : Language_Kind := File_Based;
-- Kind of the language -- Kind of the language
-- ??? Should be in Language itself
Compiled : Boolean := True; Compiled : Boolean := True;
-- False when there is no compiler for the language -- False when there is no compiler for the language
...@@ -675,6 +676,8 @@ package Prj is ...@@ -675,6 +676,8 @@ package Prj is
Path : Path_Information := No_Path_Information; Path : Path_Information := No_Path_Information;
-- Path name of the source -- Path name of the source
-- Path.Name is set to Slash for an excluded file that does not belong
-- in the project in fact
Source_TS : Time_Stamp_Type := Empty_Time_Stamp; Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Time stamp of the source file -- Time stamp of the source file
...@@ -1342,20 +1345,8 @@ package Prj is ...@@ -1342,20 +1345,8 @@ package Prj is
Project_Error : exception; Project_Error : exception;
-- Raised by some subprograms in Prj.Attr -- Raised by some subprograms in Prj.Attr
type Spec_Or_Body is (Specification, Body_Part); subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type File_Name_Data is record
Name : File_Name_Type := No_File;
Index : Int := 0;
Display_Name : File_Name_Type := No_File;
Path : Path_Information := No_Path_Information;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
type Unit_Index is new Nat; type Unit_Index is new Nat;
No_Unit_Index : constant Unit_Index := 0; No_Unit_Index : constant Unit_Index := 0;
type Unit_Data is record type Unit_Data is record
......
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