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 202 additions and 165 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/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.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