2015-10-20 Ed Schonberg <schonberg@adacore.com>

	* sem_prag.adb: Code clean up.

2015-10-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Code cleanup.
	(Make_Build_In_Place_Call_In_Object_Declaration): Update the
	parameter profile.  Code cleanup. Request debug info for the
	object renaming declaration.
	(Move_Activation_Chain): Add new formal parameter and update the
	comment on usage.
	* exp_ch6.ads (Make_Build_In_Place_Call_In_Object_Declaration):
	Update the parameter profile and comment on usage.
	* sem_util.ads, sem_util.adb (Remove_Overloaded_Entity): New routine,
	currently unused.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@229067 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 272 insertions, 157 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ee17ba0c63..e32bac43c41 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,22 @@
 2015-10-20  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_prag.adb: Code clean up.
+
+2015-10-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Code cleanup.
+	(Make_Build_In_Place_Call_In_Object_Declaration): Update the
+	parameter profile.  Code cleanup. Request debug info for the
+	object renaming declaration.
+	(Move_Activation_Chain): Add new formal parameter and update the
+	comment on usage.
+	* exp_ch6.ads (Make_Build_In_Place_Call_In_Object_Declaration):
+	Update the parameter profile and comment on usage.
+	* sem_util.ads, sem_util.adb (Remove_Overloaded_Entity): New routine,
+	currently unused.
+
+2015-10-20  Ed Schonberg  <schonberg@adacore.com>
+
 	* sem_ch13.adb (Analyze_One_Aspect, case
 	Aspect_Disable_Controlled): If expander is not active, pre-analyze
 	expression anyway for ASIS and other tools use.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index be7f72917e7..792208a3806 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3942,22 +3942,6 @@ package body Exp_Ch6 is
    procedure Expand_N_Extended_Return_Statement (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
-      Par_Func     : constant Entity_Id :=
-                       Return_Applies_To (Return_Statement_Entity (N));
-      Result_Subt  : constant Entity_Id := Etype (Par_Func);
-      Ret_Obj_Id   : constant Entity_Id :=
-                       First_Entity (Return_Statement_Entity (N));
-      Ret_Obj_Decl : constant Node_Id := Parent (Ret_Obj_Id);
-
-      Is_Build_In_Place : constant Boolean :=
-                            Is_Build_In_Place_Function (Par_Func);
-
-      Exp         : Node_Id;
-      HSS         : Node_Id;
-      Result      : Node_Id;
-      Return_Stmt : Node_Id;
-      Stmts       : List_Id;
-
       function Build_Heap_Allocator
         (Temp_Id    : Entity_Id;
          Temp_Typ   : Entity_Id;
@@ -3991,12 +3975,15 @@ package body Exp_Ch6 is
       --  temporary. Func_Id is the enclosing function. Ret_Typ is the return
       --  type of Func_Id. Alloc_Expr is the actual allocator.
 
-      function Move_Activation_Chain return Node_Id;
+      function Move_Activation_Chain (Func_Id : Entity_Id) return Node_Id;
       --  Construct a call to System.Tasking.Stages.Move_Activation_Chain
       --  with parameters:
       --    From         current activation chain
       --    To           activation chain passed in by the caller
       --    New_Master   master passed in by the caller
+      --
+      --  Func_Id is the entity of the function where the extended return
+      --  statement appears.
 
       --------------------------
       -- Build_Heap_Allocator --
@@ -4158,7 +4145,7 @@ package body Exp_Ch6 is
       -- Move_Activation_Chain --
       ---------------------------
 
-      function Move_Activation_Chain return Node_Id is
+      function Move_Activation_Chain (Func_Id : Entity_Id) return Node_Id is
       begin
          return
            Make_Procedure_Call_Statement (Loc,
@@ -4176,14 +4163,31 @@ package body Exp_Ch6 is
                --  Destination chain
 
                New_Occurrence_Of
-                 (Build_In_Place_Formal (Par_Func, BIP_Activation_Chain), Loc),
+                 (Build_In_Place_Formal (Func_Id, BIP_Activation_Chain), Loc),
 
                --  New master
 
                New_Occurrence_Of
-                 (Build_In_Place_Formal (Par_Func, BIP_Task_Master), Loc)));
+                 (Build_In_Place_Formal (Func_Id, BIP_Task_Master), Loc)));
       end Move_Activation_Chain;
 
+      --  Local variables
+
+      Func_Id      : constant Entity_Id :=
+                       Return_Applies_To (Return_Statement_Entity (N));
+      Is_BIP_Func  : constant Boolean   :=
+                       Is_Build_In_Place_Function (Func_Id);
+      Ret_Obj_Id   : constant Entity_Id :=
+                       First_Entity (Return_Statement_Entity (N));
+      Ret_Obj_Decl : constant Node_Id   := Parent (Ret_Obj_Id);
+      Ret_Typ      : constant Entity_Id := Etype (Func_Id);
+
+      Exp         : Node_Id;
+      HSS         : Node_Id;
+      Result      : Node_Id;
+      Return_Stmt : Node_Id;
+      Stmts       : List_Id;
+
    --  Start of processing for Expand_N_Extended_Return_Statement
 
    begin
