@@ -11870,10 +11870,14 @@ package body Sem_Ch3 is
else
-- Specialize error message according to kind of illegal
- -- initial expression.
+ -- initial expression. We check the Original_Node to cover
+ -- cases where the initialization expression of an object
+ -- declaration generated by the compiler has been rewritten
+ -- (such as for dispatching calls).
- if Nkind (Exp) = N_Type_Conversion
- and then Nkind (Expression (Exp)) = N_Function_Call
+ if Nkind (Original_Node (Exp)) = N_Type_Conversion
+ and then
+ Nkind (Expression (Original_Node (Exp))) = N_Function_Call
then
-- No error for internally-generated object declarations,
-- which can come from build-in-place assignment statements.
@@ -19648,8 +19652,20 @@ package body Sem_Ch3 is
=>
return not Comes_From_Source (Exp)
and then
- OK_For_Limited_Init_In_05
- (Typ, Expression (Original_Node (Exp)));
+ -- If the conversion has been rewritten, check Original_Node
+
+ ((Original_Node (Exp) /= Exp
+ and then
+ OK_For_Limited_Init_In_05 (Typ, Original_Node (Exp)))
+
+ -- Otherwise, check the expression of the compiler-generated
+ -- conversion (which is a conversion that we want to ignore
+ -- for purposes of the limited-initialization restrictions).
+
+ or else
+ (Original_Node (Exp) = Exp
+ and then
+ OK_For_Limited_Init_In_05 (Typ, Expression (Exp))));
when N_Explicit_Dereference
| N_Indexed_Component
new file mode 100644
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+
+package body Type_Conv2 is
+
+ function Wrap (X : Integer) return Root'Class is
+ begin
+ return Der_I'(X => X);
+ end Wrap;
+
+ procedure Proc_Static is
+ D : constant Der_I := Der_I (Wrap (0)); -- { dg-error "initialization of limited object requires aggregate or function call" }
+ begin
+ null;
+ end Proc_Static;
+
+end Type_Conv2;
new file mode 100644
@@ -0,0 +1,13 @@
+package Type_Conv2 is
+
+ type Root is abstract tagged limited null record;
+
+ type Der_I is new Root with record
+ X : Integer;
+ end record;
+
+ function Wrap (X : Integer) return Root'Class;
+
+ procedure Proc_Static;
+
+end Type_Conv2;