re PR ada/66242 (Front-end error if exception propagation disabled)

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	PR ada/66242

	* exp_ch3.adb (Default_Initialize_Object): Reimplemented. Abort
	defer / undefer pairs are now encapsulated in a block with
	an AT END handler. Partial finalization now takes restriction
	No_Exception_Propagation into account when generating blocks.
	* exp_ch7.adb Various reformattings.
	(Create_Finalizer): Change
	the generation of abort defer / undefer pairs and explain the
	lack of an AT END handler.
	(Process_Transient_Objects): Add generation of abort defer/undefer
	pairs.
	* exp_ch9.adb Various reformattings.
	(Build_Protected_Subprogram_Body): Use
	Build_Runtime_Call to construct a call to Abort_Defer.
	(Build_Protected_Subprogram_Call_Cleanup): Use
	Build_Runtime_Call to construct a call to Abort_Undefer.
	(Expand_N_Asynchronous_Select): Use Build_Runtime_Call to
	construct a call to Abort_Defer.
	* exp_intr.adb (Expand_Unc_Deallocation): Abort defer
	/ undefer pairs are now encapsulated in a block with
	an AT END handler. Finalization now takes restriction
	No_Exception_Propagation into account when generating blocks.
	* exp_util.ads, exp_util.adb (Wrap_Cleanup_Procedure): Removed.

From-SVN: r230531

6 files changed, 286 insertions, 355 deletions

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6fb3a59..af245ec 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -201,9 +201,9 @@ package body Exp_Ch3 is
    --  subprogram they rename is not frozen when the type is frozen.
 
    procedure Insert_Component_Invariant_Checks
-     (N   : Node_Id;
-     Typ  : Entity_Id;
-     Proc : Node_Id);
+     (N    : Node_Id;
+      Typ  : Entity_Id;
+      Proc : Node_Id);
    --  If a composite type has invariants and also has components with defined
    --  invariants. the component invariant procedure is inserted into the user-
    --  defined invariant procedure and added to the checks to be performed.
@@ -5197,8 +5197,8 @@ package body Exp_Ch3 is
                if Ekind (Comp) = E_Component
                  and then Chars (Comp) = Chars (Old_Comp)
                then
-                  Set_Discriminant_Checking_Func (Comp,
-                    Discriminant_Checking_Func (Old_Comp));
+                  Set_Discriminant_Checking_Func
+                    (Comp, Discriminant_Checking_Func (Old_Comp));
                end if;
 
                Next_Component (Old_Comp);
@@ -6083,20 +6083,19 @@ package body Exp_Ch3 is
 
          --  Local variables
 
-         Abrt_Blk   : Node_Id;
-         Abrt_HSS   : Node_Id;
-         Abrt_Id    : Entity_Id;
-         Abrt_Stmts : List_Id;
-         Aggr_Init  : Node_Id;
-         Comp_Init  : List_Id := No_List;
-         Fin_Call   : Node_Id;
-         Fin_Stmts  : List_Id := No_List;
-         Obj_Init   : Node_Id := Empty;
-         Obj_Ref    : Node_Id;
-
-         Dummy : Entity_Id;
-         --  This variable captures a dummy internal entity, see the comment
-         --  associated with its use.
+         Exceptions_OK : constant Boolean :=
+                           not Restriction_Active (No_Exception_Propagation);
+
+         Abrt_Blk    : Node_Id;
+         Abrt_Blk_Id : Entity_Id;
+         Abrt_HSS    : Node_Id;
+         Aggr_Init   : Node_Id;
+         AUD         : Entity_Id;
+         Comp_Init   : List_Id := No_List;
+         Fin_Call    : Node_Id;
+         Init_Stmts  : List_Id := No_List;
+         Obj_Init    : Node_Id := Empty;
+         Obj_Ref     : Node_Id;
 
       --  Start of processing for Default_Initialize_Object
 
@@ -6112,19 +6111,25 @@ package body Exp_Ch3 is
             return;
          end if;
 
-         --  Step 1: Initialize the object
+         --  The expansion performed by this routine is as follows:
 
-         if Needs_Finalization (Typ) and then not No_Initialization (N) then
-            Obj_Init :=
-              Make_Init_Call
-                (Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
-                 Typ     => Typ);
-         end if;
-
-         --  Step 2: Initialize the components of the object
+         --    begin
+         --       Abort_Defer;
+         --       Type_Init_Proc (Obj);
+
+         --       begin
+         --          [Deep_]Initialize (Obj);
+
+         --       exception
+         --          when others =>
+         --             [Deep_]Finalize (Obj, Self => False);
+         --             raise;
+         --       end;
+         --    at end
+         --       Abort_Undefer_Direct;
+         --    end;
 
-         --  Do not initialize the components if their initialization is
-         --  prohibited.
+         --  Initialize the components of the object
 
          if Has_Non_Null_Base_Init_Proc (Typ)
            and then not No_Initialization (N)
@@ -6154,7 +6159,8 @@ package body Exp_Ch3 is
                elsif Build_Equivalent_Aggregate then
                   null;
 
-               --  Otherwise invoke the type init proc
+               --  Otherwise invoke the type init proc, generate:
+               --    Type_Init_Proc (Obj);
 
                else
                   Obj_Ref := New_Object_Reference;
@@ -6182,41 +6188,35 @@ package body Exp_Ch3 is
             Analyze_And_Resolve (Expression (N), Typ);
          end if;
 
