diff mbox

[Ada] Missing abort deferral on controlled aggregate component assignment

Message ID 20160706124014.GA68215@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 6, 2016, 12:40 p.m. UTC
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  <kirtchev@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.
diff mbox

Patch

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)));