[Ada] Box-initialized components of aggregates in allocators

[Arnaud Charlet]

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  <schonberg@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.

-------------- next part --------------
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;