exp_util.adb, [...] (Entity_Of): Moved to Sem_Util.

2013-10-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, exp_util.ads (Entity_Of): Moved to Sem_Util.
	* sem_prag.adb (Analyze_Global_In_Decl_List): Mark a null
	item list as being analyzed.
	(Analyze_Global_List): Mark a
	null global list and multiple global items as being analyzed.
	(Analyze_Input_Item): Check the unit that defines the input
	variable or state, not the reference to it.
	* sem_util.ads, sem_util.adb (Entity_Of): Moved from Exp_Util. Ensure
	that the input has an entity.

From-SVN: r203764
This commit is contained in:
Hristian Kirtchev 2013-10-17 14:00:46 +00:00 committed by Arnaud Charlet
parent 064f4527c4
commit 275d8313ba
6 changed files with 54 additions and 41 deletions

View File

@ -1,3 +1,15 @@
2013-10-17 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, exp_util.ads (Entity_Of): Moved to Sem_Util.
* sem_prag.adb (Analyze_Global_In_Decl_List): Mark a null
item list as being analyzed.
(Analyze_Global_List): Mark a
null global list and multiple global items as being analyzed.
(Analyze_Input_Item): Check the unit that defines the input
variable or state, not the reference to it.
* sem_util.ads, sem_util.adb (Entity_Of): Moved from Exp_Util. Ensure
that the input has an entity.
2013-10-17 Thomas Quinot <quinot@adacore.com>
* exp_util.adb (Get_Current_Value_Condition,

View File

@ -1771,35 +1771,6 @@ package body Exp_Util is
end if;
end Ensure_Defined;
---------------
-- Entity_Of --
---------------
function Entity_Of (N : Node_Id) return Entity_Id is
Id : Entity_Id;
begin
Id := Empty;
if Is_Entity_Name (N) then
Id := Entity (N);
-- Follow a possible chain of renamings to reach the root renamed
-- object.
while Present (Renamed_Object (Id)) loop
if Is_Entity_Name (Renamed_Object (Id)) then
Id := Entity (Renamed_Object (Id));
else
Id := Empty;
exit;
end if;
end loop;
end if;
return Id;
end Entity_Of;
--------------------
-- Entry_Names_OK --
--------------------

View File

@ -349,10 +349,6 @@ package Exp_Util is
-- used to ensure that an Itype is properly defined outside a conditional
-- construct when it is referenced in more than one branch.
function Entity_Of (N : Node_Id) return Entity_Id;
-- Return the entity of N or Empty. If N is a renaming, return the entity
-- of the root renamed object.
function Entry_Names_OK return Boolean;
-- Determine whether it is appropriate to dynamically allocate strings
-- which represent entry [family member] names. These strings are created

View File

@ -1856,7 +1856,7 @@ package body Sem_Prag is
begin
if Nkind (List) = N_Null then
null;
Set_Analyzed (List);
-- Single global item declaration
@ -1869,6 +1869,7 @@ package body Sem_Prag is
-- Simple global list or moded global list declaration
elsif Nkind (List) = N_Aggregate then
Set_Analyzed (List);
-- The declaration of a simple global list appear as a collection
-- of expressions.
@ -1985,7 +1986,7 @@ package body Sem_Prag is
-- There is nothing to be done for a null global list
if Nkind (Items) = N_Null then
null;
Set_Analyzed (Items);
-- Analyze the various forms of global lists and items. Note that some
-- of these may be malformed in which case the analysis emits error
@ -2365,7 +2366,7 @@ package body Sem_Prag is
-- The input cannot denote states or variables declared
-- within the related package.
if In_Same_Code_Unit (Item, Input) then
if In_Same_Code_Unit (Item, Input_Id) then
Error_Msg_Name_1 := Chars (Pack_Id);
Error_Msg_NE
("input item & cannot denote a visible variable or "
@ -11125,6 +11126,11 @@ package body Sem_Prag is
GNAT_Pragma;
Check_Arg_Count (1);
-- The pragma is analyzed at the end of the declarative part which
-- contains the related subprogram. Reset the analyzed flag.
Set_Analyzed (N, False);
-- Ensure the proper placement of the pragma. Contract_Cases must
-- be associated with a subprogram declaration or a body that acts
-- as a spec.
@ -11140,11 +11146,6 @@ package body Sem_Prag is
return;
end if;
-- The pragma is analyzed at the end of the declarative part which
-- contains the related subprogram. Reset the analyzed flag.
Set_Analyzed (N, False);
-- When the pragma appears on a subprogram body, perform the full
-- analysis now.

View File

@ -4982,6 +4982,35 @@ package body Sem_Util is
end if;
end Enter_Name;
---------------
-- Entity_Of --
---------------
function Entity_Of (N : Node_Id) return Entity_Id is
Id : Entity_Id;
begin
Id := Empty;
if Is_Entity_Name (N) then
Id := Entity (N);
-- Follow a possible chain of renamings to reach the root renamed
-- object.
while Present (Id) and then Present (Renamed_Object (Id)) loop
if Is_Entity_Name (Renamed_Object (Id)) then
Id := Entity (Renamed_Object (Id));
else
Id := Empty;
exit;
end if;
end loop;
end if;
return Id;
end Entity_Of;
--------------------------
-- Explain_Limited_Type --
--------------------------

View File

@ -481,6 +481,10 @@ package Sem_Util is
-- Note: Enter_Name is not used for overloadable entities, instead these
-- are entered using Sem_Ch6.Enter_Overloadable_Entity.
function Entity_Of (N : Node_Id) return Entity_Id;
-- Return the entity of N or Empty. If N is a renaming, return the entity
-- of the root renamed object.
procedure Explain_Limited_Type (T : Entity_Id; N : Node_Id);
-- This procedure is called after issuing a message complaining about an
-- inappropriate use of limited type T. If useful, it adds additional