@@ -4207,9 +4211,7 @@ package body Exp_Ch6 is
       --  with the scope finalizer. There is one flag per each return object
       --  in case of multiple returns.
 
-      if Is_Build_In_Place
-        and then Needs_Finalization (Etype (Ret_Obj_Id))
-      then
+      if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
          declare
             Flag_Decl : Node_Id;
             Flag_Id   : Entity_Id;
@@ -4218,7 +4220,7 @@ package body Exp_Ch6 is
          begin
             --  Recover the function body
 
-            Func_Bod := Unit_Declaration_Node (Par_Func);
+            Func_Bod := Unit_Declaration_Node (Func_Id);
 
             if Nkind (Func_Bod) = N_Subprogram_Declaration then
                Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
@@ -4253,7 +4255,7 @@ package body Exp_Ch6 is
       --  built in place (though we plan to do so eventually).
 
       if Present (HSS)
-        or else Is_Composite_Type (Result_Subt)
+        or else Is_Composite_Type (Ret_Typ)
         or else No (Exp)
       then
          if No (HSS) then
@@ -4279,9 +4281,8 @@ package body Exp_Ch6 is
          --  result to be built in place, though that's necessarily true for
          --  the case of result types with task parts.
 
-         if Is_Build_In_Place
-           and then Has_Task (Result_Subt)
-         then
+         if Is_BIP_Func and then Has_Task (Ret_Typ) then
+
             --  The return expression is an aggregate for a complex type which
             --  contains tasks. This particular case is left unexpanded since
             --  the regular expansion would insert all temporaries and
@@ -4295,16 +4296,14 @@ package body Exp_Ch6 is
             --  contain tasks.
 
             if Has_Task (Etype (Ret_Obj_Id)) then
-               Append_To (Stmts, Move_Activation_Chain);
+               Append_To (Stmts, Move_Activation_Chain (Func_Id));
             end if;
          end if;
 
          --  Update the state of the function right before the object is
          --  returned.
 
-         if Is_Build_In_Place
-           and then Needs_Finalization (Etype (Ret_Obj_Id))
-         then
+         if Is_BIP_Func and then Needs_Finalization (Etype (Ret_Obj_Id)) then
             declare
                Flag_Id : constant Entity_Id :=
                            Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
@@ -4354,7 +4353,7 @@ package body Exp_Ch6 is
          --  build-in-place function, and that function is responsible for
          --  the allocation of the return object.
 
-         if Is_Build_In_Place
+         if Is_BIP_Func
            and then Nkind (Ret_Obj_Decl) = N_Object_Renaming_Declaration
          then
             pragma Assert
@@ -4366,7 +4365,7 @@ package body Exp_Ch6 is
 
             Set_By_Ref (Return_Stmt);
 
-         elsif Is_Build_In_Place then
+         elsif Is_BIP_Func then
 
             --  Locate the implicit access parameter associated with the
             --  caller-supplied return object and convert the return
@@ -4390,17 +4389,13 @@ package body Exp_Ch6 is
             --       ...
 
             declare
-               Return_Obj_Id    : constant Entity_Id :=
-                                    Defining_Identifier (Ret_Obj_Decl);
-               Return_Obj_Typ   : constant Entity_Id := Etype (Return_Obj_Id);
-               Return_Obj_Expr  : constant Node_Id :=
-                                    Expression (Ret_Obj_Decl);
-               Constr_Result    : constant Boolean :=
-                                    Is_Constrained (Result_Subt);
-               Obj_Alloc_Formal : Entity_Id;
-               Object_Access    : Entity_Id;
-               Obj_Acc_Deref    : Node_Id;
+               Ret_Obj_Expr : constant Node_Id   := Expression (Ret_Obj_Decl);
+               Ret_Obj_Typ  : constant Entity_Id := Etype (Ret_Obj_Id);
+
                Init_Assignment  : Node_Id := Empty;
+               Obj_Acc_Formal   : Entity_Id;
+               Obj_Acc_Deref    : Node_Id;
+               Obj_Alloc_Formal : Entity_Id;
 
             begin
                --  Build-in-place results must be returned by reference
@@ -4409,8 +4404,8 @@ package body Exp_Ch6 is
 
                --  Retrieve the implicit access parameter passed by the caller
 
-               Object_Access :=
-                 Build_In_Place_Formal (Par_Func, BIP_Object_Access);
+               Obj_Acc_Formal :=
+                 Build_In_Place_Formal (Func_Id, BIP_Object_Access);
 
                --  If the return object's declaration includes an expression
                --  and the declaration isn't marked as No_Initialization, then
