[multiple changes]

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.

2016-07-06  Justin Squirek  <squirek@adacore.com>

	* sem_ch4.adb (Analyze_One_Call): Add a conditional to handle
	disambiguation.

From-SVN: r238045

10 files changed, 360 insertions, 89 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be8759c..764ba8d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,39 @@
 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.
+
+2016-07-06  Justin Squirek  <squirek@adacore.com>
+
+	* sem_ch4.adb (Analyze_One_Call): Add a conditional to handle
+	disambiguation.
+
+2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
 	is now used as Is_Ignored_Transient.
 	(Is_Finalized_Transient): New routine.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 7d1db3e..33374d3 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -35,12 +35,10 @@ with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Ch9;  use Exp_Ch9;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Disp; use Exp_Disp;
 with Exp_Tss;  use Exp_Tss;
 with Fname;    use Fname;
 with Freeze;   use Freeze;
-with Inline;   use Inline;
 with Itypes;   use Itypes;
 with Lib;      use Lib;
 with Namet;    use Namet;
@@ -1121,10 +1119,39 @@ package body Exp_Aggr is
             Init_Expr : Node_Id;
             Stmts     : List_Id)
          is
+            Exceptions_OK : constant Boolean :=
+                              not Restriction_Active
+                                    (No_Exception_Propagation);
+
+            Finalization_OK : constant Boolean :=
+                                Present (Comp_Typ)
+                                  and then Needs_Finalization (Comp_Typ);
+
             Full_Typ  : constant Entity_Id := Underlying_Type (Comp_Typ);
+            Blk_Stmts : List_Id;
             Init_Stmt : Node_Id;
 
          begin
+            --  Protect the initialization statements from aborts. Generate:
+
+            --    Abort_Defer;
+
+            if Finalization_OK and Abort_Allowed then
+               if Exceptions_OK then
+                  Blk_Stmts := New_List;
+               else
+                  Blk_Stmts := Stmts;
+               end if;
+
+               Append_To (Blk_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
+
+            --  Otherwise aborts are not allowed. All generated code is added
+            --  directly to the input list.
+
+            else
+               Blk_Stmts := Stmts;
+            end if;
+
             --  Initialize the array element. Generate:
 
             --    Arr_Comp := Init_Expr;
@@ -1148,10 +1175,7 @@ package body Exp_Aggr is
             --       Arr_Comp := Init_Expr;
             --    end;
 
-            if Present (Comp_Typ)
-              and then Needs_Finalization (Comp_Typ)
-              and then Is_Array_Type (Comp_Typ)
-            then
+            if Finalization_OK and then Is_Array_Type (Comp_Typ) then
                Init_Stmt :=
                  Make_Block_Statement (Loc,
                    Handled_Statement_Sequence =>
@@ -1159,7 +1183,7 @@ package body Exp_Aggr is
                        Statements => New_List (Init_Stmt)));
             end if;
 
-            Append_To (Stmts, Init_Stmt);
+            Append_To (Blk_Stmts, Init_Stmt);
 
             --  Adjust the tag due to a possible view conversion. Generate:
 
@@ -1169,7 +1193,7 @@ package body Exp_Aggr is
               and then Present (Comp_Typ)
               and then Is_Tagged_Type (Comp_Typ)
             then