-         --  Step 3: Add partial finalization and abort actions, generate:
+         --  Initialize the object, generate:
+         --    [Deep_]Initialize (Obj);
+
+         if Needs_Finalization (Typ) and then not No_Initialization (N) then
+            Obj_Init :=
+              Make_Init_Call
+                (Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
+                 Typ     => Typ);
+         end if;
+
+         --  Build a special finalization block when both the object and its
+         --  controlled components are to be initialized. The block finalizes
+         --  the components if the object initialization fails. Generate:
 
-         --    Type_Init_Proc (Obj);
          --    begin
-         --       Deep_Initialize (Obj);
+         --       <Obj_Init>
+
          --    exception
          --       when others =>
-         --          Deep_Finalize (Obj, Self => False);
+         --          <Fin_Call>
          --          raise;
          --    end;
 
-         --  Step 3a: Build the finalization block (if applicable)
-
-         --  The finalization block is required when both the object and its
-         --  controlled components are to be initialized. The block finalizes
-         --  the components if the object initialization fails.
-
          if Has_Controlled_Component (Typ)
            and then Present (Comp_Init)
            and then Present (Obj_Init)
-           and then not Restriction_Active (No_Exception_Propagation)
+           and then Exceptions_OK
          then
-            --  Generate:
-            --    Type_Init_Proc (Obj);
-
-            Fin_Stmts := Comp_Init;
-
-            --  Generate:
-            --    begin
-            --       Deep_Initialize (Obj);
-            --    exception
-            --       when others =>
-            --          Deep_Finalize (Obj, Self => False);
-            --          raise;
-            --    end;
+            Init_Stmts := Comp_Init;
 
             Fin_Call :=
               Make_Final_Call
@@ -6232,7 +6232,7 @@ package body Exp_Ch3 is
 
                Set_No_Elaboration_Check (Fin_Call);
 
-               Append_To (Fin_Stmts,
+               Append_To (Init_Stmts,
                  Make_Block_Statement (Loc,
                    Declarations               => No_List,
 
@@ -6250,100 +6250,93 @@ package body Exp_Ch3 is
                              Make_Raise_Statement (Loc)))))));
             end if;
 
-         --  Finalization is not required, the initialization calls are passed
-         --  to the abort block building circuitry, generate:
+         --  Otherwise finalization is not required, the initialization calls
+         --  are passed to the abort block building circuitry, generate:
 
          --    Type_Init_Proc (Obj);
-         --    Deep_Initialize (Obj);
+         --    [Deep_]Initialize (Obj);
 
          else
             if Present (Comp_Init) then
-               Fin_Stmts := Comp_Init;
+               Init_Stmts := Comp_Init;
             end if;
 
             if Present (Obj_Init) then
-               if No (Fin_Stmts) then
-                  Fin_Stmts := New_List;
+               if No (Init_Stmts) then
+                  Init_Stmts := New_List;
                end if;
 
-               Append_To (Fin_Stmts, Obj_Init);
+               Append_To (Init_Stmts, Obj_Init);
             end if;
          end if;
 
-         --  Step 3b: Build the abort block (if applicable)
-
-         --  The abort block is required when aborts are allowed in order to
-         --  protect both initialization calls.
-
-         if Present (Comp_Init) and then Present (Obj_Init) then
-            if Abort_Allowed then
-
-               --  Generate:
-               --    Abort_Defer;
+         --  Build an abort block to protect the initialization calls
 