@@ -4428,16 +4423,16 @@ package body Exp_Ch6 is
                --  is a nonlimited descendant of a limited interface (the
                --  interface has no assignment operation).
 
-               if Present (Return_Obj_Expr)
+               if Present (Ret_Obj_Expr)
                  and then not No_Initialization (Ret_Obj_Decl)
-                 and then not Is_Interface (Return_Obj_Typ)
+                 and then not Is_Interface (Ret_Obj_Typ)
                then
                   Init_Assignment :=
                     Make_Assignment_Statement (Loc,
-                      Name       => New_Occurrence_Of (Return_Obj_Id, Loc),
-                      Expression => Relocate_Node (Return_Obj_Expr));
+                      Name       => New_Occurrence_Of (Ret_Obj_Id, Loc),
+                      Expression => Relocate_Node (Ret_Obj_Expr));
 
-                  Set_Etype (Name (Init_Assignment), Etype (Return_Obj_Id));
+                  Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
                   Set_Assignment_OK (Name (Init_Assignment));
                   Set_No_Ctrl_Actions (Init_Assignment);
 
@@ -4446,14 +4441,14 @@ package body Exp_Ch6 is
 
                   Set_Expression (Ret_Obj_Decl, Empty);
 
-                  if Is_Class_Wide_Type (Etype (Return_Obj_Id))
+                  if Is_Class_Wide_Type (Etype (Ret_Obj_Id))
                     and then not Is_Class_Wide_Type
                                    (Etype (Expression (Init_Assignment)))
                   then
                      Rewrite (Expression (Init_Assignment),
                        Make_Type_Conversion (Loc,
                          Subtype_Mark =>
-                           New_Occurrence_Of (Etype (Return_Obj_Id), Loc),
+                           New_Occurrence_Of (Etype (Ret_Obj_Id), Loc),
                          Expression   =>
                            Relocate_Node (Expression (Init_Assignment))));
                   end if;
@@ -4464,8 +4459,8 @@ package body Exp_Ch6 is
                   --  the different forms of allocation (this is true for
                   --  unconstrained and tagged result subtypes).
 
-                  if Constr_Result
-                    and then not Is_Tagged_Type (Underlying_Type (Result_Subt))
+                  if Is_Constrained (Ret_Typ)
+                    and then not Is_Tagged_Type (Underlying_Type (Ret_Typ))
                   then
                      Insert_After (Ret_Obj_Decl, Init_Assignment);
                   end if;
@@ -4490,11 +4485,11 @@ package body Exp_Ch6 is
                --  called in dispatching contexts and must be handled similarly
                --  to functions with a class-wide result.
 
-               if not Constr_Result
-                 or else Is_Tagged_Type (Underlying_Type (Result_Subt))
+               if not Is_Constrained (Ret_Typ)
+                 or else Is_Tagged_Type (Underlying_Type (Ret_Typ))
                then
                   Obj_Alloc_Formal :=
-                    Build_In_Place_Formal (Par_Func, BIP_Alloc_Form);
+                    Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
 
                   declare
                      Pool_Id        : constant Entity_Id :=
@@ -4529,7 +4524,7 @@ package body Exp_Ch6 is
                            Make_Access_To_Object_Definition (Loc,
                              All_Present        => True,
                              Subtype_Indication =>
-                               New_Occurrence_Of (Return_Obj_Typ, Loc)));
+                               New_Occurrence_Of (Ret_Obj_Typ, Loc)));
 
                      Insert_Before (Ret_Obj_Decl, Ptr_Type_Decl);
 
@@ -4553,7 +4548,7 @@ package body Exp_Ch6 is
                      --  global heap. If there's an initialization expression,
                      --  then create these as initialized allocators.
 
-                     if Present (Return_Obj_Expr)
+                     if Present (Ret_Obj_Expr)
                        and then not No_Initialization (Ret_Obj_Decl)
                      then
                         --  Always use the type of the expression for the
@@ -4570,9 +4565,8 @@ package body Exp_Ch6 is
                               Make_Qualified_Expression (Loc,
                                 Subtype_Mark =>
                                   New_Occurrence_Of
-                                    (Etype (Return_Obj_Expr), Loc),
-                                Expression   =>
-                                  New_Copy_Tree (Return_Obj_Expr)));
+                                    (Etype (Ret_Obj_Expr), Loc),
+                                Expression   => New_Copy_Tree (Ret_Obj_Expr)));
 
                      else
                         --  If the function returns a class-wide type we cannot
@@ -4580,17 +4574,17 @@ package body Exp_Ch6 is
                         --  use the type of the expression, which must be an
                         --  aggregate of a definite type.
 
