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>
|
2013-10-17 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
* exp_util.adb (Get_Current_Value_Condition,
|
* exp_util.adb (Get_Current_Value_Condition,
|
||||||
|
|
|
@ -1771,35 +1771,6 @@ package body Exp_Util is
|
||||||
end if;
|
end if;
|
||||||
end Ensure_Defined;
|
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 --
|
-- Entry_Names_OK --
|
||||||
--------------------
|
--------------------
|
||||||
|
|
|
@ -349,10 +349,6 @@ package Exp_Util is
|
||||||
-- used to ensure that an Itype is properly defined outside a conditional
|
-- used to ensure that an Itype is properly defined outside a conditional
|
||||||
-- construct when it is referenced in more than one branch.
|
-- 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;
|
function Entry_Names_OK return Boolean;
|
||||||
-- Determine whether it is appropriate to dynamically allocate strings
|
-- Determine whether it is appropriate to dynamically allocate strings
|
||||||
-- which represent entry [family member] names. These strings are created
|
-- which represent entry [family member] names. These strings are created
|
||||||
|
|
|
@ -1856,7 +1856,7 @@ package body Sem_Prag is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (List) = N_Null then
|
if Nkind (List) = N_Null then
|
||||||
null;
|
Set_Analyzed (List);
|
||||||
|
|
||||||
-- Single global item declaration
|
-- Single global item declaration
|
||||||
|
|
||||||
|
@ -1869,6 +1869,7 @@ package body Sem_Prag is
|
||||||
-- Simple global list or moded global list declaration
|
-- Simple global list or moded global list declaration
|
||||||
|
|
||||||
elsif Nkind (List) = N_Aggregate then
|
elsif Nkind (List) = N_Aggregate then
|
||||||
|
Set_Analyzed (List);
|
||||||
|
|
||||||
-- The declaration of a simple global list appear as a collection
|
-- The declaration of a simple global list appear as a collection
|
||||||
-- of expressions.
|
-- of expressions.
|
||||||
|
@ -1985,7 +1986,7 @@ package body Sem_Prag is
|
||||||
-- There is nothing to be done for a null global list
|
-- There is nothing to be done for a null global list
|
||||||
|
|
||||||
if Nkind (Items) = N_Null then
|
if Nkind (Items) = N_Null then
|
||||||
null;
|
Set_Analyzed (Items);
|
||||||
|
|
||||||
-- Analyze the various forms of global lists and items. Note that some
|
-- Analyze the various forms of global lists and items. Note that some
|
||||||
-- of these may be malformed in which case the analysis emits error
|
-- 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
|
-- The input cannot denote states or variables declared
|
||||||
-- within the related package.
|
-- 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_Name_1 := Chars (Pack_Id);
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("input item & cannot denote a visible variable or "
|
("input item & cannot denote a visible variable or "
|
||||||
|
@ -11125,6 +11126,11 @@ package body Sem_Prag is
|
||||||
GNAT_Pragma;
|
GNAT_Pragma;
|
||||||
Check_Arg_Count (1);
|
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
|
-- Ensure the proper placement of the pragma. Contract_Cases must
|
||||||
-- be associated with a subprogram declaration or a body that acts
|
-- be associated with a subprogram declaration or a body that acts
|
||||||
-- as a spec.
|
-- as a spec.
|
||||||
|
@ -11140,11 +11146,6 @@ package body Sem_Prag is
|
||||||
return;
|
return;
|
||||||
end if;
|
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
|
-- When the pragma appears on a subprogram body, perform the full
|
||||||
-- analysis now.
|
-- analysis now.
|
||||||
|
|
||||||
|
|
|
@ -4982,6 +4982,35 @@ package body Sem_Util is
|
||||||
end if;
|
end if;
|
||||||
end Enter_Name;
|
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 --
|
-- Explain_Limited_Type --
|
||||||
--------------------------
|
--------------------------
|
||||||
|
|
|
@ -481,6 +481,10 @@ package Sem_Util is
|
||||||
-- Note: Enter_Name is not used for overloadable entities, instead these
|
-- Note: Enter_Name is not used for overloadable entities, instead these
|
||||||
-- are entered using Sem_Ch6.Enter_Overloadable_Entity.
|
-- 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);
|
procedure Explain_Limited_Type (T : Entity_Id; N : Node_Id);
|
||||||
-- This procedure is called after issuing a message complaining about an
|
-- This procedure is called after issuing a message complaining about an
|
||||||
-- inappropriate use of limited type T. If useful, it adds additional
|
-- inappropriate use of limited type T. If useful, it adds additional
|
||||||
|
|
Loading…
Add table
Reference in a new issue