[Ada] Further optimization with uninitialized aggregates

[Ada] Further optimization with uninitialized aggregates

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 880 bytes --]

An object declaration for an unconstrained array includes an expression
(most often an aggregate) that provides the bounds for the object. If
the aggregate uses box initialization to provide those bounds, it is not
necessary to construct the aggregate to complete the object declaration:
the generated subtype of the aggregate is sufficient to create the object,
and there is no need to construct the aggregate. This optimization
prevents the construction of an empty aggregate and the useless
initialization code for the object.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* freeze.adb (Is_Uninitialized_Aggregate): Move...
	* exp_util.adb (Is_Uninitialized_Aggregate): ... here.
	(Expand_Subtype_From_Expr): If the expression is an
	uninitialized aggregate, capture subtype for declared object and
	remove expression to suppress further superfluous expansion.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5383 bytes --]

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -169,6 +169,16 @@ package body Exp_Util is
    --  Determine whether pragma Default_Initial_Condition denoted by Prag has
    --  an assertion expression that should be verified at run time.
 
+   function Is_Uninitialized_Aggregate
+     (Exp : Node_Id;
+      T   : Entity_Id) return Boolean;
+   --  Determine whether an array aggregate used in an object declaration
+   --  is uninitialized, when the aggregate is declared with a box and
+   --  the component type has no default value. Such an aggregate can be
+   --  optimized away to prevent the copying of uninitialized data, and
+   --  the bounds of the aggregate can be propagated directly to the
+   --  object declaration.
+
    function Make_CW_Equivalent_Type
      (T : Entity_Id;
       E : Node_Id) return Entity_Id;
@@ -5346,6 +5356,17 @@ package body Exp_Util is
       elsif Is_Build_In_Place_Function_Call (Exp) then
          null;
 
+     --  If the exprewsion is an uninitialized aggregate, no need to build
+     --  a subtype from the expression. because this may require the use
+     --  of dynamic memory to create the object.
+
+      elsif Is_Uninitialized_Aggregate (Exp, Exp_Typ) then
+         Rewrite (Subtype_Indic, New_Occurrence_Of (Etype (Exp), Sloc (N)));
+         if Nkind (N) = N_Object_Declaration then
+            Set_Expression (N, Empty);
+            Set_No_Initialization (N);
+         end if;
+
       else
          Remove_Side_Effects (Exp);
          Rewrite (Subtype_Indic,
@@ -8794,6 +8815,47 @@ package body Exp_Util is
           and then Etype (Expression (Expr)) = RTE (RE_Tag);
    end Is_Tag_To_Class_Wide_Conversion;
 
+   --------------------------------
+   -- Is_Uninitialized_Aggregate --
+   --------------------------------
+
+   function Is_Uninitialized_Aggregate
+     (Exp : Node_Id;
+      T   : Entity_Id) return Boolean
+   is
+      Comp      : Node_Id;
+      Comp_Type : Entity_Id;
+      Typ       : Entity_Id;
+
+   begin
+      if Nkind (Exp) /= N_Aggregate then
+         return False;
+      end if;
+
+      Preanalyze_And_Resolve (Exp, T);
+      Typ  := Etype (Exp);
+
+      if No (Typ)
+        or else Ekind (Typ) /= E_Array_Subtype
+        or else Present (Expressions (Exp))
+        or else No (Component_Associations (Exp))
+      then
+         return False;
+      else
+         Comp_Type := Component_Type (Typ);
+         Comp := First (Component_Associations (Exp));
+
+         if not Box_Present (Comp)
+           or else Present (Next (Comp))
+         then
+            return False;
+         end if;
+
+         return Is_Scalar_Type (Comp_Type)
+           and then No (Default_Aspect_Component_Value (Typ));
+      end if;
+   end Is_Uninitialized_Aggregate;
+
    ----------------------------
    -- Is_Untagged_Derivation --
    ----------------------------


diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -182,12 +182,6 @@ package body Freeze is
    --  the designated type. Otherwise freezing the access type does not freeze
    --  the designated type.
 
-   function Is_Uninitialized_Aggregate (N : Node_Id) return Boolean;
-   --  Determine whether an array aggregate used in an object declaration
-   --  is uninitialized, when the aggregate is declared with a box and
-   --  the component type has no default value. Such an aggregate can be
-   --  optimized away and prevent the copying of uninitialized data.
-
    procedure Process_Default_Expressions
      (E     : Entity_Id;
       After : in out Node_Id);
@@ -727,12 +721,6 @@ package body Freeze is
          if Present (Init)
            and then not Is_Limited_View (Typ)
          then
-            if Is_Uninitialized_Aggregate (Init) then
-               Init := Empty;
-               Set_No_Initialization (Decl);
-               return;
-            end if;
-
             --  Capture initialization value at point of declaration, and make
             --  explicit assignment legal, because object may be a constant.
 
@@ -9153,40 +9141,6 @@ package body Freeze is
       end if;
    end Freeze_Subprogram;
 
-   --------------------------------
-   -- Is_Uninitialized_Aggregate --
-   --------------------------------
-
-   function Is_Uninitialized_Aggregate (N : Node_Id) return Boolean is
-      Aggr : constant Node_Id := Original_Node (N);
-      Typ  : constant Entity_Id := Etype (Aggr);
-
-      Comp      : Node_Id;
-      Comp_Type : Entity_Id;
-   begin
-      if Nkind (Aggr) /= N_Aggregate
-        or else No (Typ)
-        or else Ekind (Typ) /= E_Array_Type
-        or else Present (Expressions (Aggr))
-        or else No (Component_Associations (Aggr))
-      then
-         return False;
-      else
-         Comp_Type := Component_Type (Typ);
-         Comp := First (Component_Associations (Aggr));
-
-         if not Box_Present (Comp)
-           or else Present (Next (Comp))
-         then
-            return False;
-         end if;
-
-         return Is_Scalar_Type (Comp_Type)
-           and then No (Default_Aspect_Component_Value (Typ))
-           and then No (Default_Aspect_Value (Comp_Type));
-      end if;
-   end Is_Uninitialized_Aggregate;
-
    ----------------------
    -- Is_Fully_Defined --
    ----------------------