-                        if Is_Class_Wide_Type (Return_Obj_Typ) then
+                        if Is_Class_Wide_Type (Ret_Obj_Typ) then
                            Heap_Allocator :=
                              Make_Allocator (Loc,
                                Expression =>
                                  New_Occurrence_Of
-                                   (Etype (Return_Obj_Expr), Loc));
+                                   (Etype (Ret_Obj_Expr), Loc));
                         else
                            Heap_Allocator :=
                              Make_Allocator (Loc,
                                Expression =>
-                                 New_Occurrence_Of (Return_Obj_Typ, Loc));
+                                 New_Occurrence_Of (Ret_Obj_Typ, Loc));
                         end if;
 
                         --  If the object requires default initialization then
@@ -4622,7 +4616,7 @@ package body Exp_Ch6 is
                               Make_Explicit_Dereference (Loc,
                                 New_Occurrence_Of
                                   (Build_In_Place_Formal
-                                     (Par_Func, BIP_Storage_Pool), Loc)));
+                                     (Func_Id, BIP_Storage_Pool), Loc)));
                         Set_Storage_Pool (Pool_Allocator, Pool_Id);
                         Set_Procedure_To_Call
                           (Pool_Allocator, RTE (RE_Allocate_Any));
@@ -4675,10 +4669,10 @@ package body Exp_Ch6 is
                      --  statement, past the point where these flags are
                      --  normally set.
 
-                     Set_Sec_Stack_Needed_For_Return (Par_Func);
+                     Set_Sec_Stack_Needed_For_Return (Func_Id);
                      Set_Sec_Stack_Needed_For_Return
                        (Return_Statement_Entity (N));
-                     Set_Uses_Sec_Stack (Par_Func);
+                     Set_Uses_Sec_Stack (Func_Id);
                      Set_Uses_Sec_Stack (Return_Statement_Entity (N));
 
                      --  Create an if statement to test the BIP_Alloc_Form
@@ -4719,7 +4713,7 @@ package body Exp_Ch6 is
                                  Subtype_Mark =>
                                    New_Occurrence_Of (Ref_Type, Loc),
                                  Expression   =>
-                                   New_Occurrence_Of (Object_Access, Loc)))),
+                                   New_Occurrence_Of (Obj_Acc_Formal, Loc)))),
 
                          Elsif_Parts => New_List (
                            Make_Elsif_Part (Loc,
@@ -4752,8 +4746,8 @@ package body Exp_Ch6 is
                                Build_Heap_Allocator
                                  (Temp_Id    => Alloc_Obj_Id,
                                   Temp_Typ   => Ref_Type,
-                                  Func_Id    => Par_Func,
-                                  Ret_Typ    => Return_Obj_Typ,
+                                  Func_Id    => Func_Id,
+                                  Ret_Typ    => Ret_Obj_Typ,
                                   Alloc_Expr => Heap_Allocator)))),
 
                          Else_Statements => New_List (
@@ -4761,8 +4755,8 @@ package body Exp_Ch6 is
                            Build_Heap_Allocator
                              (Temp_Id    => Alloc_Obj_Id,
                               Temp_Typ   => Ref_Type,
-                              Func_Id    => Par_Func,
-                              Ret_Typ    => Return_Obj_Typ,
+                              Func_Id    => Func_Id,
+                              Ret_Typ    => Ret_Obj_Typ,
                               Alloc_Expr => Pool_Allocator)));
 
                      --  If a separate initialization assignment was created
@@ -4778,8 +4772,7 @@ package body Exp_Ch6 is
                           Make_Explicit_Dereference (Loc,
                             Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
 
-                        Set_Etype
-                          (Name (Init_Assignment), Etype (Return_Obj_Id));
+                        Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
 
                         Append_To
                           (Then_Statements (Alloc_If_Stmt), Init_Assignment);
@@ -4790,7 +4783,7 @@ package body Exp_Ch6 is
                      --  Remember the local access object for use in the
                      --  dereference of the renaming created below.
 
-                     Object_Access := Alloc_Obj_Id;
+                     Obj_Acc_Formal := Alloc_Obj_Id;
                   end;
                end if;
 
@@ -4800,17 +4793,16 @@ package body Exp_Ch6 is
 
                Obj_Acc_Deref :=
                  Make_Explicit_Dereference (Loc,
-                   Prefix => New_Occurrence_Of (Object_Access, Loc));
+                   Prefix => New_Occurrence_Of (Obj_Acc_Formal, Loc));
 
                Rewrite (Ret_Obj_Decl,
                  Make_Object_Renaming_Declaration (Loc,
-                   Defining_Identifier => Return_Obj_Id,
+                   Defining_Identifier => Ret_Obj_Id,
                    Access_Definition   => Empty,
-                   Subtype_Mark        =>
-                     New_Occurrence_Of (Return_Obj_Typ, Loc),
+                   Subtype_Mark        => New_Occurrence_Of (Ret_Obj_Typ, Loc),
                    Name                => Obj_Acc_Deref));
 