-               Prepend_To
-                 (Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
+         if Abort_Allowed
+           and then Present (Comp_Init)
+           and then Present (Obj_Init)
+         then
+            --  Generate:
+            --    Abort_Defer;
 
-               --  Generate:
-               --    begin
-               --       Abort_Defer;
-               --       <finalization statements>
-               --    at end
-               --       Abort_Undefer_Direct;
-               --    end;
+            Prepend_To (Init_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
 
-               declare
-                  AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
+            --  When exceptions are propagated, abort deferral must take place
+            --  in the presence of initialization or finalization exceptions.
+            --  Generate:
 
-               begin
-                  Abrt_HSS :=
-                    Make_Handled_Sequence_Of_Statements (Loc,
-                      Statements  => Fin_Stmts,
-                      At_End_Proc => New_Occurrence_Of (AUD, Loc));
+            --    begin
+            --       Abort_Defer;
+            --       <Init_Stmts>
+            --    at end
+            --       Abort_Undefer_Direct;
+            --    end;
 
-                  --  Present the Abort_Undefer_Direct function to the backend
-                  --  so that it can inline the call to the function.
+            if Exceptions_OK then
+               AUD := RTE (RE_Abort_Undefer_Direct);
 
-                  Add_Inlined_Body (AUD, N);
-               end;
+               Abrt_HSS :=
+                 Make_Handled_Sequence_Of_Statements (Loc,
+                   Statements  => Init_Stmts,
+                   At_End_Proc => New_Occurrence_Of (AUD, Loc));
 
                Abrt_Blk :=
                  Make_Block_Statement (Loc,
-                   Declarations               => No_List,
                    Handled_Statement_Sequence => Abrt_HSS);
 
-               Add_Block_Identifier (Abrt_Blk, Abrt_Id);
-               Expand_At_End_Handler (Abrt_HSS, Abrt_Id);
+               Add_Block_Identifier  (Abrt_Blk, Abrt_Blk_Id);
+               Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
 
-               Abrt_Stmts := New_List (Abrt_Blk);
+               --  Present the Abort_Undefer_Direct function to the backend so
+               --  that it can inline the call to the function.
 
-            --  Abort is not required
+               Add_Inlined_Body (AUD, N);
 
-            else
-               --  Generate a dummy entity to ensure that the internal symbols
-               --  are in sync when a unit is compiled with and without aborts.
-               --  The entity is a block with proper scope and type.
+               Init_Stmts := New_List (Abrt_Blk);
 
-               Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
-               Set_Etype (Dummy, Standard_Void_Type);
-               Abrt_Stmts := Fin_Stmts;
-            end if;
+            --  Otherwise exceptions are not propagated. Generate:
 
-         --  No initialization calls present
+            --    Abort_Defer;
+            --    <Init_Stmts>
+            --    Abort_Undefer;
 
-         else
-            Abrt_Stmts := Fin_Stmts;
+            else
+               Append_To (Init_Stmts,
+                 Build_Runtime_Call (Loc, RE_Abort_Undefer));
+            end if;
          end if;
 
-         --  Step 4: Insert the whole initialization sequence into the tree
-         --  If the object has a delayed freeze, as will be the case when
-         --  it has aspect specifications, the initialization sequence is
-         --  part of the freeze actions.
+         --  Insert the whole initialization sequence into the tree. If the
+         --  object has a delayed freeze, as will be the case when it has
+         --  aspect specifications, the initialization sequence is part of
+         --  the freeze actions.
 
-         if Has_Delayed_Freeze (Def_Id) then
-            Append_Freeze_Actions (Def_Id, Abrt_Stmts);
-         else
-            Insert_Actions_After (After, Abrt_Stmts);
+         if Present (Init_Stmts) then
+            if Has_Delayed_Freeze (Def_Id) then
+               Append_Freeze_Actions (Def_Id, Init_Stmts);
+            else
+               Insert_Actions_After (After, Init_Stmts);
+            end if;
          end if;
       end Default_Initialize_Object;
 
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index f4db92f..f5b97e2 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1323,13 +1323,6 @@ package body Exp_Ch7 is
       ----------------------
 
       procedure Create_Finalizer is
-         Body_Id    : Entity_Id;
-         Fin_Body   : Node_Id;
-         Fin_Spec   : Node_Id;
-         Jump_Block : Node_Id;
-         Label      : Node_Id;
-         Label_Id   : Entity_Id;
-
          function New_Finalizer_Name return Name_Id;
          --  Create a fully qualified name of a package spec or body finalizer.
          --  The generated name is of the form: xx__yy__finalize_[spec|body].
@@ -1380,6 +1373,15 @@ package body Exp_Ch7 is
             return Name_Find;
          end New_Finalizer_Name;
 
+         --  Local variables
+
+         Body_Id    : Entity_Id;
+         Fin_Body   : Node_Id;
+         Fin_Spec   : Node_Id;
+         Jump_Block : Node_Id;
+         Label      : Node_Id;
+         Label_Id   : Entity_Id;
+
       --  Start of processing for Create_Finalizer
 
       begin
@@ -1532,16 +1534,17 @@ package body Exp_Ch7 is
 
          --  Protect the statements with abort defer/undefer. This is only when
          --  aborts are allowed and the clean up statements require deferral or
-         --  there are controlled objects to be finalized.
+         --  there are controlled objects to be finalized. Note that the abort
+         --  defer/undefer pair does not require an extra block because each
+         --  finalization exception is caught in its corresponding finalization
+         --  block. As a result, the call to Abort_Defer always takes place.
 
          if Abort_Allowed and then (Defer_Abort or Has_Ctrl_Objs) then
             Prepend_To (Finalizer_Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc)));
+              Build_Runtime_Call (Loc, RE_Abort_Defer));
 
             Append_To (Finalizer_Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
+              Build_Runtime_Call (Loc, RE_Abort_Undefer));
          end if;
 
          --  The local exception does not need to be reraised for library-level
@@ -1596,7 +1599,8 @@ package body Exp_Ch7 is
                  Defining_Unit_Name => Body_Id),
              Declarations               => Finalizer_Decls,
              Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc, Finalizer_Stmts));
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => Finalizer_Stmts));
 
          --  Step 4: Spec and body insertion, analysis
 
@@ -2806,9 +2810,7 @@ package body Exp_Ch7 is
 
          else
             --  Generate:
-            --    [Deep_]Finalize (Obj);  --  No_Exception_Propagation
-
-            --    begin                   --  Exception handlers allowed
+            --    begin
             --       [Deep_]Finalize (Obj);
 
             --    exception
@@ -4727,6 +4729,8 @@ package body Exp_Ch7 is
          --       Raised : Boolean := False;
 
          --    begin
+         --       Abort_Defer;
+
          --       begin
          --          Hook_N := null;
          --          [Deep_]Finalize (Ctrl_Trans_Obj_N);
@@ -4752,26 +4756,8 @@ package body Exp_Ch7 is
          --       if Raised and not Abrt then
          --          Raise_From_Controlled_Operation (Ex);
          --       end if;
-         --    end;
-
-         --  When restriction No_Exception_Propagation is active, the expansion
-         --  is as follows:
 
