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>
* 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
from processing the type conversion when the node is
replaced by an N_Raise_Program_Error node.
......
gcc/ada/clean.adb
......@@ -577,22 +577,23 @@ package body Clean is
loop
Unit := Project_Tree.Units.Table (Index);
if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) = Project
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
Name (1 .. Last)
Get_Name_String (Unit.File_Names (Impl).File)
= Name (1 .. Last)
then
Delete_File := True;
exit;
end if;
if Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) = Project
if Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) = Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
(Unit.File_Names (Spec).File) =
Name (1 .. Last)
then
Delete_File := True;
......@@ -741,15 +742,16 @@ package body Clean is
loop
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
then
if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) =
(Unit.File_Names (Impl).Project) =
Project
then
Get_Name_String
(Unit.File_Names (Body_Part).Name);
(Unit.File_Names (Impl).File);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
......@@ -761,12 +763,13 @@ package body Clean is
end if;
end if;
elsif Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) =
elsif Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) =
Project
then
Get_Name_String
(Unit.File_Names (Specification).Name);
(Unit.File_Names (Spec).File);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
......@@ -887,16 +890,33 @@ package body Clean is
-- project, check for the corresponding ALI file in the
-- object directory.
if In_Extension_Chain
(U_Data.File_Names (Body_Part).Project, Project)
if (U_Data.File_Names (Impl) /= null
and then
In_Extension_Chain
(U_Data.File_Names (Impl).Project, Project))
or else
In_Extension_Chain
(U_Data.File_Names (Specification).Project, Project)
(U_Data.File_Names (Spec) /= null
and then In_Extension_Chain
(U_Data.File_Names
(Spec).Project, Project))
then
File_Name1 := U_Data.File_Names (Body_Part).Name;
Index1 := U_Data.File_Names (Body_Part).Index;
File_Name2 := U_Data.File_Names (Specification).Name;
Index2 := U_Data.File_Names (Specification).Index;
if U_Data.File_Names (Impl) /= null then
File_Name1 := U_Data.File_Names (Impl).File;
Index1 := U_Data.File_Names (Impl).Index;
else
File_Name1 := No_File;
Index1 := 0;
end if;
if U_Data.File_Names (Spec) /= null then
File_Name2 :=
U_Data.File_Names (Spec).File;
Index2 :=
U_Data.File_Names (Spec).Index;
else
File_Name2 := No_File;
Index2 := 0;
end if;
-- If there is no body file name, then there may be
-- only a spec.
......
gcc/ada/exp_ch4.adb
......@@ -7955,9 +7955,13 @@ package body Exp_Ch4 is
begin
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
Actual_Op_Typ := Operand_Type;
Actual_Targ_Typ := Target_Type;
......@@ -7978,6 +7982,7 @@ package body Exp_Ch4 is
-- conversion.
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 Is_Ancestor (Root_Op_Typ, Actual_Targ_Typ)
then
......@@ -9486,8 +9491,10 @@ package body Exp_Ch4 is
Obj_Tag : Node_Id;
begin
Left_Type := Etype (Left);
Right_Type := Etype (Right);
-- Handle entities from the limited view
Left_Type := Available_View (Etype (Left));
Right_Type := Available_View (Etype (Right));
if Is_Class_Wide_Type (Left_Type) then
Left_Type := Root_Type (Left_Type);
......
gcc/ada/gnatcmd.adb
......@@ -418,21 +418,18 @@ procedure GNATCmd is
-- spec, but not the subunits.
if The_Command = List then
if
Unit_Data.File_Names (Body_Part).Name /= No_File
and then
Unit_Data.File_Names (Body_Part).Path.Name /= Slash
if Unit_Data.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash
then
-- There is a body, check if it is for this project
if All_Projects or else
Unit_Data.File_Names (Body_Part).Project = Project
Unit_Data.File_Names (Impl).Project = Project
then
Subunit := False;
if Unit_Data.File_Names (Specification).Name = No_File
or else Unit_Data.File_Names
(Specification).Path.Name = Slash
if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash
then
-- We have a body with no spec: we need to check if
-- this is a subunit, because gnatls will complain
......@@ -443,7 +440,7 @@ procedure GNATCmd is
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Path.Name));
(Impl).Path.Name));
begin
Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind);
......@@ -456,27 +453,25 @@ procedure GNATCmd is
new String'
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Display_Name));
(Impl).Display_File));
end if;
end if;
elsif
Unit_Data.File_Names (Specification).Name /= No_File
and then
Unit_Data.File_Names (Specification).Path.Name /= Slash
elsif Unit_Data.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash
then
-- We have a spec with no body. Check if it is for this
-- project.
if All_Projects or else
Unit_Data.File_Names (Specification).Project = Project
Unit_Data.File_Names (Spec).Project = Project
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Specification).Display_Name));
(Spec).Display_File));
end if;
end if;
......@@ -486,21 +481,19 @@ procedure GNATCmd is
-- but not the subunits.
elsif The_Command = Stack then
if Unit_Data.File_Names (Body_Part).Name /= No_File
and then
Unit_Data.File_Names (Body_Part).Path.Name /= Slash
if Unit_Data.File_Names (Impl) /= null
and then Unit_Data.File_Names (Impl).Path.Name /= Slash
then
-- There is a body. Check if .ci files for this project
-- must be added.
if Check_Project
(Unit_Data.File_Names (Body_Part).Project, Project)
(Unit_Data.File_Names (Impl).Project, Project)
then
Subunit := False;
if Unit_Data.File_Names (Specification).Name = No_File
or else Unit_Data.File_Names
(Specification).Path.Name = Slash
if Unit_Data.File_Names (Spec) = null
or else Unit_Data.File_Names (Spec).Path.Name = Slash
then
-- We have a body with no spec: we need to check
-- if this is a subunit, because .ci files are not
......@@ -511,7 +504,7 @@ procedure GNATCmd is
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Path.Name));
(Impl).Path.Name));
begin
Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind);
......@@ -524,40 +517,37 @@ procedure GNATCmd is
new String'
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Project.
(Impl).Project.
Object_Directory.Name) &
Directory_Separator &
MLib.Fil.Ext_To
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Display_Name),
(Impl).Display_File),
"ci"));
end if;
end if;
elsif Unit_Data.File_Names (Specification).Name /= No_File
and then
Unit_Data.File_Names (Specification).Path.Name /= Slash
elsif Unit_Data.File_Names (Spec) /= null
and then Unit_Data.File_Names (Spec).Path.Name /= Slash
then
-- We have a spec with no body. Check if it is for this
-- project.
if Check_Project
(Unit_Data.File_Names (Specification).Project,
Project)
(Unit_Data.File_Names (Spec).Project, Project)
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
(Unit_Data.File_Names
(Specification).Project.
(Spec).Project.
Object_Directory.Name) &
Dir_Separator &
MLib.Fil.Ext_To
(Get_Name_String
(Unit_Data.File_Names
(Specification).Name),
(Unit_Data.File_Names (Spec).File),
"ci"));
end if;
end if;
......@@ -568,14 +558,13 @@ procedure GNATCmd is
-- specified.
for Kind in Spec_Or_Body loop
if Check_Project
(Unit_Data.File_Names (Kind).Project, Project)
and then Unit_Data.File_Names (Kind).Name /= No_File
if Unit_Data.File_Names (Kind) /= null
and then Check_Project
(Unit_Data.File_Names (Kind).Project, Project)
and then Unit_Data.File_Names (Kind).Path.Name /= Slash
then
Get_Name_String
(Unit_Data.File_Names
(Kind).Path.Display_Name);
(Unit_Data.File_Names (Kind).Path.Display_Name);
if FD /= Invalid_FD then
Name_Len := Name_Len + 1;
......@@ -833,20 +822,20 @@ procedure GNATCmd is
loop
Udata := Project_Tree.Units.Table (Unit);
if Udata.File_Names (Specification).Name /= No_File
if Udata.File_Names (Spec) /= null
and then
Get_Name_String (Udata.File_Names (Specification).Name) =
Get_Name_String (Udata.File_Names (Spec).File) =
Line (1 .. Last)
then
Path := Udata.File_Names (Specification).Path.Name;
Path := Udata.File_Names (Spec).Path.Name;
exit;
elsif Udata.File_Names (Body_Part).Name /= No_File
elsif Udata.File_Names (Impl) /= null
and then
Get_Name_String (Udata.File_Names (Body_Part).Name) =
Get_Name_String (Udata.File_Names (Impl).File) =
Line (1 .. Last)
then
Path := Udata.File_Names (Body_Part).Path.Name;
Path := Udata.File_Names (Impl).Path.Name;
exit;
end if;
end loop;
......
gcc/ada/make.adb
......@@ -1473,8 +1473,11 @@ package body Make is
if UID /= Prj.No_Unit_Index then
U_Data := Project_Tree.Units.Table (UID);
if U_Data.File_Names (Body_Part).Name /= Sfile
and then U_Data.File_Names (Specification).Name /= Sfile
if (U_Data.File_Names (Impl) = null
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
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True;
......@@ -1945,15 +1948,18 @@ package body Make is
for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop
Udata := Project_Tree.Units.Table (U);
if Udata.File_Names (Body_Part).Name = Source_File then
ALI_Project := Udata.File_Names (Body_Part).Project;
if Udata.File_Names (Impl) /= null
and then Udata.File_Names (Impl).File = Source_File
then
ALI_Project := Udata.File_Names (Impl).Project;
exit;
elsif
Udata.File_Names (Specification).Name = Source_File
elsif Udata.File_Names (Spec) /= null
and then Udata.File_Names (Spec).File =
Source_File
then
ALI_Project :=
Udata.File_Names (Specification).Project;
Udata.File_Names (Spec).Project;
exit;
end if;
end loop;
......@@ -2053,16 +2059,20 @@ package body Make is
UID in 1 .. Unit_Table.Last (Project_Tree.Units)
loop
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
Proj := Project_Tree.Units.Table (UID).
File_Names (Body_Part).Project;
File_Names (Impl).Project;
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
Proj := Project_Tree.Units.Table (UID).
File_Names (Specification).Project;
File_Names (Spec).Project;
end if;
-- If a source is in a project, check if it is one
......@@ -3608,28 +3618,24 @@ package body Make is
if Uid /= Prj.No_Unit_Index then
Udata := Project_Tree.Units.Table (Uid);
if
Udata.File_Names (Body_Part).Name /=
No_File
if Udata.File_Names (Impl) /= null
and then
Udata.File_Names (Body_Part).Path.Name /=
Udata.File_Names (Impl).Path.Name /=
Slash
then
Sfile := Udata.File_Names (Body_Part).Name;
Sfile := Udata.File_Names (Impl).File;
Source_Index :=
Udata.File_Names (Body_Part).Index;
Udata.File_Names (Impl).Index;
elsif
Udata.File_Names (Specification).Name /=
No_File
elsif Udata.File_Names (Spec) /= null
and then
Udata.File_Names
(Specification).Path.Name /= Slash
(Spec).Path.Name /= Slash
then
Sfile :=
Udata.File_Names (Specification).Name;
Udata.File_Names (Spec).File;
Source_Index :=
Udata.File_Names (Specification).Index;
Udata.File_Names (Spec).Index;
end if;
end if;
end;
......@@ -4400,8 +4406,8 @@ package body Make is
-- If there is a body, put it in the mapping
if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Project /=
if Unit.File_Names (Impl) /= No_Source
and then Unit.File_Names (Impl).Project /=
No_Project
then
Get_Name_String (Unit.Name);
......@@ -4409,14 +4415,14 @@ package body Make is
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Body_Part).Display_Name);
ALI_Project := Unit.File_Names (Body_Part).Project;
(Unit.File_Names (Impl).Display_File);
ALI_Project := Unit.File_Names (Impl).Project;
-- Otherwise, if there is a spec, put it in the
-- mapping.
elsif Unit.File_Names (Specification).Name /= No_File
and then Unit.File_Names (Specification).Project /=
elsif Unit.File_Names (Spec) /= No_Source
and then Unit.File_Names (Spec).Project /=
No_Project
then
Get_Name_String (Unit.Name);
......@@ -4424,8 +4430,8 @@ package body Make is
ALI_Unit := Name_Find;
ALI_Name :=
Lib_File_Name
(Unit.File_Names (Specification).Display_Name);
ALI_Project := Unit.File_Names (Specification).Project;
(Unit.File_Names (Spec).Display_File);
ALI_Project := Unit.File_Names (Spec).Project;
else
ALI_Name := No_File;
......@@ -7014,17 +7020,17 @@ package body Make is
-- If there is a source for the body, and the body has not been
-- locally removed.
if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Path.Name /= Slash
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
-- 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 it is a subunit.
if Unit.File_Names (Specification).Name = No_File then
if Unit.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
......@@ -7042,7 +7048,7 @@ package body Make is
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(Unit.File_Names (Body_Part).Path.Name));
(Unit.File_Names (Impl).Path.Name));
-- If it is a subunit, discard it
......@@ -7050,27 +7056,27 @@ package body Make is
Sfile := No_File;
Index := 0;
else
Sfile := Unit.File_Names (Body_Part).Display_Name;
Index := Unit.File_Names (Body_Part).Index;
Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Impl).Index;
end if;
end;
else
Sfile := Unit.File_Names (Body_Part).Display_Name;
Index := Unit.File_Names (Body_Part).Index;
Sfile := Unit.File_Names (Impl).Display_File;
Index := Unit.File_Names (Impl).Index;
end if;
end if;
elsif Unit.File_Names (Specification).Name /= No_File
and then Unit.File_Names (Specification).Path.Name /= Slash
and then Check_Project (Unit.File_Names (Specification).Project)
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
and then Check_Project (Unit.File_Names (Spec).Project)
then
-- 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
-- this one.
Sfile := Unit.File_Names (Specification).Display_Name;
Index := Unit.File_Names (Specification).Index;
Sfile := Unit.File_Names (Spec).Display_File;
Index := Unit.File_Names (Spec).Index;
end if;
-- 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
loop
Unit := In_Tree.Units.Table (Source);
if Unit.File_Names (Body_Part).Name /= No_File
and then Unit.File_Names (Body_Part).Path.Name /= Slash
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
if
Check_Project (Unit.File_Names (Body_Part).Project)
Check_Project (Unit.File_Names (Impl).Project)
then
if Unit.File_Names (Specification).Name = No_File then
if Unit.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(Unit.File_Names
(Body_Part).Path.Name));
(Unit.File_Names (Impl).Path.Name));
-- Add the ALI file only if it is not a subunit
......@@ -970,23 +969,23 @@ package body MLib.Prj is
Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
Add_ALI_For
(Unit.File_Names (Body_Part).Name);
(Unit.File_Names (Impl).File);
exit when not Bind;
end if;
end;
else
Add_ALI_For (Unit.File_Names (Body_Part).Name);
Add_ALI_For (Unit.File_Names (Impl).File);
exit when not Bind;
end if;
end if;
elsif Unit.File_Names (Specification).Name /= No_File
and then Unit.File_Names (Specification).Path.Name /= Slash
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
and then Check_Project
(Unit.File_Names (Specification).Project)
(Unit.File_Names (Spec).Project)
then
Add_ALI_For (Unit.File_Names (Specification).Name);
Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind;
end if;
end loop;
......@@ -1424,30 +1423,29 @@ package body MLib.Prj is
loop
if In_Tree.Units.Table
(Index).File_Names
(Body_Part).Name /= No_File
(Impl) /= null
then
Proj :=
In_Tree.Units.Table (Index).
File_Names
(Body_Part).Project;
(Impl).Project;
Fname :=
In_Tree.Units.Table (Index).
File_Names (Body_Part).Name;
File_Names (Impl).File;
elsif
In_Tree.Units.Table
(Index).File_Names
(Specification).Name /=
No_File
(Spec) /= null
then
Proj :=
In_Tree.Units.Table
(Index).File_Names
(Specification).Project;
(Spec).Project;
Fname :=
In_Tree.Units.Table
(Index).File_Names
(Specification).Name;
(Spec).File;
else
Proj := No_Project;
......@@ -1842,15 +1840,16 @@ package body MLib.Prj is
loop
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
then
if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) =
(Unit.File_Names (Impl).Project) =
For_Project
then
Get_Name_String
(Unit.File_Names (Body_Part).Name);
(Unit.File_Names (Impl).File);
Name_Len := Name_Len -
File_Extension
(Name (1 .. Name_Len))'Length;
......@@ -1862,12 +1861,13 @@ package body MLib.Prj is
end if;
end if;
elsif Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) =
For_Project
elsif Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) =
For_Project
then
Get_Name_String
(Unit.File_Names (Specification).Name);
(Unit.File_Names (Spec).File);
Name_Len :=
Name_Len -
File_Extension
......@@ -1983,23 +1983,25 @@ package body MLib.Prj is
for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
Unit := In_Tree.Units.Table (Index);
if Ultimate_Extending_Project_Of
(Unit.File_Names (Body_Part).Project) = For_Project
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Impl).Project) = For_Project
and then
Get_Name_String
(Unit.File_Names (Body_Part).Name) =
(Unit.File_Names (Impl).File) =
Name (1 .. Last)
then
Delete := True;
exit;
end if;
if Ultimate_Extending_Project_Of
(Unit.File_Names (Specification).Project) =
if Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
(Unit.File_Names (Spec).Project) =
For_Project
and then
Get_Name_String
(Unit.File_Names (Specification).Name) =
(Unit.File_Names (Spec).File) =
Name (1 .. Last)
then
Delete := True;
......@@ -2193,9 +2195,10 @@ package body MLib.Prj is
-- Find and copy the immediate or inherited source
for J in Data.File_Names'Range loop
if Is_Same_Or_Extension
(For_Project, Data.File_Names (J).Project)
and then Data.File_Names (J).Name = File_Name
if Data.File_Names (J) /= null
and then Is_Same_Or_Extension
(For_Project, Data.File_Names (J).Project)
and then Data.File_Names (J).File = File_Name
then
Copy_File
(Get_Name_String (Data.File_Names (J).Path.Name),
......
gcc/ada/prj-env.adb
......@@ -598,7 +598,7 @@ package body Prj.Env is
Put (File, "pragma Source_File_Name_Project (");
Put (File, Namet.Get_Name_String (Unit_Name));
if Unit_Kind = Specification then
if Unit_Kind = Spec then
Put (File, ", Spec_File_Name => """);
else
Put (File, ", Body_File_Name => """);
......@@ -681,18 +681,22 @@ package body Prj.Env is
In_Tree.Units.Table (Current_Unit);
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,
Unit.File_Names (Specification).Name,
Specification,
Unit.File_Names (Specification).Index);
Unit.File_Names (Spec).File,
Spec,
Unit.File_Names (Spec).Index);
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,
Unit.File_Names (Body_Part).Name,
Body_Part,
Unit.File_Names (Body_Part).Index);
Unit.File_Names (Impl).File,
Impl,
Unit.File_Names (Impl).Index);
end if;
Current_Unit := Current_Unit + 1;
......@@ -743,7 +747,7 @@ package body Prj.Env is
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
The_Unit_Data : Unit_Data;
Data : File_Name_Data;
Data : Source_Id;
begin
Fmap.Reset_Tables;
......@@ -754,32 +758,32 @@ package body Prj.Env is
-- Process only if the unit has a valid name
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 Data.Name /= No_File then
if Data /= null then
if Data.Path.Name = Slash then
Fmap.Add_Forbidden_File_Name (Data.Name);
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
(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));
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 Data.Name /= No_File then
if Data /= null then
if Data.Path.Name = Slash then
Fmap.Add_Forbidden_File_Name (Data.Name);
Fmap.Add_Forbidden_File_Name (Data.File);
else
Fmap.Add_To_File_Map
(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));
end if;
end if;
......@@ -807,7 +811,7 @@ package body Prj.Env is
Source : Source_Id;
Suffix : File_Name_Type;
The_Unit_Data : Unit_Data;
Data : File_Name_Data;
Data : Source_Id;
Iter : Source_Iterator;
procedure Put_Name_Buffer;
......@@ -861,7 +865,7 @@ package body Prj.Env is
-- Line with the file name
Get_Name_String (Data.Name);
Get_Name_String (Data.File);
Put_Name_Buffer;
-- Line with the path name
......@@ -928,23 +932,23 @@ package body Prj.Env is
-- Case of unit has a valid name
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
-- 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)
then
Put_Data (Spec => True);
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
-- 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)
then
Put_Data (Spec => False);
......@@ -1160,16 +1164,18 @@ package body Prj.Env is
-- Check for body
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
declare
Current_Name : constant File_Name_Type :=
Unit.File_Names (Body_Part).Name;
Current_Name : File_Name_Type;
begin
-- 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
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
......@@ -1190,7 +1196,7 @@ package body Prj.Env is
if Full_Path then
return Get_Name_String
(Unit.File_Names (Body_Part).Path.Name);
(Unit.File_Names (Impl).Path.Name);
else
return Get_Name_String (Current_Name);
......@@ -1206,7 +1212,7 @@ package body Prj.Env is
if Full_Path then
return Get_Name_String
(Unit.File_Names (Body_Part).Path.Name);
(Unit.File_Names (Impl).Path.Name);
else
return Extended_Body_Name;
......@@ -1224,16 +1230,19 @@ package body Prj.Env is
-- Check for spec
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
declare
Current_Name : constant File_Name_Type :=
Unit.File_Names (Specification).Name;
Current_Name : File_Name_Type;
begin
-- 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
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
......@@ -1253,7 +1262,7 @@ package body Prj.Env is
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path.Name);
(Unit.File_Names (Spec).Path.Name);
else
return Get_Name_String (Current_Name);
end if;
......@@ -1268,7 +1277,7 @@ package body Prj.Env is
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path.Name);
(Unit.File_Names (Spec).Path.Name);
else
return Extended_Spec_Name;
end if;
......@@ -1406,40 +1415,43 @@ package body Prj.Env is
loop
Unit := In_Tree.Units.Table (Id);
if (Unit.File_Names (Specification).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Name) = Original_Name)
or else (Unit.File_Names (Specification).Path /=
No_Path_Information
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Path.Name) =
Original_Name)
if Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).File /= No_File
and then
(Namet.Get_Name_String
(Unit.File_Names (Spec).File) = Original_Name
or else (Unit.File_Names (Spec).Path /=
No_Path_Information
and then
Namet.Get_Name_String
(Unit.File_Names (Spec).Path.Name) =
Original_Name))
then
Project := Ultimate_Extension_Of
(Project => Unit.File_Names (Specification).Project);
Path := Unit.File_Names (Specification).Path.Display_Name;
(Project => Unit.File_Names (Spec).Project);
Path := Unit.File_Names (Spec).Path.Display_Name;
if Current_Verbosity > Default then
Write_Str ("Done: Specification.");
Write_Str ("Done: Spec.");
Write_Eol;
end if;
return;
elsif (Unit.File_Names (Body_Part).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name) = Original_Name)
or else (Unit.File_Names (Body_Part).Path /= No_Path_Information
and then Namet.Get_Name_String
(Unit.File_Names (Body_Part).Path.Name) =
Original_Name)
elsif Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).File /= No_File
and then
(Namet.Get_Name_String
(Unit.File_Names (Impl).File) = Original_Name
or else (Unit.File_Names (Impl).Path /=
No_Path_Information
and then Namet.Get_Name_String
(Unit.File_Names (Impl).Path.Name) =
Original_Name))
then
Project := Ultimate_Extension_Of
(Project => Unit.File_Names (Body_Part).Project);
Path := Unit.File_Names (Body_Part).Path.Display_Name;
(Project => Unit.File_Names (Impl).Project);
Path := Unit.File_Names (Impl).Path.Display_Name;
if Current_Verbosity > Default then
Write_Str ("Done: Body.");
......@@ -1490,38 +1502,37 @@ package body Prj.Env is
Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name));
if Unit.File_Names (Specification).Name /= No_File then
if Unit.File_Names (Specification).Project = No_Project then
if Unit.File_Names (Spec).File /= No_File then
if Unit.File_Names (Spec).Project = No_Project then
Write_Line (" No project");
else
Write_Str (" Project: ");
Get_Name_String
(Unit.File_Names (Specification).Project.Path.Name);
(Unit.File_Names (Spec).Project.Path.Name);
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
Write_Str (" spec: ");
Write_Line
(Namet.Get_Name_String
(Unit.File_Names (Specification).Name));
(Unit.File_Names (Spec).File));
end if;
if Unit.File_Names (Body_Part).Name /= No_File then
if Unit.File_Names (Body_Part).Project = No_Project then
if Unit.File_Names (Impl).File /= No_File then
if Unit.File_Names (Impl).Project = No_Project then
Write_Line (" No project");
else
Write_Str (" Project: ");
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));
end if;
Write_Str (" body: ");
Write_Line
(Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name));
(Namet.Get_Name_String (Unit.File_Names (Impl).File));
end if;
end loop;
......@@ -1574,13 +1585,10 @@ package body Prj.Env is
loop
Unit := In_Tree.Units.Table (Current);
-- Check for body
Current_Name := Unit.File_Names (Body_Part).Name;
-- 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,
-- we have found the project.
......@@ -1589,16 +1597,15 @@ package body Prj.Env is
or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name
then
Result := Unit.File_Names (Body_Part).Project;
Result := Unit.File_Names (Impl).Project;
exit;
end if;
end if;
-- Check for spec
Current_Name := Unit.File_Names (Specification).Name;
if Current_Name /= No_File then
if Unit.File_Names (Spec) /= null then
Current_Name := Unit.File_Names (Spec).File;
-- If name same as the original name, or the spec name, we have
-- found the project.
......@@ -1607,7 +1614,7 @@ package body Prj.Env is
or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name
then
Result := Unit.File_Names (Specification).Project;
Result := Unit.File_Names (Spec).Project;
exit;
end if;
end if;
......
gcc/ada/prj-nmsc.adb
......@@ -850,9 +850,9 @@ package body Prj.Nmsc is
if Get_Mode = Ada_Only then
Prepare_Ada_Naming_Exceptions
(Project.Naming.Bodies, In_Tree, Body_Part);
(Project.Naming.Bodies, In_Tree, Impl);
Prepare_Ada_Naming_Exceptions
(Project.Naming.Specs, In_Tree, Specification);
(Project.Naming.Specs, In_Tree, Spec);
end if;
-- Find the sources
......@@ -1702,7 +1702,7 @@ package body Prj.Nmsc is
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
when Name_Specification_Suffix | Name_Spec_Suffix =>
when Name_Spec_Suffix | Name_Specification_Suffix =>
-- Attribute Spec_Suffix (<language>)
......@@ -2978,7 +2978,7 @@ package body Prj.Nmsc is
if Exceptions = No_Array_Element then
Exceptions := Value_Of
(Name_Specification,
(Name_Spec,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
......@@ -3282,7 +3282,7 @@ package body Prj.Nmsc is
if Suffix = Nil_Variable_Value then
Suffix := Value_Of
(Name => Lang,
Attribute_Or_Array_Name => Name_Specification_Suffix,
Attribute_Or_Array_Name => Name_Spec_Suffix,
In_Package => Naming_Id,
In_Tree => In_Tree);
end if;
......@@ -4133,7 +4133,7 @@ package body Prj.Nmsc is
Suffix := Element.Next;
end loop;
-- Put the resulting array as the specification suffixes
-- Put the resulting array as the Spec suffixes
Project.Naming.Spec_Suffix := Spec_Suffixs;
end if;
......@@ -4541,22 +4541,20 @@ package body Prj.Nmsc is
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
UData.File_Names (Body_Part).Path.Name /=
UData.File_Names (Impl).Path.Name /=
Slash
then
if Check_Project
(UData.File_Names (Body_Part).Project,
(UData.File_Names (Impl).Project,
Project, Extending)
then
-- There is a body for this unit.
-- If there is no spec, we need to check that it
-- is not a subunit.
if UData.File_Names (Specification).Name =
No_File
then
if UData.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
......@@ -4564,7 +4562,7 @@ package body Prj.Nmsc is
Src_Ind := Sinput.P.Load_Project_File
(Get_Name_String
(UData.File_Names
(Body_Part).Path.Name));
(Impl).Path.Name));
if Sinput.P.Source_File_Is_Subunit
(Src_Ind)
......@@ -4584,7 +4582,7 @@ package body Prj.Nmsc is
-- ALI file for its body to the Interface ALIs.
Add_ALI_For
(UData.File_Names (Body_Part).Name);
(UData.File_Names (Impl).File);
else
Error_Msg
......@@ -4594,13 +4592,12 @@ package body Prj.Nmsc is
(Interfaces).Location);
end if;
elsif UData.File_Names (Specification).Name /=
No_File
elsif UData.File_Names (Spec) /= null
and then UData.File_Names
(Specification).Path.Name /= Slash
(Spec).Path.Name /= Slash
and then Check_Project
(UData.File_Names
(Specification).Project,
(Spec).Project,
Project, Extending)
then
......@@ -4609,7 +4606,7 @@ package body Prj.Nmsc is
-- Interface ALIs.
Add_ALI_For
(UData.File_Names (Specification).Name);
(UData.File_Names (Spec).File);
else
Error_Msg
......@@ -6360,7 +6357,7 @@ package body Prj.Nmsc is
if Info_Id /= No_Ada_Naming_Exception then
Exception_Id := Info_Id;
Unit_Name := No_Name;
Unit_Kind := Specification;
Unit_Kind := Spec;
else
Exception_Id := No_Ada_Naming_Exception;
......@@ -6376,8 +6373,8 @@ package body Prj.Nmsc is
In_Tree => In_Tree);
case Kind is
when Spec => Unit_Kind := Specification;
when Impl | Sep => Unit_Kind := Body_Part;
when Spec => Unit_Kind := Spec;
when Impl | Sep => Unit_Kind := Impl;
end case;
end if;
end Get_Unit;
......@@ -7770,7 +7767,7 @@ package body Prj.Nmsc is
if Index /= No_Unit_Index then
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;
end if;
......@@ -7815,7 +7812,9 @@ package body Prj.Nmsc is
Unit := In_Tree.Units.Table (Index);
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);
exit For_Each_Unit;
end if;
......@@ -7829,7 +7828,7 @@ package body Prj.Nmsc is
exit when Source = No_Source;
if Source.File = Excluded.File then
Exclude (Source.Project, No_Unit_Index, Specification);
Exclude (Source.Project, No_Unit_Index, Spec);
exit;
end if;
......@@ -8105,29 +8104,21 @@ package body Prj.Nmsc is
if The_Unit /= No_Unit_Index then
UData := In_Tree.Units.Table (The_Unit);
if (UData.File_Names (Unit_Kind).Name = Canonical_File
and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).Name = No_File
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project)
if UData.File_Names (Unit_Kind) = null
or else
((UData.File_Names (Unit_Kind).File = Canonical_File
and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else UData.File_Names (Unit_Kind).File = No_File
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project))
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
(UData.File_Names (Unit_Kind).Name);
(UData.File_Names (Unit_Kind).File);
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;
Source_Recorded := True;
......@@ -8189,31 +8180,24 @@ package body Prj.Nmsc is
Location);
else
UData.Name := Unit_Name;
Unit_Table.Increment_Last (In_Tree.Units);
The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
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;
To_Record := True;
end if;
end if;
if To_Record then
Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
case Unit_Kind is
when Body_Part => Kind := Impl;
when Specification => Kind := Spec;
when Impl =>
Kind := Impl;
when Spec =>
Kind := Spec;
end case;
Add_Source
......@@ -8226,8 +8210,13 @@ package body Prj.Nmsc is
Display_File => File_Name,
Unit => Unit_Name,
Path => (Canonical_Path, Path_Name),
Naming_Exception => Needs_Pragma,
Kind => Kind,
Index => Unit_Ind,
Other_Part => No_Source); -- ??? Can we find file ?
UData.File_Names (Unit_Kind) := Source;
In_Tree.Units.Table (The_Unit) := UData;
end if;
end Record_Unit;
......@@ -8451,7 +8440,7 @@ package body Prj.Nmsc is
if Specs then
if not Check_Project
(The_Unit_Data.File_Names (Specification).Project,
(The_Unit_Data.File_Names (Spec).Project,
Project, Extending)
then
Error_Msg
......@@ -8462,9 +8451,10 @@ package body Prj.Nmsc is
end if;
else
if not Check_Project
(The_Unit_Data.File_Names (Body_Part).Project,
Project, Extending)
if The_Unit_Data.File_Names (Impl) = null
or else not Check_Project
(The_Unit_Data.File_Names (Impl).Project,
Project, Extending)
then
Error_Msg
(Project, In_Tree,
......
gcc/ada/prj.ads
......@@ -626,6 +626,7 @@ package Prj is
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
......@@ -675,6 +676,8 @@ package Prj is
Path : Path_Information := No_Path_Information;
-- 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;
-- Time stamp of the source file
......@@ -1342,20 +1345,8 @@ package Prj is
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
type Spec_Or_Body is (Specification, Body_Part);
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;
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
......
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