-               Set_Renamed_Object (Return_Obj_Id, Obj_Acc_Deref);
+               Set_Renamed_Object (Ret_Obj_Id, Obj_Acc_Deref);
             end;
          end if;
 
@@ -8789,14 +8781,14 @@ package body Exp_Ch6 is
    ----------------------------------------------------
 
    procedure Make_Build_In_Place_Call_In_Object_Declaration
-     (Object_Decl   : Node_Id;
+     (Obj_Decl      : Node_Id;
       Function_Call : Node_Id)
    is
-      Loc             : Source_Ptr;
-      Obj_Def_Id      : constant Entity_Id :=
-                          Defining_Identifier (Object_Decl);
-      Enclosing_Func  : constant Entity_Id :=
-                          Enclosing_Subprogram (Obj_Def_Id);
+      Obj_Def_Id : constant Entity_Id  := Defining_Identifier (Obj_Decl);
+      Encl_Func  : constant Entity_Id  := Enclosing_Subprogram (Obj_Def_Id);
+      Loc        : constant Source_Ptr := Sloc (Function_Call);
+      Obj_Loc    : constant Source_Ptr := Sloc (Obj_Decl);
+
       Call_Deref      : Node_Id;
       Caller_Object   : Node_Id;
       Def_Id          : Entity_Id;
@@ -8835,8 +8827,6 @@ package body Exp_Ch6 is
 
       Set_Is_Expanded_Build_In_Place_Call (Func_Call);
 
-      Loc := Sloc (Function_Call);
-
       if Is_Entity_Name (Name (Func_Call)) then
          Function_Id := Entity (Name (Func_Call));
 
@@ -8878,11 +8868,11 @@ package body Exp_Ch6 is
       --  cause freezing.
 
       if Definite
-        and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+        and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
       then
-         Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
+         Insert_After_And_Analyze (Obj_Decl, Ptr_Typ_Decl);
       else
-         Insert_Action (Object_Decl, Ptr_Typ_Decl);
+         Insert_Action (Obj_Decl, Ptr_Typ_Decl);
       end if;
 
       --  Force immediate freezing of Ptr_Typ because Res_Decl will be
@@ -8907,18 +8897,18 @@ package body Exp_Ch6 is
       --  aggregate return object, when the call result should really be
       --  directly built in place in the aggregate and not in a temporary. ???)
 
-      if Is_Return_Object (Defining_Identifier (Object_Decl)) then
+      if Is_Return_Object (Defining_Identifier (Obj_Decl)) then
          Pass_Caller_Acc := True;
 
          --  When the enclosing function has a BIP_Alloc_Form formal then we
          --  pass it along to the callee (such as when the enclosing function
          --  has an unconstrained or tagged result type).
 
-         if Needs_BIP_Alloc_Form (Enclosing_Func) then
+         if Needs_BIP_Alloc_Form (Encl_Func) then
             if RTE_Available (RE_Root_Storage_Pool_Ptr) then
                Pool_Actual :=
-                 New_Occurrence_Of (Build_In_Place_Formal
-                   (Enclosing_Func, BIP_Storage_Pool), Loc);
+                 New_Occurrence_Of
+                   (Build_In_Place_Formal (Encl_Func, BIP_Storage_Pool), Loc);
 
             --  The build-in-place pool formal is not built on e.g. ZFP
 
@@ -8931,8 +8921,7 @@ package body Exp_Ch6 is
                Function_Id    => Function_Id,
                Alloc_Form_Exp =>
                  New_Occurrence_Of
-                   (Build_In_Place_Formal
-                     (Enclosing_Func, BIP_Alloc_Form), Loc),
+                   (Build_In_Place_Formal (Encl_Func, BIP_Alloc_Form), Loc),
                Pool_Actual    => Pool_Actual);
 
          --  Otherwise, if enclosing function has a definite result subtype,
@@ -8943,27 +8932,27 @@ package body Exp_Ch6 is
               (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
          end if;
 
-         if Needs_BIP_Finalization_Master (Enclosing_Func) then
+         if Needs_BIP_Finalization_Master (Encl_Func) then
             Fmaster_Actual :=
               New_Occurrence_Of
                 (Build_In_Place_Formal
-                   (Enclosing_Func, BIP_Finalization_Master), Loc);
+                   (Encl_Func, BIP_Finalization_Master), Loc);
          end if;
 
          --  Retrieve the BIPacc formal from the enclosing function and convert
          --  it to the access type of the callee's BIP_Object_Access formal.
 
          Caller_Object :=