-         --    type Ptr_Typ_1 is access all Ctrl_Trans_Obj_1_Typ;
-         --    Hook_1 : Ptr_Typ_1 := null;
-         --    Ctrl_Trans_Obj_1 : ...;
-         --    Hook_1 := Ctrl_Trans_Obj_1'Unrestricted_Access;
-         --    . . .
-         --    type Ptr_Typ_N is access all Ctrl_Trans_Obj_N_Typ;
-         --    Hook_N : Ptr_Typ_N := null;
-         --    Ctrl_Trans_Obj_N : ...;
-         --    Hook_N := Ctrl_Trans_Obj_N'Unrestricted_Access;
-
-         --    begin
-         --       Hook_N := null;
-         --       [Deep_]Finalize (Ctrl_Trans_Obj_N);
-         --       Hook_1 := null;
-         --       [Deep_]Finalize (Ctrl_Trans_Obj_1);
+         --       Abort_Undefer_Direct;
          --    end;
 
          --  Recognize a scenario where the transient context is an object
@@ -4983,6 +4969,7 @@ package body Exp_Ch7 is
                --  When exception propagation is enabled wrap the hook clear
                --  statement and the finalization call into a block to catch
                --  potential exceptions raised during finalization. Generate:
+
                --    begin
                --       [Temp := null;]
                --       [Deep_]Finalize (Obj_Ref);
@@ -5037,6 +5024,20 @@ package body Exp_Ch7 is
          end loop;
 
          if Present (Blk_Decl) then
+
+            --  Note that the abort defer / undefer pair does not require an
+            --  extra block because each finalization exception is caught in
+            --  its corresponding finalization block. As a result, the call to
+            --  Abort_Defer always takes place.
+
+            if Abort_Allowed then
+               Prepend_To (Blk_Stmts,
+                 Build_Runtime_Call (Loc, RE_Abort_Defer));
+
+               Append_To (Blk_Stmts,
+                 Build_Runtime_Call (Loc, RE_Abort_Undefer));
+            end if;
+
             Insert_After_And_Analyze (Blk_Ins, Blk_Decl);
          end if;
       end Process_Transient_Objects;
@@ -5428,10 +5429,13 @@ package body Exp_Ch7 is
       function Build_Adjust_Or_Finalize_Statements
         (Typ : Entity_Id) return List_Id
       is
-         Comp_Typ        : constant Entity_Id  := Component_Type (Typ);
-         Index_List      : constant List_Id    := New_List;
-         Loc             : constant Source_Ptr := Sloc (Typ);
-         Num_Dims        : constant Int        := Number_Dimensions (Typ);
+         Comp_Typ       : constant Entity_Id  := Component_Type (Typ);
+         Exceptions_OK  : constant Boolean    :=
+                            not Restriction_Active (No_Exception_Propagation);
+         Index_List     : constant List_Id    := New_List;
+         Loc            : constant Source_Ptr := Sloc (Typ);
+         Num_Dims       : constant Int        := Number_Dimensions (Typ);
+
          Finalizer_Decls : List_Id := No_List;
          Finalizer_Data  : Finalization_Exception_Data;
          Call            : Node_Id;
@@ -5442,9 +5446,6 @@ package body Exp_Ch7 is
          Loop_Id         : Entity_Id;
          Stmts           : List_Id;
 
-         Exceptions_OK : constant Boolean :=
-                           not Restriction_Active (No_Exception_Propagation);
-
          procedure Build_Indexes;
          --  Generate the indexes used in the dimension loops
 
@@ -5492,9 +5493,7 @@ package body Exp_Ch7 is
 
          --  Generate the block which houses the adjust or finalize call:
 
-         --    <adjust or finalize call>;  --  No_Exception_Propagation
-
-         --    begin                       --  Exception handlers allowed
+         --    begin
          --       <adjust or finalize call>
 
          --    exception
@@ -5567,7 +5566,7 @@ package body Exp_Ch7 is
          --    begin
          --       <core loop>
 
-         --       if Raised and then not Abort then  --  Expection handlers OK
+         --       if Raised and then not Abort then
          --          Raise_From_Controlled_Operation (E);
          --       end if;
          --    end;
@@ -5575,8 +5574,7 @@ package body Exp_Ch7 is
          Stmts := New_List (Core_Loop);
 
          if Exceptions_OK then
-            Append_To (Stmts,
-              Build_Raise_Statement (Finalizer_Data));
+            Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
          end if;
 
          return
@@ -5593,11 +5591,14 @@ package body Exp_Ch7 is
       ---------------------------------
 
       function Build_Initialize_Statements (Typ : Entity_Id) return List_Id is
-         Comp_Typ        : constant Entity_Id  := Component_Type (Typ);
-         Final_List      : constant List_Id    := New_List;
-         Index_List      : constant List_Id    := New_List;
-         Loc             : constant Source_Ptr := Sloc (Typ);
-         Num_Dims        : constant Int        := Number_Dimensions (Typ);
+         Comp_Typ       : constant Entity_Id  := Component_Type (Typ);
+         Exceptions_OK  : constant Boolean    :=
+                            not Restriction_Active (No_Exception_Propagation);
+         Final_List     : constant List_Id    := New_List;
+         Index_List     : constant List_Id    := New_List;
+         Loc            : constant Source_Ptr := Sloc (Typ);
+         Num_Dims       : constant Int        := Number_Dimensions (Typ);
+
          Counter_Id      : Entity_Id;
          Dim             : Int;
          F               : Node_Id;
@@ -5611,9 +5612,6 @@ package body Exp_Ch7 is
          Loop_Id         : Node_Id;
          Stmts           : List_Id;
 
-         Exceptions_OK : constant Boolean :=
-                           not Restriction_Active (No_Exception_Propagation);
-
          function Build_Counter_Assignment return Node_Id;
          --  Generate the following assignment:
          --    Counter := V'Length (1) *
