If a record component is constrained with a current instance, that is to say an access to the enclosing type, an initialization call for the component must use a reference to the target object. Previously this was done when generating the code for the initialization procedure for the encloing record, but such a call can also be generated for an aggregate.
The following must compile quietly in Ada2005 mode: --- package Small_Class is type Instance is limited private; type Instance_P is access all Instance; function Create (Index : Integer) return Instance_P; procedure Start (This : Instance_P); private task type T (This : not null access Instance) is entry Start; end T; type Instance is limited record The_T : T (This => Instance'Access); Index : Integer := 0; end record; end Small_Class; --- with Ada.Text_IO; use Ada.Text_IO; package body Small_Class is task body T is begin accept Start; Put_Line ("T (" & Integer'Image (This.Index) & " ) started."); end T; function Create (Index : Integer) return Instance_P is -- Result : Instance_P := new Instance; begin -- Result.Index := Index; -- return Result; return new Instance'(Index => Index, others => <>); end Create; procedure Start (This : Instance_P) is begin This.The_T.Start; end Start; end Small_Class; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-06 Ed Schonberg <schonb...@adacore.com> * exp_ch3.adb (Build_Initialization_Call): If the target is a selected component discriminated by a current instance, replace the constraint with a reference to the target object, regardless of whether the context is an init_proc.
Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 178565) +++ exp_ch3.adb (working copy) @@ -1563,8 +1563,22 @@ Discriminant_Constraint (Full_Type)); end; - if In_Init_Proc then + -- If the target has access discriminants, and is constrained by + -- an access to the enclosing construct, i.e. a current instance, + -- replace the reference to the type by a reference to the object. + if Nkind (Arg) = N_Attribute_Reference + and then Is_Access_Type (Etype (Arg)) + and then Is_Entity_Name (Prefix (Arg)) + and then Is_Type (Entity (Prefix (Arg))) + then + Arg := + Make_Attribute_Reference (Loc, + Prefix => New_Copy (Prefix (Id_Ref)), + Attribute_Name => Name_Unrestricted_Access); + + elsif In_Init_Proc then + -- Replace any possible references to the discriminant in the -- call to the record initialization procedure with references -- to the appropriate formal parameter. @@ -1574,19 +1588,6 @@ then Arg := New_Reference_To (Discriminal (Entity (Arg)), Loc); - -- Case of access discriminants. We replace the reference - -- to the type by a reference to the actual object - - elsif Nkind (Arg) = N_Attribute_Reference - and then Is_Access_Type (Etype (Arg)) - and then Is_Entity_Name (Prefix (Arg)) - and then Is_Type (Entity (Prefix (Arg))) - then - Arg := - Make_Attribute_Reference (Loc, - Prefix => New_Copy (Prefix (Id_Ref)), - Attribute_Name => Name_Unrestricted_Access); - -- Otherwise make a copy of the default expression. Note that -- we use the current Sloc for this, because we do not want the -- call to appear to be at the declaration point. Within the