-            Make_Unchecked_Type_Conversion (Loc,
-              Subtype_Mark =>
-                New_Occurrence_Of
-                  (Etype
-                     (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
-                   Loc),
-              Expression   =>
-                New_Occurrence_Of
-                  (Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
-                   Loc));
+           Make_Unchecked_Type_Conversion (Loc,
+             Subtype_Mark =>
+               New_Occurrence_Of
+                 (Etype
+                    (Build_In_Place_Formal (Function_Id, BIP_Object_Access)),
+                  Loc),
+             Expression   =>
+               New_Occurrence_Of
+                 (Build_In_Place_Formal (Encl_Func, BIP_Object_Access),
+                  Loc));
 
       --  In the definite case, add an implicit actual to the function call
       --  that provides access to the declared object. An unchecked conversion
@@ -8990,7 +8979,7 @@ package body Exp_Ch6 is
       --  the secondary stack is destroyed after each library unload. This is
       --  a hybrid mechanism where a stack-allocated object lives on the heap.
 
-      elsif Is_Library_Level_Entity (Defining_Identifier (Object_Decl))
+      elsif Is_Library_Level_Entity (Defining_Identifier (Obj_Decl))
         and then not Restriction_Active (No_Implicit_Heap_Allocations)
       then
          Add_Unconstrained_Actuals_To_Build_In_Place_Call
@@ -9024,7 +9013,7 @@ package body Exp_Ch6 is
            (Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
          Caller_Object := Empty;
 
-         Establish_Transient_Scope (Object_Decl, Sec_Stack => True);
+         Establish_Transient_Scope (Obj_Decl, Sec_Stack => True);
       end if;
 
       --  Pass along any finalization master actual, which is needed in the
@@ -9036,7 +9025,7 @@ package body Exp_Ch6 is
          Func_Id    => Function_Id,
          Master_Exp => Fmaster_Actual);
 
-      if Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement
+      if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
         and then Has_Task (Result_Subt)
       then
          --  Here we're passing along the master that was passed in to this
@@ -9045,8 +9034,8 @@ package body Exp_Ch6 is
          Add_Task_Actuals_To_Build_In_Place_Call
            (Func_Call, Function_Id,
             Master_Actual =>
-              New_Occurrence_Of (Build_In_Place_Formal
-                (Enclosing_Func, BIP_Task_Master), Loc));
+              New_Occurrence_Of
+                (Build_In_Place_Formal (Encl_Func, BIP_Task_Master), Loc));
 
       else
          Add_Task_Actuals_To_Build_In_Place_Call
@@ -9079,7 +9068,7 @@ package body Exp_Ch6 is
       --  the object as having no initialization.
 
       if Definite
-        and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+        and then not Is_Return_Object (Defining_Identifier (Obj_Decl))
       then
          --  The related object declaration is encased in a transient block
          --  because the build-in-place function call contains at least one
@@ -9093,14 +9082,12 @@ package body Exp_Ch6 is
          --  which prompted the generation of the transient block. To resolve
          --  this scenario, store the build-in-place call.
 
-         if Scope_Is_Transient
-           and then Node_To_Be_Wrapped = Object_Decl
-         then
+         if Scope_Is_Transient and then Node_To_Be_Wrapped = Obj_Decl then
             Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl);
          end if;
 
-         Set_Expression (Object_Decl, Empty);
-         Set_No_Initialization (Object_Decl);
+         Set_Expression (Obj_Decl, Empty);
+         Set_No_Initialization (Obj_Decl);
 
       --  In case of an indefinite result subtype, or if the call is the
       --  return expression of an enclosing BIP function, rewrite the object
@@ -9111,20 +9098,28 @@ package body Exp_Ch6 is
 
       else
          Call_Deref :=
