This patch adds an abort defer / undefer pair around the initialization
statements of a controlled aggregate component as dictated by 9.8 11.
------------
-- Source --
------------
-- aggregates.ads
with Ada.Finalization; use Ada.Finalization;
package Aggregates is
type Ctrl is new Controlled with null record;
Ctrl_Obj : constant Ctrl := (Controlled with null record);
type Arr is array (1 .. 3) of Ctrl;
Arr_Obj_1 : constant Arr := (others => Ctrl_Obj);
Arr_Obj_2 : constant Arr := (others => (Controlled with null record));
type Rec is record
Comp : Ctrl;
end record;
Rec_Obj_1 : constant Rec := (Comp => Ctrl_Obj);
Rec_Obj_2 : constant Rec := (Comp => (Controlled with null record));
end Aggregates;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c -gnatDG aggregates.ads
$ line=$(grep -n "arr_obj_1 : constant" aggregates.ads.dg | cut -f1 -d:)
$ tail -n +$line aggregates.ads.dg | head -n 20 | grep "abort_" | sed "s/^ *//"
system__soft_links__abort_defer.all;
system__standard_library__abort_undefer_direct;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-07-06 Hristian Kirtchev <kirtc...@adacore.com>
* exp_aggr.adb Remove with and use clauses for Exp_Ch11 and Inline.
(Initialize_Array_Component): Protect the initialization
statements in an abort defer / undefer block when the associated
component is controlled.
(Initialize_Record_Component): Protect the initialization statements
in an abort defer / undefer block when the associated component is
controlled.
(Process_Transient_Component_Completion): Use Build_Abort_Undefer_Block
to create an abort defer / undefer block.
* exp_ch3.adb Remove with and use clauses for Exp_ch11 and Inline.
(Default_Initialize_Object): Use Build_Abort_Undefer_Block to
create an abort defer / undefer block.
* exp_ch5.adb (Expand_N_Assignment_Statement): Mark an abort
defer / undefer block as such.
* exp_ch9.adb (Find_Enclosing_Context): Do not consider an abort
defer / undefer block as a suitable context for an activation
chain or a master.
* exp_util.adb Add with and use clauses for Exp_Ch11.
(Build_Abort_Undefer_Block): New routine.
* exp_util.ads (Build_Abort_Undefer_Block): New routine.
* sinfo.adb (Is_Abort_Block): New routine.
(Set_Is_Abort_Block): New routine.
* sinfo.ads New attribute Is_Abort_Block along with occurrences
in nodes.
(Is_Abort_Block): New routine along with pragma Inline.
(Set_Is_Abort_Block): New routine along with pragma Inline.
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 321913)
+++ exp_ch9.adb (working copy)
@@ -6251,8 +6251,11 @@
Defining_Identifier => D_T2,
Type_Definition => Def1);
- Insert_After_And_Analyze (N, Decl1);
+ -- Declare the new types before the original one since the latter will
+ -- refer to them through the Equivalent_Type slot.
+ Insert_Before_And_Analyze (N, Decl1);
+
-- Associate the access to subprogram with its original access to
-- protected subprogram type. Needed by the backend to know that this
-- type corresponds with an access to protected subprogram type.
@@ -6286,7 +6289,7 @@
Component_List =>
Make_Component_List (Loc, Component_Items => Comps)));
- Insert_After_And_Analyze (Decl1, Decl2);
+ Insert_Before_And_Analyze (N, Decl2);
Set_Equivalent_Type (T, E_T);
end Expand_Access_Protected_Subprogram_Type;
@@ -9310,6 +9313,9 @@
pragma Assert (Present (Pdef));
+ Insert_After (Current_Node, Rec_Decl);
+ Current_Node := Rec_Decl;
+
-- Add private field components
if Present (Private_Declarations (Pdef)) then
@@ -9570,9 +9576,6 @@
Append_To (Cdecls, Object_Comp);
end if;
- Insert_After (Current_Node, Rec_Decl);
- Current_Node := Rec_Decl;
-
-- Analyze the record declaration immediately after construction,
-- because the initialization procedure is needed for single object
-- declarations before the next entity is analyzed (the freeze call
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 321913)
+++ exp_util.adb (working copy)
@@ -7912,11 +7912,11 @@
Scope_Suppress.Suppress := (others => True);
- -- If this is an elementary or a small not-by-reference record type, and
+ -- If this is an elementary or a small not by-reference record type, and
-- we need to capture the value, just make a constant; this is cheap and
-- objects of both kinds of types can be bit aligned, so it might not be
-- possible to generate a reference to them. Likewise if this is not a
- -- name reference, except for a type conversion, because we would enter
+ -- name reference, except for a type conversion because we would enter
-- an infinite recursion with Checks.Apply_Predicate_Check if the target
-- type has predicates (and type conversions need a specific treatment
-- anyway, see below). Also do it if we have a volatile reference and
@@ -8839,7 +8839,7 @@
-- alignment is known to be at least the maximum alignment for the
-- target or if both alignments are known and the output type's
-- alignment is no stricter than the input's. We can use the component
- -- type alignement for an array if a type is an unpacked array type.
+ -- type alignment for an array if a type is an unpacked array type.
if Present (Alignment_Clause (Otyp)) then
Oalign := Expr_Value (Expression (Alignment_Clause (Otyp)));
