[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2a3ff0ff548d239886b64b582bae1d38c0aae1c4..132cc0a76fd961c7bbdaf21e80feff8917b45225 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/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

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 866abed39205ecfa76cc81832045755bed11b8d7..45d517d1cb20d55d47410f012e11ba2a68359e20 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/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;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2e63d0ad405412d2a76109d2765b233b0c084634..110932fdbbb65579cf4d372407b75c9d70f319b4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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,

diff --git a/gcc/testsuite/gnat.dg/array32.adb b/gcc/testsuite/gnat.dg/array32.adb
new file mode 100644 (file)
index 0000000..1932e40
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/array32.ads b/gcc/testsuite/gnat.dg/array32.ads
new file mode 100644 (file)
index 0000000..48c0046
--- /dev/null
+++ b/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;