ada: Fix wrong finalization of anonymous array aggregate

The issue arises when the aggregate consists only of iterated associations
because, in this case, its expansion uses a 2-pass mechanism which creates
a temporary that needs a fully-fledged initialization, thus running afoul
of the optimization that avoids building the initialization procedure in
the anonymous array case.

gcc/ada/ChangeLog:
	* exp_aggr.ads (Is_Two_Pass_Aggregate): New function declaration.
	* exp_aggr.adb (Is_Two_Pass_Aggregate): New function body.
	(Expand_Array_Aggregate): Call Is_Two_Pass_Aggregate to detect the
	aggregates that need the 2-pass expansion.
	* exp_ch3.adb (Expand_Freeze_Array_Type): In the anonymous array
	case, build the initialization procedure if the initial value in
	the object declaration is a 2-pass aggregate.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 846665eae20ba3202699df9551427363bffb9aec..86d886a302c8cb44634a50ee8b23096c3688b0f9 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5946,12 +5946,7 @@ package body Exp_Aggr is
       then
          return;
 
-      elsif Present (Component_Associations (N))
-        and then Nkind (First (Component_Associations (N))) =
-                 N_Iterated_Component_Association
-        and then
-          Present (Iterator_Specification (First (Component_Associations (N))))
-      then
+      elsif Is_Two_Pass_Aggregate (N) then
          Two_Pass_Aggregate_Expansion (N);
          return;
 
@@ -8872,6 +8867,21 @@ package body Exp_Aggr is
         and then C in Uint_1 | Uint_2 | Uint_4; -- False if No_Uint
    end Is_Two_Dim_Packed_Array;
 
+   ---------------------------
+   -- Is_Two_Pass_Aggregate --
+   ---------------------------
+
+   function Is_Two_Pass_Aggregate (N : Node_Id) return Boolean is
+   begin
+      return Nkind (N) = N_Aggregate
+        and then Present (Component_Associations (N))
+        and then Nkind (First (Component_Associations (N))) =
+                   N_Iterated_Component_Association
+        and then
+          Present
+            (Iterator_Specification (First (Component_Associations (N))));
+   end Is_Two_Pass_Aggregate;
+
    --------------------
    -- Late_Expansion --
    --------------------

diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index 17fa38b7ca3597dd5b556a256c92c935b53d1366..aa79616c609a90af465b3d8f9078a9e47ba17d08 100644 (file)
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -58,6 +58,10 @@ package Exp_Aggr is
    --  Returns True if N is a conditional expression whose Expansion_Delayed
    --  flag is set (see sinfo for meaning of flag).
 
+   function Is_Two_Pass_Aggregate (N : Node_Id) return Boolean;
+   --  Return True if N is an aggregate that is to be expanded in two passes.
+   --  This is the case if it consists only of iterated associations.
+
    function Static_Array_Aggregate (N : Node_Id) return Boolean;
    --  N is an array aggregate that may have a component association with
    --  an others clause and a range. If bounds are static and the expressions

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index ff808aadea887ab38898c02834bc232de8730c86..139fce8b288c26050bc99d32220bb7a0d87436e3 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5429,17 +5429,22 @@ package body Exp_Ch3 is
       if not Is_Bit_Packed_Array (Typ) then
          if No (Init_Proc (Base)) then
 
-            --  If this is an anonymous array created for a declaration with
-            --  an initial value, its init_proc will never be called. The
+            --  If this is an anonymous array built for an object declaration
+            --  with an initial value, its Init_Proc will never be called. The
             --  initial value itself may have been expanded into assignments,
-            --  in which case the object declaration is carries the
-            --  No_Initialization flag.
+            --  in which case the declaration has the No_Initialization flag.
+            --  The exception is when the initial value is a 2-pass aggregate,
+            --  because the special expansion used for it creates a temporary
+            --  that needs a fully-fledged initialization.
 
             if Is_Itype (Base)
               and then Nkind (Associated_Node_For_Itype (Base)) =
                                                     N_Object_Declaration
               and then
-                (Present (Expression (Associated_Node_For_Itype (Base)))
+                ((Present (Expression (Associated_Node_For_Itype (Base)))
+                    and then not
+                      Is_Two_Pass_Aggregate
+                        (Expression (Associated_Node_For_Itype (Base))))
                   or else No_Initialization (Associated_Node_For_Itype (Base)))
             then
                null;