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:
parent
064f4527c4
commit
275d8313ba
6 changed files with 54 additions and 41 deletions
|
@ -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,
|
||||
|
|
|
@ -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 --
|
||||
--------------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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 --
|
||||
--------------------------
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue