This patch enhances the memory usage of object declarations initialized by
a qualified array aggregate. Previously, as per RM 4.3(5), an anonymous object
was created to capture the value of the array aggregate, effectively doubling
the memory consumption. The changes above remove the anonymous object
declaration and instead ignore the qualified expression. As noted in the
comments this is allowed due to RM 7.6(17 1/3).
------------
-- Source --
------------
-- pack.adb
procedure Pack is
type Rec is record
I : Integer;
SI : Short_Integer;
B : Boolean;
end record;
type Arr is array (1 .. 3, 0 .. 255) of Rec;
Obj_1 : Arr := Arr'(others => (others => Rec'(0, 0, False)));
begin
null;
end Pack;
----------------------------
-- Compilation and output --
----------------------------
gnatmake -g -f -gnatD pack.adb
grep "obj_1[ ]*:[ a-z_]*;" pack.adb.dg
obj_1 : pack__arr;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-06-16 Justin Squirek <squi...@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): Add a missing check
for optimized aggregate arrays with qualified expressions.
* exp_aggr.adb (Expand_Array_Aggregate): Fix block and
conditional statement in charge of deciding whether to perform
in-place expansion. Specifically, use Parent_Node to jump over
the qualified expression to the object declaration node. Also,
a check has been inserted to skip the optimization if SPARK 2005
is being used in strict adherence to RM 4.3(5).
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 237439)
+++ sem_ch3.adb (working copy)
@@ -3471,7 +3471,7 @@
-- In case of aggregates we must also take care of the correct
-- initialization of nested aggregates bug this is done at the
- -- point of the analysis of the aggregate (see sem_aggr.adb).
+ -- point of the analysis of the aggregate (see sem_aggr.adb) ???
if Present (Expression (N))
and then Nkind (Expression (N)) = N_Aggregate
@@ -4038,7 +4038,10 @@
elsif Is_Array_Type (T)
and then No_Initialization (N)
- and then Nkind (Original_Node (E)) = N_Aggregate
+ and then (Nkind (Original_Node (E)) = N_Aggregate
+ or else (Nkind (Original_Node (E)) = N_Qualified_Expression
+ and then Nkind (Original_Node (Expression
+ (Original_Node (E)))) = N_Aggregate))
then
if not Is_Entity_Name (Object_Definition (N)) then
Act_T := Etype (E);
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 237429)
+++ exp_aggr.adb (working copy)
@@ -5433,8 +5433,8 @@
-- STEP 3
- -- Delay expansion for nested aggregates: it will be taken care of
- -- when the parent aggregate is expanded.
+ -- Delay expansion for nested aggregates: it will be taken care of when
+ -- the parent aggregate is expanded.
Parent_Node := Parent (N);
Parent_Kind := Nkind (Parent_Node);
@@ -5524,14 +5524,18 @@
and then Parent_Kind = N_Object_Declaration
and then not
Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
- and then N = Expression (Parent_Node)
+ and then Present (Expression (Parent_Node))
+ and then not Has_Controlled_Component (Typ)
and then not Is_Bit_Packed_Array (Typ)
- and then not Has_Controlled_Component (Typ)
+
+ -- ??? the test for SPARK 05 needs documentation
+
+ and then not Restriction_Check_Required (SPARK_05)
then
In_Place_Assign_OK_For_Declaration := True;
- Tmp := Defining_Identifier (Parent (N));
- Set_No_Initialization (Parent (N));
- Set_Expression (Parent (N), Empty);
+ Tmp := Defining_Identifier (Parent_Node);
+ Set_No_Initialization (Parent_Node);
+ Set_Expression (Parent_Node, Empty);
-- Set kind and type of the entity, for use in the analysis
-- of the subsequent assignments. If the nominal type is not
@@ -5544,10 +5548,10 @@
if not Is_Constrained (Typ) then
Build_Constrained_Type (Positional => False);
- elsif Is_Entity_Name (Object_Definition (Parent (N)))
- and then Is_Constrained (Entity (Object_Definition (Parent (N))))
+ elsif Is_Entity_Name (Object_Definition (Parent_Node))
+ and then Is_Constrained (Entity (Object_Definition (Parent_Node)))
then
- Set_Etype (Tmp, Entity (Object_Definition (Parent (N))));
+ Set_Etype (Tmp, Entity (Object_Definition (Parent_Node)));
else
Set_Size_Known_At_Compile_Time (Typ, False);
