Proc_Id : Entity_Id;
Rec_Type : Entity_Id;
Set_Tag : Entity_Id := Empty;
+ Has_Late_Init_Comp : Boolean := False; -- set in Build_Init_Statements
function Build_Assignment
(Id : Entity_Id;
Selector_Name => New_Occurrence_Of (Id, Default_Loc));
Set_Assignment_OK (Lhs);
- -- Case of an access attribute applied to the current instance.
- -- Replace the reference to the type by a reference to the actual
- -- object. (Note that this handles the case of the top level of
- -- the expression being given by such an attribute, but does not
- -- cover uses nested within an initial value expression. Nested
- -- uses are unlikely to occur in practice, but are theoretically
- -- possible.) It is not clear how to handle them without fully
- -- traversing the expression. ???
-
- if Kind = N_Attribute_Reference
- and then Attribute_Name (Default) in Name_Unchecked_Access
- | Name_Unrestricted_Access
- and then Is_Entity_Name (Prefix (Default))
- and then Is_Type (Entity (Prefix (Default)))
- and then Entity (Prefix (Default)) = Rec_Type
- then
- Exp :=
- Make_Attribute_Reference (Default_Loc,
- Prefix =>
- Make_Identifier (Default_Loc, Name_uInit),
- Attribute_Name => Name_Unrestricted_Access);
- end if;
-
-- Take a copy of Exp to ensure that later copies of this component
-- declaration in derived types see the original tree, not a node
-- rewritten during expansion of the init_proc. If the copy contains
-- itypes, the scope of the new itypes is the init_proc being built.
- Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id);
+ declare
+ Map : Elist_Id := No_Elist;
+ begin
+ if Has_Late_Init_Comp then
+ -- Map the type to the _Init parameter in order to
+ -- handle "current instance" references.
+
+ Map := New_Elmt_List
+ (Elmt1 => Rec_Type,
+ Elmt2 => Defining_Identifier (First
+ (Parameter_Specifications
+ (Parent (Proc_Id)))));
+ end if;
+
+ Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id, Map => Map);
+ end;
Res := New_List (
Make_Assignment_Statement (Loc,
Counter_Id : Entity_Id := Empty;
Comp_Loc : Source_Ptr;
Decl : Node_Id;
- Has_Late_Init_Comp : Boolean;
Id : Entity_Id;
Parent_Stmts : List_Id;
Stmts : List_Id;
function Find_Current_Instance
(N : Node_Id) return Traverse_Result is
begin
- if Nkind (N) = N_Attribute_Reference
- and then Is_Access_Type (Etype (N))
- and then Is_Entity_Name (Prefix (N))
- and then Is_Type (Entity (Prefix (N)))
+ if Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then Is_Current_Instance (N)
then
References_Current_Instance := True;
return Abandon;
-- step deals with regular components. The second step deals with
-- components that require late initialization.
- Has_Late_Init_Comp := False;
-
-- First pass : regular components
Decl := First_Non_Pragma (Component_Items (Comp_List));
-- statement is aliased if its type is immutably limited.
or else (Is_Return_Object (E)
+ and then Is_Limited_View (Etype (E)))
+
+ -- The current instance of a limited type is aliased, so
+ -- we want to allow uses of T'Access in the init proc for
+ -- a limited type T. However, we don't want to mark the formal
+ -- parameter as being aliased since that could impact callers.
+
+ or else (Is_Formal (E)
+ and then Chars (E) = Name_uInit
and then Is_Limited_View (Etype (E)));
elsif Nkind (Obj) = N_Selected_Component then
-- This is because the parser always checks that prefixes of attributes
-- are named.
- return not (Is_Entity_Name (Prefix) and then Is_Type (Entity (Prefix)));
+ return not (Is_Entity_Name (Prefix)
+ and then Is_Type (Entity (Prefix))
+ and then not Is_Current_Instance (Prefix));
end Is_Object_Image;
-------------------------