-               Append_To (Stmts,
+               Append_To (Blk_Stmts,
                  Make_OK_Assignment_Statement (Loc,
                    Name       =>
                      Make_Selected_Component (Loc,
@@ -1191,19 +1215,54 @@ package body Exp_Aggr is
 
             --    [Deep_]Adjust (Arr_Comp);
 
-            if Present (Comp_Typ)
-              and then Needs_Finalization (Comp_Typ)
+            if Finalization_OK
               and then not Is_Limited_Type (Comp_Typ)
               and then not
                 (Is_Array_Type (Comp_Typ)
                   and then Is_Controlled (Component_Type (Comp_Typ))
                   and then Nkind (Expr) = N_Aggregate)
             then
-               Append_To (Stmts,
+               Append_To (Blk_Stmts,
                  Make_Adjust_Call
                    (Obj_Ref => New_Copy_Tree (Arr_Comp),
                     Typ     => Comp_Typ));
             end if;
+
+            --  Complete the protection of the initialization statements
+
+            if Finalization_OK and Abort_Allowed then
+
+               --  Wrap the initialization statements in a block to catch a
+               --  potential exception. Generate:
+
+               --    begin
+               --       Abort_Defer;
+               --       Arr_Comp := Init_Expr;
+               --       Arr_Comp._tag := Full_TypP;
+               --       [Deep_]Adjust (Arr_Comp);
+               --    at end
+               --       Abort_Undefer_Direct;
+               --    end;
+
+               if Exceptions_OK then
+                  Append_To (Stmts,
+                    Build_Abort_Undefer_Block (Loc,
+                      Stmts   => Blk_Stmts,
+                      Context => N));
+
+               --  Otherwise exceptions are not propagated. Generate:
+
+               --    Abort_Defer;
+               --    Arr_Comp := Init_Expr;
+               --    Arr_Comp._tag := Full_TypP;
+               --    [Deep_]Adjust (Arr_Comp);
+               --    Abort_Undefer;
+
+               else
+                  Append_To (Blk_Stmts,
+                    Build_Runtime_Call (Loc, RE_Abort_Undefer));
+               end if;
+            end if;
          end Initialize_Array_Component;
 
          -------------------------------------
@@ -2772,10 +2831,36 @@ package body Exp_Aggr is
          Init_Expr : Node_Id;
          Stmts     : List_Id)
       is
+         Exceptions_OK : constant Boolean :=
+                           not Restriction_Active (No_Exception_Propagation);
+
+         Finalization_OK : constant Boolean := Needs_Finalization (Comp_Typ);
+
          Full_Typ  : constant Entity_Id := Underlying_Type (Comp_Typ);
+         Blk_Stmts : List_Id;
          Init_Stmt : Node_Id;
 
       begin
+         --  Protect the initialization statements from aborts. Generate:
+
+         --    Abort_Defer;
+
+         if Finalization_OK and Abort_Allowed then
+            if Exceptions_OK then
+               Blk_Stmts := New_List;
+            else
+               Blk_Stmts := Stmts;
+            end if;
+
+            Append_To (Blk_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
+
+         --  Otherwise aborts are not allowed. All generated code is added
+         --  directly to the input list.
+
+         else
+            Blk_Stmts := Stmts;
+         end if;
+
          --  Initialize the record component. Generate:
 
          --    Rec_Comp := Init_Expr;
@@ -2789,14 +2874,14 @@ package body Exp_Aggr is
              Expression => Init_Expr);
          Set_No_Ctrl_Actions (Init_Stmt);
 
-         Append_To (Stmts, Init_Stmt);
+         Append_To (Blk_Stmts, Init_Stmt);
 
          --  Adjust the tag due to a possible view conversion. Generate:
 
          --    Rec_Comp._tag := Full_TypeP;
 
          if Tagged_Type_Expansion and then Is_Tagged_Type (Comp_Typ) then
-            Append_To (Stmts,
+            Append_To (Blk_Stmts,
               Make_OK_Assignment_Statement (Loc,
                 Name       =>
                   Make_Selected_Component (Loc,
@@ -2816,14 +2901,48 @@ package body Exp_Aggr is
 
          --    [Deep_]Adjust (Rec_Comp);
 
-         if Needs_Finalization (Comp_Typ)
-           and then not Is_Limited_Type (Comp_Typ)
-         then
-            Append_To (Stmts,
+         if Finalization_OK and then not Is_Limited_Type (Comp_Typ) then
+            Append_To (Blk_Stmts,
               Make_Adjust_Call
                 (Obj_Ref => New_Copy_Tree (Rec_Comp),
                  Typ     => Comp_Typ));
          end if;
+
+         --  Complete the protection of the initialization statements
+
+         if Finalization_OK and Abort_Allowed then
+
+            --  Wrap the initialization statements in a block to catch a
+            --  potential exception. Generate:
+
+            --    begin
+            --       Abort_Defer;
+            --       Rec_Comp := Init_Expr;
+            --       Rec_Comp._tag := Full_TypP;
+            --       [Deep_]Adjust (Rec_Comp);
+            --    at end
+            --       Abort_Undefer_Direct;
+            --    end;
+
+            if Exceptions_OK then
+               Append_To (Stmts,
+                 Build_Abort_Undefer_Block (Loc,
+                   Stmts   => Blk_Stmts,
+                   Context => N));
+
+            --  Otherwise exceptions are not propagated. Generate:
+
+            --    Abort_Defer;
+            --    Rec_Comp := Init_Expr;
+            --    Rec_Comp._tag := Full_TypP;
+            --    [Deep_]Adjust (Rec_Comp);
+            --    Abort_Undefer;
+
+            else
+               Append_To (Blk_Stmts,
+                 Build_Runtime_Call (Loc, RE_Abort_Undefer));
+            end if;
+         end if;
       end Initialize_Record_Component;
 
       -------------------------
@@ -7804,43 +7923,22 @@ package body Exp_Aggr is
       --       Hook := null;
       --       [Deep_]Finalize (Res.all);
       --    at end
-      --       Abort_Undefer;
+      --       Abort_Undefer_Direct;
       --    end;
 
       elsif Abort_Allowed then
          Abort_Only : declare
             Blk_Stmts : constant List_Id := New_List;
 
-            AUD     : Entity_Id;
-            Blk     : Node_Id;
-            Blk_HSS : Node_Id;
-            Blk_Id  : Entity_Id;
-
          begin
             Append_To (Blk_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
             Append_To (Blk_Stmts, Hook_Clear);
             Append_To (Blk_Stmts, Fin_Call);
 
-            AUD := RTE (RE_Abort_Undefer_Direct);
-
-            Blk_HSS :=
-              Make_Handled_Sequence_Of_Statements (Loc,
-                Statements  => Blk_Stmts,
-                At_End_Proc => New_Occurrence_Of (AUD, Loc));
-
-            Blk :=
-              Make_Block_Statement (Loc,
-                Handled_Statement_Sequence => Blk_HSS);
-
-            Add_Block_Identifier (Blk, Blk_Id);
-            Expand_At_End_Handler (Blk_HSS, Blk_Id);
-
-            --  Present the Abort_Undefer_Direct function to the back end so
-            --  that it can inline the call to the function.
-
-            Add_Inlined_Body (AUD, Aggr);
-
-            Append_To (Stmts, Blk);
+            Append_To (Stmts,
+              Build_Abort_Undefer_Block (Loc,
+                Stmts   => Blk_Stmts,
+                Context => Aggr));
          end Abort_Only;
 
       --  Otherwise generate:
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 923eca3..6f7ae0a 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -34,7 +34,6 @@ with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Ch9;  use Exp_Ch9;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
 with Exp_Disp; use Exp_Disp;
 with Exp_Dist; use Exp_Dist;
@@ -44,7 +43,6 @@ with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Ghost;    use Ghost;
-with Inline;   use Inline;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -5519,16 +5517,12 @@ package body Exp_Ch3 is
          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;
+         Aggr_Init  : Node_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
 
@@ -5726,26 +5720,10 @@ package body Exp_Ch3 is
             --    end;
 
             if Exceptions_OK then
-               AUD := RTE (RE_Abort_Undefer_Direct);
-
-               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,
-                   Handled_Statement_Sequence => Abrt_HSS);
-
-               Add_Block_Identifier  (Abrt_Blk, Abrt_Blk_Id);
-               Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
-
-               --  Present the Abort_Undefer_Direct function to the backend so
-               --  that it can inline the call to the function.
-
-               Add_Inlined_Body (AUD, N);
-
-               Init_Stmts := New_List (Abrt_Blk);
+               Init_Stmts := New_List (
+                 Build_Abort_Undefer_Block (Loc,
+                   Stmts   => Init_Stmts,
+                   Context => N));
 
             --  Otherwise exceptions are not propagated. Generate:
 
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 2a3ecbf..7734229 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2371,6 +2371,8 @@ package body Exp_Ch5 is
                   AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
 
                begin
+                  Set_Is_Abort_Block (N);
+
                   Set_Scope (Blk, Current_Scope);
                   Set_Etype (Blk, Standard_Void_Type);
                   Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 34f2150..9591e19 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -13217,17 +13217,30 @@ package body Exp_Ch9 is
       --  package or return statement.
 
       Context := Parent (N);
-      while not Nkind_In (Context, N_Block_Statement,
-                                   N_Entry_Body,
-                                   N_Extended_Return_Statement,
-                                   N_Package_Body,
-                                   N_Package_Declaration,
-                                   N_Subprogram_Body,
-                                   N_Task_Body)
-      loop
+      while Present (Context) loop
+         if Nkind_In (Context, N_Entry_Body,
+                               N_Extended_Return_Statement,
+                               N_Package_Body,
+                               N_Package_Declaration,
+                               N_Subprogram_Body,
+                               N_Task_Body)
+         then
+            exit;
+
+         --  Do not consider block created to protect a list of statements with
+         --  an Abort_Defer / Abort_Undefer_Direct pair.
+
+         elsif Nkind (Context) = N_Block_Statement
+           and then not Is_Abort_Block (Context)
+         then
+            exit;
+         end if;
+
          Context := Parent (Context);
       end loop;
 
+      pragma Assert (Present (Context));
+
       --  Extract the constituents of the context
 
       if Nkind (Context) = N_Extended_Return_Statement then
@@ -13258,8 +13271,6 @@ package body Exp_Ch9 is
          end if;
 
       else
-         Context_Decls := Declarations (Context);
-
          if Nkind (Context) = N_Block_Statement then
             Context_Id := Entity (Identifier (Context));
 
@@ -13283,9 +13294,10 @@ package body Exp_Ch9 is
          else
             raise Program_Error;
          end if;
+
+         Context_Decls := Declarations (Context);
       end if;
 
-      pragma Assert (Present (Context));
       pragma Assert (Present (Context_Id));
       pragma Assert (Present (Context_Decls));
    end Find_Enclosing_Context;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 92a3aab..6d6d754 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -34,6 +34,7 @@ with Errout;   use Errout;
 with Exp_Aggr; use Exp_Aggr;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_Ch7;  use Exp_Ch7;
+with Exp_Ch11; use Exp_Ch11;
 with Ghost;    use Ghost;
 with Inline;   use Inline;
 with Itypes;   use Itypes;
@@ -724,7 +725,7 @@ package body Exp_Util is
          --  For deallocation of class-wide types we obtain the value of
          --  alignment from the Type Specific Record of the deallocated object.
          --  This is needed because the frontend expansion of class-wide types
-         --  into equivalent types confuses the backend.
+         --  into equivalent types confuses the back end.
 
          else
             --  Generate:
@@ -930,6 +931,59 @@ package body Exp_Util is
       end;
    end Build_Allocate_Deallocate_Proc;
 
+   -------------------------------
+   -- Build_Abort_Undefer_Block --
+   -------------------------------
+
+   function Build_Abort_Undefer_Block
+     (Loc     : Source_Ptr;
+      Stmts   : List_Id;
+      Context : Node_Id) return Node_Id
+   is
+      Exceptions_OK : constant Boolean :=
+                        not Restriction_Active (No_Exception_Propagation);
+
+      AUD    : Entity_Id;
+      Blk    : Node_Id;
+      Blk_Id : Entity_Id;
+      HSS    : Node_Id;
+
+   begin
+      --  The block should be generated only when undeferring abort in the
+      --  context of a potential exception.
+
+      pragma Assert (Abort_Allowed and Exceptions_OK);
+
+      --  Generate:
+      --    begin
+      --       <Stmts>
+      --    at end
+      --       Abort_Undefer_Direct;
+      --    end;
+
+      AUD := RTE (RE_Abort_Undefer_Direct);
+
+      HSS :=
+        Make_Handled_Sequence_Of_Statements (Loc,
+          Statements  => Stmts,
+          At_End_Proc => New_Occurrence_Of (AUD, Loc));
+
+      Blk :=
+        Make_Block_Statement (Loc,
+          Handled_Statement_Sequence => HSS);
+      Set_Is_Abort_Block (Blk);
+
+      Add_Block_Identifier  (Blk, Blk_Id);
+      Expand_At_End_Handler (HSS, Blk_Id);
+
+      --  Present the Abort_Undefer_Direct function to the back end to inline
+      --  the call to the routine.
+
+      Add_Inlined_Body (AUD, Context);
+
+      return Blk;
+   end Build_Abort_Undefer_Block;
+
    --------------------------
    -- Build_Procedure_Form --
    --------------------------
@@ -2441,7 +2495,7 @@ package body Exp_Util is
       --  If the type of the expression is an internally generated type it
       --  may not be necessary to create a new subtype. However there are two
       --  exceptions: references to the current instances, and aliased array
-      --  object declarations for which the backend needs to create a template.
+      --  object declarations for which the back end has to create a template.
 
       elsif Is_Constrained (Exp_Typ)
         and then not Is_Class_Wide_Type (Unc_Type)
@@ -9227,7 +9281,7 @@ package body Exp_Util is
       --  Note on checks that could raise Constraint_Error. Strictly, if we
       --  take advantage of 11.6, these checks do not count as side effects.
       --  However, we would prefer to consider that they are side effects,
-      --  since the backend CSE does not work very well on expressions which
+      --  since the back end CSE does not work very well on expressions which
       --  can raise Constraint_Error. On the other hand if we don't consider
       --  them to be side effect free, then we get some awkward expansions
       --  in -gnato mode, resulting in code insertions at a point where we
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index e5b9916..b82d408 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -238,6 +238,15 @@ package Exp_Util is
    --  must be a free statement. If flag Is_Allocate is set, the generated
    --  routine is allocate, deallocate otherwise.
 
+   function Build_Abort_Undefer_Block
+     (Loc     : Source_Ptr;
+      Stmts   : List_Id;
+      Context : Node_Id) return Node_Id;
+   --  Wrap statements Stmts in a block where the AT END handler contains a
+   --  call to Abort_Undefer_Direct. Context is the node which prompted the
+   --  inlining of the abort undefer routine. Note that this routine does
+   --  not install a call to Abort_Defer.
+
    procedure Build_Procedure_Form (N : Node_Id);
    --  Create a procedure declaration which emulates the behavior of a function
    --  that returns an array type, for C-compatible generation.
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 17c6308..5bbc1a3 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3480,6 +3480,61 @@ package body Sem_Ch4 is
                   Next_Actual (Actual);
                   Next_Formal (Formal);
 
+               --  In a complex case where an enclosing generic and a nested
+               --  generic package, both declared with partially parameterized
+               --  formal subprograms with the same names, are instantiated
+               --  with the same type, the types of the actual parameter and
+               --  that of the formal may appear incompatible at first sight.
+
+               --   generic
+               --      type Outer_T is private;
+               --      with function Func (Formal : Outer_T)
+               --                         return ... is <>;
+
+               --   package Outer_Gen is
+               --      generic
+               --         type Inner_T is private;
+               --         with function Func (Formal : Inner_T)   --  (1)
+               --                            return ... is <>;
+
+               --      package Inner_Gen is
+               --         function Inner_Func (Formal : Inner_T)  --  (2)
+               --                             return ... is (Func (Formal));
+               --      end Inner_Gen;
+               --   end Outer_Generic;
+
+               --   package Outer_Inst is new Outer_Gen (Actual_T);
+               --   package Inner_Inst is new Outer_Inst.Inner_Gen (Actual_T);
+
+               --  In the example above, the type of parameter
+               --  Inner_Func.Formal at (2) is incompatible with the type of
+               --  Func.Formal at (1) in the context of instantiations
+               --  Outer_Inst and Inner_Inst. In reality both types are
+               --  generic actual subtypes renaming base type Actual_T as
+               --  part of the generic prologues for the instantiations.
+
+               --  Recognize this case and add a type conversion to allow
+               --  this kind of generic actual subtype conformance. Note that
+               --  this is done only when the call is non-overloaded because
+               --  the resolution mechanism already has the means to
+               --  disambiguate similar cases.
+
+               elsif not Is_Overloaded (Name (N))
+                 and then Is_Type (Etype (Actual))
+                 and then Is_Type (Etype (Formal))
+                 and then Is_Generic_Actual_Type (Etype (Actual))
+                 and then Is_Generic_Actual_Type (Etype (Formal))
+                 and then Base_Type (Etype (Actual)) =
+                          Base_Type (Etype (Formal))
+               then
+                  Rewrite (Actual,
+                    Convert_To (Etype (Formal), Relocate_Node (Actual)));
+                  Analyze_And_Resolve (Actual, Etype (Formal));
+                  Next_Actual (Actual);
+                  Next_Formal (Formal);
+
+               --  Handle failed type check
+
                else
                   if Debug_Flag_E then
                      Write_Str (" type checking fails in call ");
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 5ea25db..9738101 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1752,6 +1752,14 @@ package body Sinfo is
       return Uint3 (N);
    end Intval;
 
+   function Is_Abort_Block
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      return Flag4 (N);
+   end Is_Abort_Block;
+
    function Is_Accessibility_Actual
      (N : Node_Id) return Boolean is
    begin
@@ -5015,6 +5023,14 @@ package body Sinfo is
       Set_Uint3 (N, Val);
    end Set_Intval;
 
+   procedure Set_Is_Abort_Block
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      Set_Flag4 (N, Val);
+   end Set_Is_Abort_Block;
+
    procedure Set_Is_Accessibility_Actual
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 29feb25..01d9be5 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1535,6 +1535,10 @@ package Sinfo is
    --    to the node for the spec of the instance, inserted as part of the
    --    semantic processing for instantiations in Sem_Ch12.
 
+   --  Is_Abort_Block (Flag4-Sem)
+   --    Present in N_Block_Statement nodes. True if the block protects a list
+   --    of statements with an Abort_Defer / Abort_Undefer_Direct pair.
+
    --  Is_Accessibility_Actual (Flag13-Sem)
    --    Present in N_Parameter_Association nodes. True if the parameter is
    --    an extra actual that carries the accessibility level of the actual
@@ -4937,6 +4941,7 @@ package Sinfo is
       --  Declarations (List2) (set to No_List if no DECLARE part)
       --  Handled_Statement_Sequence (Node4)
       --  Cleanup_Actions (List5-Sem)
+      --  Is_Abort_Block (Flag4-Sem)
       --  Is_Task_Master (Flag5-Sem)
       --  Activation_Chain_Entity (Node3-Sem)
       --  Has_Created_Identifier (Flag15)
@@ -9331,6 +9336,9 @@ package Sinfo is
    function Intval
      (N : Node_Id) return Uint;       -- Uint3
 
+   function Is_Abort_Block
+     (N : Node_Id) return Boolean;    -- Flag4
+
    function Is_Accessibility_Actual
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -10375,6 +10383,9 @@ package Sinfo is
    procedure Set_Intval
      (N : Node_Id; Val : Uint);               -- Uint3
 
+   procedure Set_Is_Abort_Block
+     (N : Node_Id; Val : Boolean := True);    -- Flag4
+
    procedure Set_Is_Accessibility_Actual
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -12819,6 +12830,7 @@ package Sinfo is
    pragma Inline (Instance_Spec);
    pragma Inline (Intval);
    pragma Inline (Iterator_Specification);
+   pragma Inline (Is_Abort_Block);
    pragma Inline (Is_Accessibility_Actual);
    pragma Inline (Is_Analyzed_Pragma);
    pragma Inline (Is_Asynchronous_Call_Block);
@@ -13162,6 +13174,7 @@ package Sinfo is
    pragma Inline (Set_Interface_List);
    pragma Inline (Set_Interface_Present);
    pragma Inline (Set_Intval);
+   pragma Inline (Set_Is_Abort_Block);
    pragma Inline (Set_Is_Accessibility_Actual);
    pragma Inline (Set_Is_Analyzed_Pragma);
    pragma Inline (Set_Is_Asynchronous_Call_Block);