@@ -5751,9 +5749,7 @@ package body Exp_Ch7 is
          --    if Counter > 0 then
          --       Counter := Counter - 1;
          --    else
-         --       [Deep_]Finalize (V (F1, ..., FN));  --  No_Except_Propagation
-
-         --       begin                               --  Exceptions allowed
+         --       begin
          --          [Deep_]Finalize (V (F1, ..., FN));
          --       exception
          --          when others =>
@@ -5852,18 +5848,17 @@ package body Exp_Ch7 is
 
          --       <final loop>
 
-         --       if Raised and then not Abort then  --  Exception handlers OK
+         --       if Raised and then not Abort then
          --          Raise_From_Controlled_Operation (E);
          --       end if;
 
-         --       raise;  --  Exception handlers OK
+         --       raise;
          --    end;
 
          Stmts := New_List (Build_Counter_Assignment, Final_Loop);
 
          if Exceptions_OK then
-            Append_To (Stmts,
-              Build_Raise_Statement (Finalizer_Data));
+            Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
             Append_To (Stmts, Make_Raise_Statement (Loc));
          end if;
 
@@ -6243,17 +6238,17 @@ package body Exp_Ch7 is
       -----------------------------
 
       function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is
-         Loc             : constant Source_Ptr := Sloc (Typ);
-         Typ_Def         : constant Node_Id := Type_Definition (Parent (Typ));
+         Exceptions_OK  : constant Boolean    :=
+                            not Restriction_Active (No_Exception_Propagation);
+         Loc            : constant Source_Ptr := Sloc (Typ);
+         Typ_Def        : constant Node_Id := Type_Definition (Parent (Typ));
+
          Bod_Stmts       : List_Id;
          Finalizer_Data  : Finalization_Exception_Data;
          Finalizer_Decls : List_Id := No_List;
          Rec_Def         : Node_Id;
          Var_Case        : Node_Id;
 
-         Exceptions_OK : constant Boolean :=
-                           not Restriction_Active (No_Exception_Propagation);
-
          function Process_Component_List_For_Adjust
            (Comps : Node_Id) return List_Id;
          --  Build all necessary adjust statements for a single component list
@@ -6285,11 +6280,9 @@ package body Exp_Ch7 is
                Adj_Stmt : Node_Id;
 
             begin
-               --  Generate:
-               --    [Deep_]Adjust (V.Id);  --  No_Exception_Propagation
-
-               --    begin                  --  Exception handlers allowed
+               --    begin
                --       [Deep_]Adjust (V.Id);
+
                --    exception
                --       when others =>
                --          if not Raised then
@@ -6523,10 +6516,9 @@ package body Exp_Ch7 is
                        Skip_Self => True);
 
                   --  Generate:
-                  --    Deep_Adjust (V._parent, False);  --  No_Except_Propagat
-
-                  --    begin                            --  Exceptions OK
+                  --    begin
                   --       Deep_Adjust (V._parent, False);
+
                   --    exception
                   --       when Id : others =>
                   --          if not Raised then
@@ -6568,10 +6560,9 @@ package body Exp_Ch7 is
 
                --  Generate:
                --    if F then
-               --       Adjust (V);  --  No_Exception_Propagation
-
-               --       begin        --  Exception handlers allowed
+               --       begin
                --          Adjust (V);
+
                --       exception
                --          when others =>
                --             if not Raised then
@@ -6635,8 +6626,7 @@ package body Exp_Ch7 is
 
          else
             if Exceptions_OK then
-               Append_To (Bod_Stmts,
-                 Build_Raise_Statement (Finalizer_Data));
+               Append_To (Bod_Stmts, Build_Raise_Statement (Finalizer_Data));
             end if;
 
             return
@@ -6654,8 +6644,11 @@ package body Exp_Ch7 is
       -------------------------------
 
       function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is
-         Loc             : constant Source_Ptr := Sloc (Typ);
-         Typ_Def         : constant Node_Id := Type_Definition (Parent (Typ));
+         Exceptions_OK  : constant Boolean    :=
+                            not Restriction_Active (No_Exception_Propagation);
+         Loc            : constant Source_Ptr := Sloc (Typ);
+         Typ_Def        : constant Node_Id := Type_Definition (Parent (Typ));
+
          Bod_Stmts       : List_Id;
          Counter         : Int := 0;
          Finalizer_Data  : Finalization_Exception_Data;
@@ -6663,9 +6656,6 @@ package body Exp_Ch7 is
          Rec_Def         : Node_Id;
          Var_Case        : Node_Id;
 
-         Exceptions_OK : constant Boolean :=
-                           not Restriction_Active (No_Exception_Propagation);
-
          function Process_Component_List_For_Finalize
            (Comps : Node_Id) return List_Id;
          --  Build all necessary finalization statements for a single component
@@ -7096,10 +7086,9 @@ package body Exp_Ch7 is
                        Skip_Self => True);
 
                   --  Generate:
-                  --    Deep_Finalize (V._parent, False);  --  No_Except_Propag
-
-                  --    begin                              --  Exceptions OK
+                  --    begin
                   --       Deep_Finalize (V._parent, False);
+
                   --    exception
                   --       when Id : others =>
                   --          if not Raised then
@@ -7142,10 +7131,9 @@ package body Exp_Ch7 is
 
                --  Generate:
                --    if F then
