OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_util.adb (Unique_Name): Reach through Unique_Entity to get the name of the entity.

Browse Source 
2011-12-02  Yannick Moy  <moy@adacore.com>

	* sem_util.adb (Unique_Name): Reach through Unique_Entity to
	get the name of the entity.
	(Unique_Entity): Correct case for subprogram stubs.

2011-12-02  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Check_Initialization): Do not emit warning on
	initialization of limited type object in Alfa mode.

From-SVN: r181916
This commit is contained in:
Yannick Moy 2011-12-02 14:50:16 +00:00 committed by Arnaud Charlet
parent 7a6c40a654
commit 151c42b0b5
3 changed files with 51 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2011-12-02 Yannick Moy <moy@adacore.com>
* sem_util.adb (Unique_Name): Reach through Unique_Entity to
get the name of the entity.
(Unique_Entity): Correct case for subprogram stubs.
2011-12-02 Yannick Moy <moy@adacore.com>
* sem_ch3.adb (Check_Initialization): Do not emit warning on
initialization of limited type object in Alfa mode.
2011-12-02 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Minor reformatting.

16
gcc/ada/sem_ch3.adb
View File

@ -9704,9 +9704,25 @@ package body Sem_Ch3 is
("?cannot initialize entities of limited type!", Exp);
elsif Ada_Version < Ada_2005 then
-- The side effect removal machinery may generate illegal Ada
-- code to avoid the usage of access types and 'reference in
-- Alfa mode. Since this is legal code with respect to theorem
-- proving, do not emit the error.
if Alfa_Mode
and then Nkind (Exp) = N_Function_Call
and then Nkind (Parent (Exp)) = N_Object_Declaration
and then not Comes_From_Source
(Defining_Identifier (Parent (Exp)))
then
null;
else
Error_Msg_N
("cannot initialize entities of limited type", Exp);
Explain_Limited_Type (T, Exp);
end if;
else
-- Specialize error message according to kind of illegal

26
gcc/ada/sem_util.adb
View File

@ -3045,7 +3045,8 @@ package body Sem_Util is
function Effectively_Has_Constrained_Partial_View
(Typ : Entity_Id;
Scop : Entity_Id := Current_Scope) return Boolean is
Scop : Entity_Id := Current_Scope) return Boolean
is
begin
return Has_Constrained_Partial_View (Typ)
or else (In_Generic_Body (Scop)
@ -6111,9 +6112,12 @@ package body Sem_Util is
---------------------
function In_Generic_Body (Id : Entity_Id) return Boolean is
S : Entity_Id := Id;
S : Entity_Id;
begin
-- Climb scopes looking for generic body
S := Id;
while Present (S) and then S /= Standard_Standard loop
-- Generic package body
@ -6135,6 +6139,8 @@ package body Sem_Util is
S := Scope (S);
end loop;
-- False if top of scope stack without finding a generic body
return False;
end In_Generic_Body;
@ -12905,7 +12911,12 @@ package body Sem_Util is
if Nkind (P) = N_Subprogram_Body_Stub then
if Present (Library_Unit (P)) then
U := Get_Body_From_Stub (P);
-- Get to the function or procedure (generic) entity through
-- the body entity.
U :=
Unique_Entity (Defining_Entity (Get_Body_From_Stub (P)));
end if;
else
U := Corresponding_Spec (P);
@ -12929,6 +12940,11 @@ package body Sem_Util is
function Unique_Name (E : Entity_Id) return String is
-- Names of E_Subprogram_Body or E_Package_Body entities are not
-- reliable, as they may not include the overloading suffix. Instead,
-- when looking for the name of E or one of its enclosing scope, we get
-- the name of the corresponding Unique_Entity.
function Get_Scoped_Name (E : Entity_Id) return String;
-- Return the name of E prefixed by all the names of the scopes to which
-- E belongs, except for Standard.
@ -12945,7 +12961,7 @@ package body Sem_Util is
then
return Name;
else
return Get_Scoped_Name (Scope (E)) & "__" & Name;
return Get_Scoped_Name (Unique_Entity (Scope (E))) & "__" & Name;
end if;
end Get_Scoped_Name;
@ -12965,7 +12981,7 @@ package body Sem_Util is
return Unique_Name (Etype (E)) & "__" & Get_Name_String (Chars (E));
else
return Get_Scoped_Name (E);
return Get_Scoped_Name (Unique_Entity (E));
end if;
end Unique_Name;