[Ada] Optimizing allocators for arrays with non-static upper bound

[Pierre-Marie de Rodat]

This patch extends the optimization of allocators for arrays of non-controlled
components, when the qualified expression for the aggregate has an
unconstrained type and the upper bound of the aggregte is non-static. In this
case it is safe to build the array in the allocated object, instead of first
creating a temporary for the aggregate, then allocating the object, and then
assigning the temporary to the object, as mandated by the dynamic semantics
of initialized allocators. This optimization is particularly useful when the
size of the aggregate may be too large to be built on the stack,

Executing the following:

   gnatmake -q foo
   ./foo

must yield:

   10000000

---
with Text_IO; use Text_IO;
procedure Foo is

   type Record_Type is record
      I : Integer;
   end record;

   type Array_Type is array (Positive range <>) of Record_Type;
   type Array_Access is access all Array_Type;

   function Get_Last return Integer is
   begin
      return 10_000_000;
   end Get_Last;

   A : Array_Access := new Array_Type'(1 .. Get_Last => (I => 0));
begin
   Put_Line (Integer'Image (A'Length));
end Foo;

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

2017-12-15  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (In_Place_Assign_OK): Extend the predicate to recognize
	an array aggregate in an allocator, when the designated type is
	unconstrained and the upper bound of the aggregate belongs to the base
	type of the index.

-------------- next part --------------
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 255678)
+++ exp_aggr.adb	(working copy)
@@ -5537,13 +5537,29 @@
                Get_Index_Bounds (Obj_In, Obj_Lo, Obj_Hi);
 
                if not Compile_Time_Known_Value (Aggr_Lo)
-                 or else not Compile_Time_Known_Value (Aggr_Hi)
                  or else not Compile_Time_Known_Value (Obj_Lo)
                  or else not Compile_Time_Known_Value (Obj_Hi)
                  or else Expr_Value (Aggr_Lo) /= Expr_Value (Obj_Lo)
-                 or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
                then
                   return False;
+
+               --  For an assignment statement we require static matching
+               --  of bounds. Ditto for an allocator whose qualified
+               --  expression is a constrained type. If the expression in
+               --  the allocator is an unconstrained array, we accept an
+               --  upper bound that is not static, to allow for non-static
+               --  expressions of the base type. Clearly there are further
+               --  possibilities (with diminishing returns) for safely
+               --  building arrays in place here.
+
+               elsif Nkind (Parent (N)) = N_Assignment_Statement
+                 or else Is_Constrained (Etype (Parent (N)))
+               then
+                  if not Compile_Time_Known_Value (Aggr_Hi)
+                   or else Expr_Value (Aggr_Hi) /= Expr_Value (Obj_Hi)
+                  then
+                     return False;
+                  end if;
                end if;
 
                Next_Index (Aggr_In);