-               --       Finalize (V);  --  No_Exception_Propagation
-
                --       begin
                --          Finalize (V);
+
                --       exception
                --          when others =>
                --             if not Raised then
@@ -7207,8 +7195,7 @@ package body Exp_Ch7 is
 
          else
             if Exceptions_OK then
-               Append_To (Bod_Stmts,
-                 Build_Raise_Statement (Finalizer_Data));
+               Append_To (Bod_Stmts, Build_Raise_Statement (Finalizer_Data));
             end if;
 
             return
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 0c9419e..07dfb9b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4315,15 +4315,18 @@ package body Exp_Ch9 is
       if Nkind (Op_Spec) = N_Function_Specification then
          if Exc_Safe then
             R := Make_Temporary (Loc, 'R');
+
             Unprot_Call :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => R,
-                Constant_Present => True,
-                Object_Definition => New_Copy (Result_Definition (N_Op_Spec)),
-                Expression =>
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Copy (Result_Definition (N_Op_Spec)),
+                Expression          =>
                   Make_Function_Call (Loc,
-                    Name => Make_Identifier (Loc,
-                      Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
+                    Name                   =>
+                      Make_Identifier (Loc,
+                        Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
                     Parameter_Associations => Uactuals));
 
             Return_Stmt :=
@@ -4331,12 +4334,14 @@ package body Exp_Ch9 is
                 Expression => New_Occurrence_Of (R, Loc));
 
          else
-            Unprot_Call := Make_Simple_Return_Statement (Loc,
-              Expression => Make_Function_Call (Loc,
-                Name =>
-                  Make_Identifier (Loc,
-                    Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
-                Parameter_Associations => Uactuals));
+            Unprot_Call :=
+              Make_Simple_Return_Statement (Loc,
+                Expression =>
+                  Make_Function_Call (Loc,
+                    Name                   =>
+                      Make_Identifier (Loc,
+                        Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
+                    Parameter_Associations => Uactuals));
          end if;
 
          Lock_Kind := RE_Lock_Read_Only;
@@ -4344,7 +4349,7 @@ package body Exp_Ch9 is
       else
          Unprot_Call :=
            Make_Procedure_Call_Statement (Loc,
-             Name =>
+             Name                   =>
                Make_Identifier (Loc, Chars (Defining_Unit_Name (N_Op_Spec))),
              Parameter_Associations => Uactuals);
 
@@ -4354,10 +4359,11 @@ package body Exp_Ch9 is
       --  Wrap call in block that will be covered by an at_end handler
 
       if not Exc_Safe then
-         Unprot_Call := Make_Block_Statement (Loc,
-           Handled_Statement_Sequence =>
-             Make_Handled_Sequence_Of_Statements (Loc,
-               Statements => New_List (Unprot_Call)));
+         Unprot_Call :=
+           Make_Block_Statement (Loc,
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => New_List (Unprot_Call)));
       end if;
 
       --  Make the protected subprogram body. This locks the protected
@@ -4379,21 +4385,20 @@ package body Exp_Ch9 is
 
       Object_Parm :=
         Make_Attribute_Reference (Loc,
-           Prefix =>
+           Prefix         =>
              Make_Selected_Component (Loc,
                Prefix        => Make_Identifier (Loc, Name_uObject),
                Selector_Name => Make_Identifier (Loc, Name_uObject)),
            Attribute_Name => Name_Unchecked_Access);
 
-      Lock_Stmt := Make_Procedure_Call_Statement (Loc,
-        Name => Lock_Name,
-        Parameter_Associations => New_List (Object_Parm));
+      Lock_Stmt :=
+        Make_Procedure_Call_Statement (Loc,
+          Name                   => Lock_Name,
+          Parameter_Associations => New_List (Object_Parm));
 
       if Abort_Allowed then
          Stmts := New_List (
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
-             Parameter_Associations => Empty_List),
+           Build_Runtime_Call (Loc, RE_Abort_Defer),
            Lock_Stmt);
 
       else
@@ -4417,20 +4422,21 @@ package body Exp_Ch9 is
          Build_Protected_Subprogram_Call_Cleanup (Op_Spec, Pid, Loc, Stmts);
 
          if Nkind (Op_Spec) = N_Function_Specification then
-            Append (Return_Stmt, Stmts);
-            Append (Make_Block_Statement (Loc,
-              Declarations => New_List (Unprot_Call),
-              Handled_Statement_Sequence =>
-                Make_Handled_Sequence_Of_Statements (Loc,
-                  Statements => Stmts)), Pre_Stmts);
+            Append_To (Stmts, Return_Stmt);
+            Append_To (Pre_Stmts,
+              Make_Block_Statement (Loc,
+                Declarations               => New_List (Unprot_Call),
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => Stmts)));
             Stmts := Pre_Stmts;
          end if;
       end if;
 
       Sub_Body :=
         Make_Subprogram_Body (Loc,
-          Declarations => Empty_List,
-          Specification => P_Op_Spec,
+          Declarations               => Empty_List,
+          Specification              => P_Op_Spec,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts));
 
@@ -4594,11 +4600,7 @@ package body Exp_Ch9 is
       --    Abort_Undefer;
 
       if Abort_Allowed then
-         Append_To (Stmts,
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
-             Parameter_Associations => Empty_List));
+         Append_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
       end if;
    end Build_Protected_Subprogram_Call_Cleanup;
 
@@ -7169,6 +7171,8 @@ package body Exp_Ch9 is
                Name => New_Occurrence_Of (Proc, Loc)));
       end Rewrite_Abortable_Part;
 
