[Ada] Improper copying of limited arrays with default initialization

This patch fixes an improper expansion of aggregates for limited array
types in an object declaration. Prior to this patch, The presence of the
aggregate (which can only consist of box initializations) would create a
temporary that was then assigned to the object in the declaration.
Apart from a violation of the semantics of build-in-place limited
objects, this can also lead to out-of-scope access in LLVM.

Executing the following;

   gcc -c -gnatDG nocopy.adb
   grep quintet nocopy.adb.dg | wc -l

must yield:

   5

----
procedure NoCopy is

  --  Task used in this example to test that the limited component
  --  is properly initialized.

  task type T_Task (Disc : Natural);

  task body T_Task is
  begin
     null;
  end T_Task;

  type My_Rec (D : Natural := 9999) is record

     --  Components initialized by means of the current value
     --  of the record discriminant

     T : T_Task (D);
  end record;

  type TR is array (1 .. 5) of My_Rec;
  Quintet : TR := (others => (others => <>));
begin
   null;
end NoCopy;

2018-08-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_aggr.adb (Expand_Array_Aggregate): If the component type
	is limited, the array must be constructed in place, so set flag
	In_Place_Assign_OK_For_Declaration accordingly. This prevents
	improper copying of an array of tasks during initialization.

From-SVN: r263719

2 files changed, 33 insertions, 7 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e882e39..d0ad28d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-08-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Expand_Array_Aggregate): If the component type
+	is limited, the array must be constructed in place, so set flag
+	In_Place_Assign_OK_For_Declaration accordingly. This prevents
+	improper copying of an array of tasks during initialization.
+
 2018-08-21  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/trans.c (Call_to_gnu): Always suppress an
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 9d9ab6a..d1d9c12 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6195,10 +6195,11 @@ package body Exp_Aggr is
       --  Look if in place aggregate expansion is possible
 
       --  For object declarations we build the aggregate in place, unless
-      --  the array is bit-packed or the component is controlled.
+      --  the array is bit-packed.
 
       --  For assignments we do the assignment in place if all the component
-      --  associations have compile-time known values. For other cases we
+      --  associations have compile-time known values, or are default-
+      --  initialized limited components, e.g. tasks. For other cases we
       --  create a temporary. The analysis for safety of on-line assignment
       --  is delicate, i.e. we don't know how to do it fully yet ???
 
@@ -6211,7 +6212,12 @@ package body Exp_Aggr is
          Establish_Transient_Scope (N, Manage_Sec_Stack => False);
       end if;
 
-      if Has_Default_Init_Comps (N) then
+      --  An array of limited components is built in place.
+
+      if Is_Limited_Type (Typ) then
+         Maybe_In_Place_OK := True;
+
+      elsif Has_Default_Init_Comps (N) then
          Maybe_In_Place_OK := False;
 
       elsif Is_Bit_Packed_Array (Typ)
@@ -6247,15 +6253,17 @@ package body Exp_Aggr is
       --  expected to appear in qualified form. In-place expansion eliminates
       --  the qualification and eventually violates this SPARK 05 restiction.
 
-      --  Should document the rest of the guards ???
+      --  Arrays of limited components must be built in place. The code
+      --  previously excluded controlled components but this is an old
+      --  oversight: the rules in 7.6 (17) are clear.
 
-      if not Has_Default_Init_Comps (N)
+      if (not Has_Default_Init_Comps (N)
+            or else Is_Limited_Type (Etype (N)))
         and then Comes_From_Source (Parent_Node)
         and then Parent_Kind = N_Object_Declaration
         and then Present (Expression (Parent_Node))
         and then not
           Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
-        and then not Has_Controlled_Component (Typ)
         and then not Is_Bit_Packed_Array (Typ)
         and then not Restriction_Check_Required (SPARK_05)
       then
@@ -6292,6 +6300,15 @@ package body Exp_Aggr is
          Set_Expansion_Delayed (N);
          return;
 
+      --  Limited arrays in return statements are expanded when
+      --  enclosing construct is expanded.
+
+      elsif Maybe_In_Place_OK
+        and then Nkind (Parent (N)) = N_Simple_Return_Statement
+      then
+         Set_Expansion_Delayed (N);
+         return;
+
       --  In the remaining cases the aggregate is the RHS of an assignment
 
       elsif Maybe_In_Place_OK
@@ -6365,7 +6382,9 @@ package body Exp_Aggr is
             Target := New_Occurrence_Of (Tmp, Loc);
 
          else
-            if Has_Default_Init_Comps (N) then
+            if Has_Default_Init_Comps (N)
+              and then not Maybe_In_Place_OK
+            then
 
                --  Ada 2005 (AI-287): This case has not been analyzed???