-           Make_Explicit_Dereference (Loc,
-             Prefix => New_Occurrence_Of (Def_Id, Loc));
-
-         Loc := Sloc (Object_Decl);
-         Rewrite (Object_Decl,
-           Make_Object_Renaming_Declaration (Loc,
-             Defining_Identifier => Make_Temporary (Loc, 'D'),
-             Access_Definition   => Empty,
-             Subtype_Mark        => New_Occurrence_Of (Result_Subt, Loc),
+           Make_Explicit_Dereference (Obj_Loc,
+             Prefix => New_Occurrence_Of (Def_Id, Obj_Loc));
+
+         Rewrite (Obj_Decl,
+           Make_Object_Renaming_Declaration (Obj_Loc,
+             Defining_Identifier => Make_Temporary (Obj_Loc, 'D'),
+             Subtype_Mark        => New_Occurrence_Of (Result_Subt, Obj_Loc),
              Name                => Call_Deref));
 
-         Set_Renamed_Object (Defining_Identifier (Object_Decl), Call_Deref);
+         Set_Renamed_Object (Defining_Identifier (Obj_Decl), Call_Deref);
+
+         --  If the original entity comes from source, then mark the new
+         --  entity as needing debug information, even though it's defined
+         --  by a generated renaming that does not come from source, so that
+         --  the Materialize_Entity flag will be set on the entity when
+         --  Debug_Renaming_Declaration is called during analysis.
+
+         if Comes_From_Source (Obj_Def_Id) then
+            Set_Debug_Info_Needed (Defining_Identifier (Obj_Decl));
+         end if;
 
-         Analyze (Object_Decl);
+         Analyze (Obj_Decl);
 
          --  Replace the internal identifier of the renaming declaration's
          --  entity with identifier of the original object entity. We also have
@@ -9138,31 +9133,27 @@ package body Exp_Ch6 is
          --  corrupted. Finally, the homonym chain must be preserved as well.
 
          declare
-            Renaming_Def_Id  : constant Entity_Id :=
-                                 Defining_Identifier (Object_Decl);
-            Next_Entity_Temp : constant Entity_Id :=
-                                 Next_Entity (Renaming_Def_Id);
+            Ren_Id  : constant Entity_Id := Defining_Entity (Obj_Decl);
+            Next_Id : constant Entity_Id := Next_Entity (Ren_Id);
+
          begin
-            Set_Chars (Renaming_Def_Id, Chars (Obj_Def_Id));
+            Set_Chars (Ren_Id, Chars (Obj_Def_Id));
 
             --  Swap next entity links in preparation for exchanging entities
 
-            Set_Next_Entity (Renaming_Def_Id, Next_Entity (Obj_Def_Id));
-            Set_Next_Entity (Obj_Def_Id, Next_Entity_Temp);
-            Set_Homonym     (Renaming_Def_Id, Homonym (Obj_Def_Id));
+            Set_Next_Entity (Ren_Id, Next_Entity (Obj_Def_Id));
+            Set_Next_Entity (Obj_Def_Id, Next_Id);
+            Set_Homonym     (Ren_Id, Homonym (Obj_Def_Id));
 
-            Exchange_Entities (Renaming_Def_Id, Obj_Def_Id);
+            Exchange_Entities (Ren_Id, Obj_Def_Id);
 
             --  Preserve source indication of original declaration, so that
             --  xref information is properly generated for the right entity.
 
-            Preserve_Comes_From_Source
-              (Object_Decl, Original_Node (Object_Decl));
-
-            Preserve_Comes_From_Source
-              (Obj_Def_Id, Original_Node (Object_Decl));
+            Preserve_Comes_From_Source (Obj_Decl, Original_Node (Obj_Decl));
+            Preserve_Comes_From_Source (Obj_Def_Id, Original_Node (Obj_Decl));
 
-            Set_Comes_From_Source (Renaming_Def_Id, False);
+            Set_Comes_From_Source (Ren_Id, False);
          end;
       end if;
 
@@ -9174,8 +9165,8 @@ package body Exp_Ch6 is
       --  improve this treatment when build-in-place functions with class-wide
       --  results are implemented. ???
 
-      if Is_Class_Wide_Type (Etype (Defining_Identifier (Object_Decl))) then
-         Set_Etype (Defining_Identifier (Object_Decl), Result_Subt);
+      if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then
+         Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt);
       end if;
    end Make_Build_In_Place_Call_In_Object_Declaration;
 
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 5cbcc965cf4..1cc993f509e 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -178,7 +178,7 @@ package Exp_Ch6 is
    --  call.
 
    procedure Make_Build_In_Place_Call_In_Object_Declaration
-     (Object_Decl   : Node_Id;
+     (Obj_Decl      : Node_Id;
       Function_Call : Node_Id);
    --  Ada 2005 (AI-318-02): Handle a call to a build-in-place function that
    --  occurs as the expression initializing an object declaration by
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 149c7798bcf..fa00f620506 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -25211,6 +25211,7 @@ package body Sem_Prag is
             Root_Typ := Etype (F);
 
             if Is_Access_Type (Etype (F)) then
+               Root_Typ := Designated_Type (Root_Typ);
                New_Typ :=
                  Make_Defining_Identifier (Loc,
                    Chars =>
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e0c857b1177..a6eb50c52b7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16961,6 +16961,106 @@ package body Sem_Util is
       end if;
    end Remove_Homonym;
 
+   ------------------------------
+   -- Remove_Overloaded_Entity --
+   ------------------------------
+
+   procedure Remove_Overloaded_Entity (Id : Entity_Id) is
+      procedure Remove_Primitive_Of (Typ : Entity_Id);
+      --  Remove primitive subprogram Id from the list of primitives that
+      --  belong to type Typ.
+
+      -------------------------
+      -- Remove_Primitive_Of --
+      -------------------------
+
+      procedure Remove_Primitive_Of (Typ : Entity_Id) is
+         Prims : Elist_Id;
+
+      begin
+         if Is_Tagged_Type (Typ) then
+            Prims := Direct_Primitive_Operations (Typ);
+
+            if Present (Prims) then
+               Remove (Prims, Id);
+            end if;
+         end if;
+      end Remove_Primitive_Of;
+
+      --  Local variables
+
+      Scop    : constant Entity_Id := Scope (Id);
+      Formal  : Entity_Id;
+      Prev_Id : Entity_Id;
+
+   --  Start of processing for Remove_Overloaded_Entity
+
+   begin
+      --  Remove the entity from the homonym chain. When the entity is the
+      --  head of the chain, associate the entry in the name table with its
+      --  homonym effectively making it the new head of the chain.
+
+      if Current_Entity (Id) = Id then
+         Set_Name_Entity_Id (Chars (Id), Homonym (Id));
+
+      --  Otherwise link the previous and next homonyms
+
+      else
+         Prev_Id := Current_Entity (Id);
+         while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop
+            Prev_Id := Homonym (Prev_Id);
+         end loop;
+
+         Set_Homonym (Prev_Id, Homonym (Id));
+      end if;
+
+      --  Remove the entity from the scope entity chain. When the entity is
+      --  the head of the chain, set the next entity as the new head of the
+      --  chain.
+
+      if First_Entity (Scop) = Id then
+         Prev_Id := Empty;
+         Set_First_Entity (Scop, Next_Entity (Id));
+
+      --  Otherwise the entity is either in the middle of the chain or it acts
+      --  as its tail. Traverse and link the previous and next entities.
+
+      else
+         Prev_Id := First_Entity (Scop);
+         while Present (Prev_Id) and then Next_Entity (Prev_Id) /= Id loop
+            Next_Entity (Prev_Id);
+         end loop;
+
+         Set_Next_Entity (Prev_Id, Next_Entity (Id));
+      end if;
+
+      --  Handle the case where the entity acts as the tail of the scope entity
+      --  chain.
+
+      if Last_Entity (Scop) = Id then
+         Set_Last_Entity (Scop, Prev_Id);
+      end if;
+
+      --  The entity denotes a primitive subprogram. Remove it from the list of
+      --  primitives of the associated controlling type.
+
+      if Ekind_In (Id, E_Function, E_Procedure) and then Is_Primitive (Id) then
+         Formal := First_Formal (Id);
+         while Present (Formal) loop
+            if Is_Controlling_Formal (Formal) then
+               Remove_Primitive_Of (Etype (Formal));
+               exit;
+            end if;
+
+            Next_Formal (Formal);
+         end loop;
+
+         if Ekind (Id) = E_Function and then Has_Controlling_Result (Id) then
+            Remove_Primitive_Of (Etype (Id));
+         end if;
+      end if;
+   end Remove_Overloaded_Entity;
+
    ---------------------
    -- Rep_To_Pos_Flag --
    ---------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 872bdedf388..c0bf234ce70 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1781,12 +1781,6 @@ package Sem_Util is
    --  convenience, qualified expressions applied to object names are also
    --  allowed as actuals for this function.
 
-   function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id;
-   --  [Ada 2012: AI05-0125-1]: If S is an inherited dispatching primitive S2,
-   --  or overrides an inherited dispatching primitive S2, the original
-   --  corresponding operation of S is the original corresponding operation of
-   --  S2. Otherwise, it is S itself.
-
    function Original_Aspect_Pragma_Name (N : Node_Id) return Name_Id;
    --  Retrieve the name of aspect or pragma N taking into account a possible
    --  rewrite and whether the pragma is generated from an aspect as the names
@@ -1799,6 +1793,12 @@ package Sem_Util is
    --    Type_Invariant       -> Name_uType_Invariant
    --    Type_Invariant'Class -> Name_uType_Invariant
 
+   function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id;
+   --  [Ada 2012: AI05-0125-1]: If S is an inherited dispatching primitive S2,
+   --  or overrides an inherited dispatching primitive S2, the original
+   --  corresponding operation of S is the original corresponding operation of
+   --  S2. Otherwise, it is S itself.
+
    function Policy_In_Effect (Policy : Name_Id) return Name_Id;
    --  Given a policy, return the policy identifier associated with it. If no
    --  such policy is in effect, the value returned is No_Name.
@@ -1845,6 +1845,12 @@ package Sem_Util is
    procedure Remove_Homonym (E : Entity_Id);
    --  Removes E from the homonym chain
 
+   procedure Remove_Overloaded_Entity (Id : Entity_Id);
+   --  Remove arbitrary entity Id from the homonym chain, the scope chain and
+   --  the primitive operations list of the associated controlling type. NOTE:
+   --  the removal performed by this routine does not affect the visibility of
+   --  existing homonyms.
+
    function Rep_To_Pos_Flag (E : Entity_Id; Loc : Source_Ptr) return Node_Id;
    --  This is used to construct the second argument in a call to Rep_To_Pos
    --  which is Standard_True if range checks are enabled (E is an entity to