+   --  Start of processing for Expand_N_Asynchronous_Select
+
    begin
       Process_Statements_For_Controlled_Objects (Trig);
       Process_Statements_For_Controlled_Objects (Abrt);
@@ -7426,23 +7430,19 @@ package body Exp_Ch9 is
                       Name_uDisp_Asynchronous_Select),
                     Loc),
 
-                Parameter_Associations =>
-                  New_List (
-                    New_Copy_Tree (Obj),             --  <object>
-                    New_Occurrence_Of (S, Loc),       --  S
-                    Make_Attribute_Reference (Loc,   --  P'Address
-                      Prefix         => New_Occurrence_Of (P, Loc),
-                      Attribute_Name => Name_Address),
-                    Make_Identifier (Loc, Name_uD),  --  D
-                    New_Occurrence_Of (B, Loc))));    --  B
+                Parameter_Associations => New_List (
+                  New_Copy_Tree (Obj),             --  <object>
+                  New_Occurrence_Of (S, Loc),      --  S
+                  Make_Attribute_Reference (Loc,   --  P'Address
+                    Prefix         => New_Occurrence_Of (P, Loc),
+                    Attribute_Name => Name_Address),
+                  Make_Identifier (Loc, Name_uD),  --  D
+                  New_Occurrence_Of (B, Loc))));   --  B
 
             --  Generate:
             --    Abort_Defer;
 
-            Prepend_To (TaskE_Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
-                Parameter_Associations => No_List));
+            Prepend_To (TaskE_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
 
             --  Generate:
             --    Abort_Undefer;
@@ -7450,10 +7450,8 @@ package body Exp_Ch9 is
 
             Cleanup_Stmts := New_Copy_List_Tree (Astats);
 
-            Prepend_To (Cleanup_Stmts,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
-                Parameter_Associations => No_List));
+            Prepend_To
+              (Cleanup_Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
 
             --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
             --  will generate a _clean for the additional status flag.
@@ -7640,9 +7638,7 @@ package body Exp_Ch9 is
 
             Hdle := New_List (Build_Abort_Block_Handler (Loc));
 
-            Prepend_To (Astats,
-              Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
+            Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer));
 
             Abortable_Block :=
               Make_Block_Statement (Loc,
@@ -7788,17 +7784,14 @@ package body Exp_Ch9 is
              Has_Created_Identifier => True,
              Is_Asynchronous_Call_Block => True);
 
-         if Exception_Mechanism = Back_End_Exceptions then
-
-            --  Aborts are not deferred at beginning of exception handlers
-            --  in ZCX.
+         --  Aborts are not deferred at beginning of exception handlers in
+         --  ZCX.
 
+         if Exception_Mechanism = Back_End_Exceptions then
             Handler_Stmt := Make_Null_Statement (Loc);
 
          else
-            Handler_Stmt := Make_Procedure_Call_Statement (Loc,
-              Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
-              Parameter_Associations => No_List);
+            Handler_Stmt := Build_Runtime_Call (Loc, RE_Abort_Undefer);
          end if;
 
          Stmts := New_List (
@@ -7881,9 +7874,7 @@ package body Exp_Ch9 is
 
          Hdle := New_List (Build_Abort_Block_Handler (Loc));
 
-         Prepend_To (Astats,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
+         Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer));
 
          Abortable_Block :=
            Make_Block_Statement (Loc,
@@ -7927,10 +7918,7 @@ package body Exp_Ch9 is
 
          --  Protected the call against abort
 
-         Prepend_To (Stmts,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
-             Parameter_Associations => Empty_List));
+         Prepend_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
       end if;
 
       Set_Entry_Cancel_Parameter (Blk_Ent, Cancel_Param);
@@ -10762,9 +10750,7 @@ package body Exp_Ch9 is
             --  analysis with unknown calls, so don't do it.
 
             if not CodePeer_Mode then
-               Call :=
-                 Make_Procedure_Call_Statement (Eloc,
-                   Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Eloc));
+               Call := Build_Runtime_Call (Loc, RE_Abort_Undefer);
                Insert_Before
                  (First (Statements (Handled_Statement_Sequence
                                        (Accept_Statement (Alt)))),
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index a76486b..ab30c1f 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -1022,6 +1022,7 @@ package body Exp_Intr is
 
       Abrt_Blk    : Node_Id := Empty;
       Abrt_Blk_Id : Entity_Id;
+      Abrt_HSS    : Node_Id;
       AUD         : Entity_Id;
       Fin_Blk     : Node_Id;
       Fin_Call    : Node_Id;
@@ -1031,10 +1032,6 @@ package body Exp_Intr is
       Gen_Code    : Node_Id;
       Obj_Ref     : Node_Id;
 
-      Dummy : Entity_Id;
-      --  This variable captures an unused dummy internal entity, see the
-      --  comment associated with its use.
-
    begin
       --  Nothing to do if we know the argument is null
 
@@ -1048,10 +1045,10 @@ package body Exp_Intr is
       --    Ex     : Exception_Occurrence;
       --    Raised : Boolean := False;
 
-      --    begin                             --  aborts allowed
+      --    begin
       --       Abort_Defer;
 
-      --       begin                          --  exception propagation allowed
+      --       begin
       --          [Deep_]Finalize (Obj_Ref);
 
       --       exception
@@ -1121,50 +1118,51 @@ package body Exp_Intr is
                     Exception_Handlers => New_List (
                       Build_Exception_Handler (Fin_Data))));
 
