[Ada] Fix recent regression on array aggregate with dynamic subtype

This prevents either a crash or an assertion failure in gigi on an array
with dynamic subtype that is wrongly flagged as static by the front-end
because of a recent improvement made in the handling of nested
aggregates.

The patch reuses the existing Static_Array_Aggregate predicate instead
of fixing the problematic test, pluging a few loopholes in the process.
The predicate is conservatively correct but should be good enough in
practice.

2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Convert_To_Positional): Use
	Static_Array_Aggregate to decide whether to set
	Compile_Time_Known_Aggregate on an already flat aggregate.
	(Expand_Array_Aggregate): Remove test on
	Compile_Time_Known_Aggregate that turns out to be dead and
	simplify.
	(Is_Static_Component): New predicate extracted from...
	(Static_Array_Aggregate): ...here.  Test neither Is_Tagged_Type
	nor Is_Controlled for the type, but test whether the component
	type has discriminants.  Use the Is_Static_Component predicate
	consistently for the positional and named cases.

gcc/testsuite/

	* gnat.dg/array32.adb, gnat.dg/array32.ads: New testcase.

From-SVN: r266755

gcc/ada/ChangeLog

@@ -1,3 +1,17 @@
+2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_aggr.adb (Convert_To_Positional): Use
+	Static_Array_Aggregate to decide whether to set
+	Compile_Time_Known_Aggregate on an already flat aggregate.
+	(Expand_Array_Aggregate): Remove test on
+	Compile_Time_Known_Aggregate that turns out to be dead and
+	simplify.
+	(Is_Static_Component): New predicate extracted from...
+	(Static_Array_Aggregate): ...here.  Test neither Is_Tagged_Type
+	nor Is_Controlled for the type, but test whether the component
+	type has discriminants.  Use the Is_Static_Component predicate
+	consistently for the positional and named cases.
+
 2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* freeze.adb (Freeze_Entity): Do not freeze the partial view of

gcc/ada/exp_aggr.adb

@@ -4759,17 +4759,8 @@ package body Exp_Aggr is
       --  initial value of a thread-local variable.
 
       if Is_Flat (N, Number_Dimensions (Typ)) then
-         Check_Static_Components;
-         if Static_Components then
-            if Is_Packed (Etype (N))
-              or else
-                (Is_Record_Type (Component_Type (Etype (N)))
-                  and then Has_Discriminants (Component_Type (Etype (N))))
-            then
-               null;
-            else
-               Set_Compile_Time_Known_Aggregate (N);
-            end if;
+         if Static_Array_Aggregate (N) then
+            Set_Compile_Time_Known_Aggregate (N);
          end if;
 
          return;
@@ -6205,15 +6196,8 @@ package body Exp_Aggr is
         or else (Parent_Kind = N_Assignment_Statement
                   and then Inside_Init_Proc)
       then
-         if Static_Array_Aggregate (N)
-           or else Compile_Time_Known_Aggregate (N)
-         then
-            Set_Expansion_Delayed (N, False);
-            return;
-         else
-            Set_Expansion_Delayed (N);
-            return;
-         end if;
+         Set_Expansion_Delayed (N, not Static_Array_Aggregate (N));
+         return;
       end if;
 
       --  STEP 4
@@ -8506,20 +8490,48 @@ package body Exp_Aggr is
    ----------------------------
 
    function Static_Array_Aggregate (N : Node_Id) return Boolean is
+
+      function Is_Static_Component (N : Node_Id) return Boolean;
+      --  Return True if N has a compile-time known value and can be passed as
+      --  is to the back-end without further expansion.
+
+      ---------------------------
+      --  Is_Static_Component  --
+      ---------------------------
+
+      function Is_Static_Component (N : Node_Id) return Boolean is
+      begin
+         if Nkind_In (N, N_Integer_Literal, N_Real_Literal) then
+            return True;
+
+         elsif Is_Entity_Name (N)
+           and then Present (Entity (N))
+           and then Ekind (Entity (N)) = E_Enumeration_Literal
+         then
+            return True;
+
+         elsif Nkind (N) = N_Aggregate
+           and then Compile_Time_Known_Aggregate (N)
+         then
+            return True;
+
+         else
+            return False;
+         end if;
+      end Is_Static_Component;
+
       Bounds : constant Node_Id := Aggregate_Bounds (N);
 
       Typ       : constant Entity_Id := Etype (N);
-      Comp_Type : constant Entity_Id := Component_Type (Typ);
       Agg       : Node_Id;
       Expr      : Node_Id;
       Lo        : Node_Id;
       Hi        : Node_Id;
 
+   --  Start of processing for Static_Array_Aggregate
+
    begin
-      if Is_Tagged_Type (Typ)
-        or else Is_Controlled (Typ)
-        or else Is_Packed (Typ)
-      then
+      if Is_Packed (Typ) or else Has_Discriminants (Component_Type (Typ)) then
          return False;
       end if;
 
@@ -8533,11 +8545,11 @@ package body Exp_Aggr is
 
          if No (Component_Associations (N)) then
 
-            --  Verify that all components are static integers
+            --  Verify that all components are static
 
             Expr := First (Expressions (N));
             while Present (Expr) loop
-               if Nkind (Expr) /= N_Integer_Literal then
+               if not Is_Static_Component (Expr) then
                   return False;
                end if;
 
@@ -8567,17 +8579,7 @@ package body Exp_Aggr is
                --  component type. We also limit the size of a static aggregate
                --  to prevent runaway static expressions.
 
-               if Is_Array_Type (Comp_Type)
-                 or else Is_Record_Type (Comp_Type)
-               then
-                  if Nkind (Expression (Expr)) /= N_Aggregate
-                    or else
-                      not Compile_Time_Known_Aggregate (Expression (Expr))
-                  then
-                     return False;
-                  end if;
-
-               elsif Nkind (Expression (Expr)) /= N_Integer_Literal then
+               if not Is_Static_Component (Expression (Expr)) then
                   return False;
                end if;
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/array32.adb, gnat.dg/array32.ads: New testcase.
+
 2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/generic_inst2.adb, gnat.dg/generic_inst2.ads,

gcc/testsuite/gnat.dg/array32.adb

@@ -0,0 +1,10 @@
+--  { dg-do compile }
+
+package body Array32 is
+
+   procedure Init (A : out Arr) is
+   begin
+      A := ((I => 1), (I => 2));
+   end;
+
+end Array32;

gcc/testsuite/gnat.dg/array32.ads

@@ -0,0 +1,11 @@
+package Array32 is
+
+   type Rec is record
+      I : Integer;
+   end record;
+
+   type Arr is array (Positive range <>) of Rec;
+
+   procedure Init (A : out Arr);
+
+end Array32;