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