-            --  The finalization action must be protected by an abort defer
-            --  undefer pair when aborts are allowed. Generate:
+         --  Otherwise exception propagation is not allowed
 
-            --    begin
-            --       Abort_Defer;
-            --       <Fin_Blk>
-            --    at end
-            --       Abort_Undefer_Direct;
-            --    end;
+         else
+            Fin_Blk := Fin_Call;
+         end if;
 
-            if Abort_Allowed then
-               AUD := RTE (RE_Abort_Undefer_Direct);
+         --  The finalization action must be protected by an abort defer and
+         --  undefer pair when aborts are allowed. Generate:
 
-               Abrt_Blk :=
-                 Make_Block_Statement (Loc,
-                   Handled_Statement_Sequence =>
-                     Make_Handled_Sequence_Of_Statements (Loc,
-                       Statements  => New_List (
-                         Build_Runtime_Call (Loc, RE_Abort_Defer),
-                         Fin_Blk),
-                       At_End_Proc => New_Occurrence_Of (AUD, Loc)));
+         --    begin
+         --       Abort_Defer;
+         --       <Fin_Blk>
+         --    at end
+         --       Abort_Undefer_Direct;
+         --    end;
 
-               Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id);
+         if Abort_Allowed then
+            AUD := RTE (RE_Abort_Undefer_Direct);
 
-               --  Present the Abort_Undefer_Direct function to the backend so
-               --  that it can inline the call to the function.
+            Abrt_HSS :=
+              Make_Handled_Sequence_Of_Statements (Loc,
+                Statements  => New_List (
+                  Build_Runtime_Call (Loc, RE_Abort_Defer),
+                  Fin_Blk),
+                At_End_Proc => New_Occurrence_Of (AUD, Loc));
 
-               Add_Inlined_Body (AUD, N);
-               Append_To (Stmts, Abrt_Blk);
+            Abrt_Blk :=
+              Make_Block_Statement (Loc,
+                Handled_Statement_Sequence => Abrt_HSS);
 
-            --  Otherwise aborts are not allowed. Generate a dummy entity to
-            --  ensure that the internal symbols are in sync when a unit is
-            --  compiled with and without aborts.
+            Add_Block_Identifier  (Abrt_Blk, Abrt_Blk_Id);
+            Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
 
-            else
-               Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
-               Append_To (Stmts, Fin_Blk);
-            end if;
+            --  Present the Abort_Undefer_Direct function to the backend so
+            --  that it can inline the call to the function.
 
-         --  Otherwise exception propagation is not allowed
+            Add_Inlined_Body (AUD, N);
+
+         --  Otherwise aborts are not allowed
 
          else
-            Append_To (Stmts, Fin_Call);
+            Abrt_Blk := Fin_Blk;
          end if;
+
+         Append_To (Stmts, Abrt_Blk);
       end if;
 
       --  For a task type, call Free_Task before freeing the ATCB. We used to
@@ -1174,8 +1172,8 @@ package body Exp_Intr is
       --  (the task will be freed once it terminates).
 
       if Is_Task_Type (Desig_Typ) then
-         Append_To
-           (Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
+         Append_To (Stmts,
+           Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
 
       --  For composite types that contain tasks, recurse over the structure
       --  to build the selectors for the task subcomponents.
@@ -1411,15 +1409,6 @@ package body Exp_Intr is
 
       Rewrite (N, Gen_Code);
       Analyze (N);
-
-      --  If we generated a block with an At_End_Proc, expand the exception
-      --  handler. We need to wait until after everything else is analyzed.
-
-      if Present (Abrt_Blk) then
-         Expand_At_End_Handler
-           (HSS    => Handled_Statement_Sequence (Abrt_Blk),
-            Blk_Id => Entity (Identifier (Abrt_Blk)));
-      end if;
    end Expand_Unc_Deallocation;
 
    -----------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5810dd5..3d534bd 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9453,19 +9453,4 @@ package body Exp_Util is
         and then not Is_Predicate_Function_M (S);
    end Within_Internal_Subprogram;
 
-   ----------------------------
-   -- Wrap_Cleanup_Procedure --
-   ----------------------------
-
-   procedure Wrap_Cleanup_Procedure (N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (N);
-      Stseq : constant Node_Id    := Handled_Statement_Sequence (N);
-      Stmts : constant List_Id    := Statements (Stseq);
-   begin
-      if Abort_Allowed then
-         Prepend_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
-         Append_To  (Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
-      end if;
-   end Wrap_Cleanup_Procedure;
-
 end Exp_Util;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 10fd70c..1357b3b 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -1020,15 +1020,6 @@ package Exp_Util is
    --  predefined primitive operation. Some expansion activity (e.g. predicate
    --  checks) is disabled in such.
 
-   procedure Wrap_Cleanup_Procedure (N : Node_Id);
-   --  Given an N_Subprogram_Body node, this procedure adds an Abort_Defer call
-   --  at the start of the statement sequence, and an Abort_Undefer call at the
-   --  end of the statement sequence. All cleanup routines (i.e. those that are
-   --  called from "at end" handlers) must defer abort on entry and undefer
-   --  abort on exit. Note that it is assumed that the code for the procedure
-   --  does not contain any return statements which would allow the flow of
-   --  control to escape doing the undefer call.
-
 private
    pragma Inline (Duplicate_Subexpr);
    pragma Inline (Force_Evaluation);