Box-initialized components are replaced with calls to the corresponding
initialization procedures during resolution of the aggregate. This requires
that the type of the aggregate and that of all its components be frozen before
resolution is completed. In addition, such an aggregate may be the designated
object of an access-to-constant object, and it can legally appear as an in-out
parameter in a call to the corresponding initialization procedure.
The following commands
gnatmake -q -gnat05 main
main
must yield:
3.14150000000000E+00
3.14150000000000E+00
---
with A;
with Text_IO; use Text_IO;
procedure Main is
Instance_OK : A.T_Record_Access :=
new A.T_Record'(My_Record => <>);
Instance_KO : A.T_Record_Access_Constant :=
new A.T_Record'(My_Record => <>);
begin
Put_Line (Long_Float'Image (Instance_KO.My_Record.A_Value));
Put_Line (Long_Float'Image (A.Local_Instance_OK.My_Record.A_Value));
end Main;
---
package A is
type T_Inner_Record is record
A_Value : Long_Float := 3.1415;
end record;
type T_Record is record
My_Record : T_Inner_Record;
end record;
type T_Record_Access_Constant is access constant T_Record;
type T_Record_Access is access T_Record;
Local_Instance_OK : T_Record_Access_Constant :=
new T_Record'(My_Record => <>);
end A;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Ed Schonberg <schonb...@adacore.com>
* sem_aggr.adb (Resolve_Aggregate): If aggregate has box-initialized
components, freeze type before resolution, to ensure that default
initializations are present for all components.
* sem_res.adb (Resolve_Actuals): the designated object of an
accces-to-constant type is a legal actual in a call to an
initialization procedure.
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 177275)
+++ sem_aggr.adb (working copy)
@@ -978,6 +978,30 @@
return;
end if;
+ -- If the aggregate has box-initialized components, its type must be
+ -- frozen so that initialization procedures can properly be called
+ -- in the resolution that follows. The replacement of boxes with
+ -- initialization calls is properly an expansion activity but it must
+ -- be done during revolution.
+
+ if Expander_Active
+ and then Present (Component_Associations (N))
+ then
+ declare
+ Comp : Node_Id;
+
+ begin
+ Comp := First (Component_Associations (N));
+ while Present (Comp) loop
+ if Box_Present (Comp) then
+ Insert_Actions (N, Freeze_Entity (Typ, N));
+ exit;
+ end if;
+ Next (Comp);
+ end loop;
+ end;
+ end if;
+
-- An unqualified aggregate is restricted in SPARK to:
-- An aggregate item inside an aggregate for a multi-dimensional array
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 177342)
+++ sem_res.adb (working copy)
@@ -3736,7 +3736,13 @@
-- Is_OK_Variable_For_Out_Formal generates the required
-- reference in this case.
- if not Is_OK_Variable_For_Out_Formal (A) then
+ -- A call to an initialization procedure for an aggregate
+ -- component may initialize a nested component of a constant
+ -- designated object. In this context the object is variable.
+
+ if not Is_OK_Variable_For_Out_Formal (A)
+ and then not Is_Init_Proc (Nam)
+ then
Error_Msg_NE ("actual for& must be a variable", A, F);
end if;
