===================================================================
@@ -4841,11 +4841,11 @@
return;
-- Ada 2005 (AI-251): Rewrite the expression that initializes a
- -- class-wide object to ensure that we copy the full object,
- -- unless we are targetting a VM where interfaces are handled by
- -- VM itself. Note that if the root type of Typ is an ancestor
- -- of Expr's type, both types share the same dispatch table and
- -- there is no need to displace the pointer.
+ -- class-wide interface object to ensure that we copy the full
+ -- object, unless we are targetting a VM where interfaces are handled
+ -- by VM itself. Note that if the root type of Typ is an ancestor of
+ -- Expr's type, both types share the same dispatch table and there is
+ -- no need to displace the pointer.
elsif Comes_From_Source (N)
and then Is_Interface (Typ)
@@ -4978,14 +4978,32 @@
-- Copy the object
- Insert_Action (N,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Obj_Id,
- Object_Definition =>
- New_Occurrence_Of
- (Etype (Object_Definition (N)), Loc),
- Expression => New_Expr));
+ if not Is_Limited_Record (Expr_Typ) then
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Obj_Id,
+ Object_Definition =>
+ New_Occurrence_Of
+ (Etype (Object_Definition (N)), Loc),
+ Expression => New_Expr));
+ -- Rename limited type object since they cannot be copied
+ -- This case occurs when the initialization expression
+ -- has been previously expanded into a temporary object.
+
+ else pragma Assert (not Comes_From_Source (Expr_Q));
+
+ Insert_Action (N,
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Obj_Id,
+ Subtype_Mark =>
+ New_Occurrence_Of
+ (Etype (Object_Definition (N)), Loc),
+ Name =>
+ Unchecked_Convert_To
+ (Etype (Object_Definition (N)), New_Expr)));
+ end if;
+
-- Dynamically reference the tag associated with the
-- interface.