-----------------------------
procedure Analyze_Object_Renaming (N : Node_Id) is
- Id : constant Entity_Id := Defining_Identifier (N);
- Loc : constant Source_Ptr := Sloc (N);
- Nam : constant Node_Id := Name (N);
- Dec : Node_Id;
- T : Entity_Id;
- T2 : Entity_Id;
+ Id : constant Entity_Id := Defining_Identifier (N);
+ Loc : constant Source_Ptr := Sloc (N);
+ Nam : constant Node_Id := Name (N);
+ Is_Object_Ref : Boolean := False;
+ Dec : Node_Id;
+ T : Entity_Id;
+ T2 : Entity_Id;
procedure Check_Constrained_Object;
-- If the nominal type is unconstrained but the renamed object is
Mark_Ghost_Renaming (N, Entity (Nam));
end if;
- -- Reject renamings of conversions unless the type is tagged, or
- -- the conversion is implicit (which can occur for cases of anonymous
- -- access types in Ada 2012).
-
- if Nkind (Nam) = N_Type_Conversion
- and then Comes_From_Source (Nam)
- and then not Is_Tagged_Type (T)
- then
- Error_Msg_N
- ("renaming of conversion only allowed for tagged types", Nam);
- end if;
-
Resolve (Nam, T);
-- If the renamed object is a function call of a limited type,
return;
end if;
- -- Ada 2005 (AI-327)
-
- if Ada_Version >= Ada_2005
- and then Nkind (Nam) = N_Attribute_Reference
- and then Attribute_Name (Nam) = Name_Priority
- then
- null;
-
- elsif Ada_Version >= Ada_2005 and then Nkind (Nam) in N_Has_Entity then
+ if Ada_Version >= Ada_2005 and then Nkind (Nam) in N_Has_Entity then
declare
Nam_Ent : constant Entity_Id := Entity (Get_Object_Name (Nam));
Nam_Decl : constant Node_Id := Declaration_Node (Nam_Ent);
Init_Object_Size_Align (Id);
+ -- If N comes from source then check that the original node is an
+ -- object reference since there may have been several rewritting and
+ -- folding. Do not do this for N_Function_Call or N_Explicit_Dereference
+ -- which might correspond to rewrites of e.g. N_Selected_Component
+ -- (for example Object.Method rewriting).
+ -- If N does not come from source then assume the tree is properly
+ -- formed and accept any object reference. In such cases we do support
+ -- more cases of renamings anyway, so the actual check on which renaming
+ -- is valid is better left to the code generator as a last sanity
+ -- check.
+
+ if Comes_From_Source (N) then
+ if Nkind_In (Nam, N_Function_Call, N_Explicit_Dereference) then
+ Is_Object_Ref := Is_Object_Reference (Nam);
+ else
+ Is_Object_Ref := Is_Object_Reference (Original_Node (Nam));
+ end if;
+ else
+ Is_Object_Ref := True;
+ end if;
+
if T = Any_Type or else Etype (Nam) = Any_Type then
return;
- -- Verify that the renamed entity is an object or a function call. It
- -- may have been rewritten in several ways.
+ -- Verify that the renamed entity is an object or function call.
- elsif Is_Object_Reference (Nam) then
+ elsif Is_Object_Ref then
if Comes_From_Source (N) then
if Is_Dependent_Component_Of_Mutable_Object (Nam) then
Error_Msg_N
end if;
end if;
- -- A static function call may have been folded into a literal
+ -- Weird but legal, equivalent to renaming a function call. Illegal
+ -- if the literal is the result of constant-folding an attribute
+ -- reference that is not a function.
- elsif Nkind (Original_Node (Nam)) = N_Function_Call
-
- -- When expansion is disabled, attribute reference is not rewritten
- -- as function call. Otherwise it may be rewritten as a conversion,
- -- so check original node.
-
- or else (Nkind (Original_Node (Nam)) = N_Attribute_Reference
- and then Is_Function_Attribute_Name
- (Attribute_Name (Original_Node (Nam))))
-
- -- Weird but legal, equivalent to renaming a function call. Illegal
- -- if the literal is the result of constant-folding an attribute
- -- reference that is not a function.
-
- or else (Is_Entity_Name (Nam)
- and then Ekind (Entity (Nam)) = E_Enumeration_Literal
- and then
- Nkind (Original_Node (Nam)) /= N_Attribute_Reference)
-
- or else (Nkind (Nam) = N_Type_Conversion
- and then Is_Tagged_Type (Entity (Subtype_Mark (Nam))))
- then
- null;
-
- elsif Nkind (Nam) = N_Type_Conversion then
- Error_Msg_N
- ("renaming of conversion only allowed for tagged types", Nam);
-
- -- Ada 2005 (AI-327)
-
- elsif Ada_Version >= Ada_2005
- and then Nkind (Nam) = N_Attribute_Reference
- and then Attribute_Name (Nam) = Name_Priority
+ elsif Is_Entity_Name (Nam)
+ and then Ekind (Entity (Nam)) = E_Enumeration_Literal
+ and then Nkind (Original_Node (Nam)) /= N_Attribute_Reference
then
null;
-
- -- Allow internally generated x'Ref resulting in N_Reference node
-
- elsif Nkind (Nam) = N_Reference then
- null;
-
else
Error_Msg_N ("expect object name in renaming", Nam);
end if;
-------------------------
function Is_Object_Reference (N : Node_Id) return Boolean is
- function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean;
- -- Determine whether N is the name of an internally-generated renaming
-
- --------------------------------------
- -- Is_Internally_Generated_Renaming --
- --------------------------------------
-
- function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean is
- P : Node_Id;
-
- begin
- P := N;
- while Present (P) loop
- if Nkind (P) = N_Object_Renaming_Declaration then
- return not Comes_From_Source (P);
- elsif Is_List_Member (P) then
- return False;
- end if;
-
- P := Parent (P);
- end loop;
-
- return False;
- end Is_Internally_Generated_Renaming;
-
- -- Start of processing for Is_Object_Reference
-
begin
if Is_Entity_Name (N) then
return Present (Entity (N)) and then Is_Object (Entity (N));
=>
return Etype (N) /= Standard_Void_Type;
- -- Attributes references 'Loop_Entry, 'Old, and 'Result yield
- -- objects, even though they are not functions.
+ -- Attributes references 'Loop_Entry, 'Old, 'Priority and 'Result
+ -- yield objects, even though they are not functions.
when N_Attribute_Reference =>
return
Nam_In (Attribute_Name (N), Name_Loop_Entry,
Name_Old,
+ Name_Priority,
Name_Result)
or else Is_Function_Attribute_Name (Attribute_Name (N));
-- A view conversion of a tagged object is an object reference
when N_Type_Conversion =>
- return Is_Tagged_Type (Etype (Subtype_Mark (N)))
- and then Is_Tagged_Type (Etype (Expression (N)))
- and then Is_Object_Reference (Expression (N));
+ if Ada_Version <= Ada_2012 then
+ -- A view conversion of a tagged object is an object
+ -- reference.
+ return Is_Tagged_Type (Etype (Subtype_Mark (N)))
+ and then Is_Tagged_Type (Etype (Expression (N)))
+ and then Is_Object_Reference (Expression (N));
+
+ else
+ -- AI12-0226: In Ada 202x a value conversion of an object is
+ -- an object.
+
+ return Is_Object_Reference (Expression (N));
+ end if;
-- An unchecked type conversion is considered to be an object if
-- the operand is an object (this construction arises only as a
when N_Unchecked_Type_Conversion =>
return True;
- -- Allow string literals to act as objects as long as they appear
- -- in internally-generated renamings. The expansion of iterators
- -- may generate such renamings when the range involves a string
- -- literal.
-
- when N_String_Literal =>
- return Is_Internally_Generated_Renaming (Parent (N));
-
-- AI05-0003: In Ada 2012 a qualified expression is a name.
-- This allows disambiguation of function calls and the use
-- of aggregates in more contexts.
projects / platform / upstream / gcc.git / commitdiff