[multiple changes]

2016-05-02  Tristan Gingold  <gingold@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): Use Has_Protected
	to check for the no local protected objects restriction.

2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Anonymous_Master now uses Node35.
	(Anonymous_Master): Update the assertion and node reference.
	(Set_Anonymous_Master): Update the assertion and node reference.
	(Write_Field35_Name): Add output for Anonymous_Master.
	(Write_Field36_Name): The output is now undefined.
	* einfo.ads Update the node and description of attribute
	Anonymous_Master. Remove prior occurrences in entities as this
	is now a type attribute.
	* exp_ch3.adb (Expand_Freeze_Array_Type): Remove local variable
	Ins_Node. Anonymous access- to-controlled component types no
	longer need finalization masters. The master is now built when
	a related allocator is expanded.
	(Expand_Freeze_Record_Type): Remove local variable Has_AACC. Do not
	detect whether the record type has at least one component of anonymous
	access-to- controlled type. These types no longer need finalization
	masters. The master is now built when a related allocator is expanded.
	* exp_ch4.adb Remove with and use clauses for Lib and Sem_Ch8.
	(Current_Anonymous_Master): Removed.
	(Expand_N_Allocator): Call Build_Anonymous_Master to create a
	finalization master for an anonymous access-to-controlled type.
	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
	Call routine Build_Anonymous_Master to create a finalization master
	for an anonymous access-to-controlled type.
	* exp_ch7.adb (Allows_Finalization_Master): New routine.
	(Build_Anonymous_Master): New routine.
	(Build_Finalization_Master): Remove formal parameter
	For_Anonymous. Use Allows_Finalization_Master to determine whether
	circumstances warrant a finalization master. This routine no
	longer creates masters for anonymous access-to-controlled types.
	(In_Deallocation_Instance): Removed.
	* exp_ch7.ads (Build_Anonymous_Master): New routine.
	(Build_Finalization_Master): Remove formal parameter For_Anonymous
	and update the comment on usage.
	* sem_util.adb (Get_Qualified_Name): New routines.
	(Output_Name): Reimplemented.
	(Output_Scope): Removed.
	* sem_util.ads (Get_Qualified_Name): New routines.

2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* debug.adb: Document the use of switch -gnatd.H.
	* gnat1drv.adb (Adjust_Global_Switches): Set ASIS_GNSA mode when
	-gnatd.H is present.
	(Gnat1drv): Suppress the call to gigi when ASIS_GNSA mode is active.
	* opt.ads: Add new option ASIS_GNSA_Mode.
	* sem_ch13.adb (Alignment_Error): New routine.
	(Analyze_Attribute_Definition_Clause): Suppress certain errors in
	ASIS mode for attribute clause Alignment, Machine_Radix, Size, and
	Stream_Size.
	(Check_Size): Use routine Size_Too_Small_Error to
	suppress certain errors in ASIS mode.
	(Get_Alignment_Value): Use routine Alignment_Error to suppress certain
	errors in ASIS mode.
	(Size_Too_Small_Error): New routine.

From-SVN: r235732

15 files changed, 697 insertions, 615 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index eaab1b7..7627ad3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,65 @@
+2016-05-02  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_ch3.adb (Analyze_Object_Declaration): Use Has_Protected
+	to check for the no local protected objects restriction.
+
+2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb Anonymous_Master now uses Node35.
+	(Anonymous_Master): Update the assertion and node reference.
+	(Set_Anonymous_Master): Update the assertion and node reference.
+	(Write_Field35_Name): Add output for Anonymous_Master.
+	(Write_Field36_Name): The output is now undefined.
+	* einfo.ads Update the node and description of attribute
+	Anonymous_Master. Remove prior occurrences in entities as this
+	is now a type attribute.
+	* exp_ch3.adb (Expand_Freeze_Array_Type): Remove local variable
+	Ins_Node. Anonymous access- to-controlled component types no
+	longer need finalization masters. The master is now built when
+	a related allocator is expanded.
+	(Expand_Freeze_Record_Type): Remove local variable Has_AACC. Do not
+	detect whether the record type has at least one component of anonymous
+	access-to- controlled type. These types no longer need finalization
+	masters. The master is now built when a related allocator is expanded.
+	* exp_ch4.adb Remove with and use clauses for Lib and Sem_Ch8.
+	(Current_Anonymous_Master): Removed.
+	(Expand_N_Allocator): Call Build_Anonymous_Master to create a
+	finalization master for an anonymous access-to-controlled type.
+	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
+	Call routine Build_Anonymous_Master to create a finalization master
+	for an anonymous access-to-controlled type.
+	* exp_ch7.adb (Allows_Finalization_Master): New routine.
+	(Build_Anonymous_Master): New routine.
+	(Build_Finalization_Master): Remove formal parameter
+	For_Anonymous. Use Allows_Finalization_Master to determine whether
+	circumstances warrant a finalization master. This routine no
+	longer creates masters for anonymous access-to-controlled types.
+	(In_Deallocation_Instance): Removed.
+	* exp_ch7.ads (Build_Anonymous_Master): New routine.
+	(Build_Finalization_Master): Remove formal parameter For_Anonymous
+	and update the comment on usage.
+	* sem_util.adb (Get_Qualified_Name): New routines.
+	(Output_Name): Reimplemented.
+	(Output_Scope): Removed.
+	* sem_util.ads (Get_Qualified_Name): New routines.
+
+2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* debug.adb: Document the use of switch -gnatd.H.
+	* gnat1drv.adb (Adjust_Global_Switches): Set ASIS_GNSA mode when
+	-gnatd.H is present.
+	(Gnat1drv): Suppress the call to gigi when ASIS_GNSA mode is active.
+	* opt.ads: Add new option ASIS_GNSA_Mode.
+	* sem_ch13.adb (Alignment_Error): New routine.
+	(Analyze_Attribute_Definition_Clause): Suppress certain errors in
+	ASIS mode for attribute clause Alignment, Machine_Radix, Size, and
+	Stream_Size.
+	(Check_Size): Use routine Size_Too_Small_Error to
+	suppress certain errors in ASIS mode.
+	(Get_Alignment_Value): Use routine Alignment_Error to suppress certain
+	errors in ASIS mode.
+	(Size_Too_Small_Error): New routine.
+
 2016-05-02  Arnaud Charlet  <charlet@adacore.com>
 
 	* spark_xrefs.ads Description of the spark cross-references
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 543c399..f396913 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -125,7 +125,7 @@ package body Debug is
    --  d.E  Turn selected errors into warnings
    --  d.F  Debug mode for GNATprove
    --  d.G  Ignore calls through generic formal parameters for elaboration
-   --  d.H
+   --  d.H  GNSA mode for ASIS
    --  d.I  Do not ignore enum representation clauses in CodePeer mode
    --  d.J  Disable parallel SCIL generation mode
    --  d.K
@@ -630,6 +630,9 @@ package body Debug is
    --       now fixed, but we provide this debug flag to revert to the previous
    --       situation of ignoring such calls to aid in transition.
 
+   --  d.H  Sets ASIS_GNSA_Mode to True. This signals the front end to suppress
+   --       the call to gigi in ASIS_Mode.
+
    --  d.I  Do not ignore enum representation clauses in CodePeer mode.
    --       The default of ignoring representation clauses for enumeration
    --       types in CodePeer is good for the majority of Ada code, but in some
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 6df9788..378b757 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -265,10 +265,9 @@ package body Einfo is
 
    --    Contract                        Node34
 
+   --    Anonymous_Master                Node35
    --    Import_Pragma                   Node35
 
-   --    Anonymous_Master                Node36
-
    --    Class_Wide_Preconds             List38
 
    --    Class_Wide_Postconds            List39
@@ -757,12 +756,8 @@ package body Einfo is
 
    function Anonymous_Master (Id : E) return E is
    begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Package,
-                                   E_Package_Body,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      return Node36 (Id);
+      pragma Assert (Is_Type (Id));
+      return Node35 (Id);
    end Anonymous_Master;
 
    function Anonymous_Object (Id : E) return E is
@@ -3682,12 +3677,8 @@ package body Einfo is
 
    procedure Set_Anonymous_Master (Id : E; V : E) is
    begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Package,
-                                   E_Package_Body,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      Set_Node36 (Id, V);
+      pragma Assert (Is_Type (Id));
+      Set_Node35 (Id, V);
    end Set_Anonymous_Master;
 
    procedure Set_Anonymous_Object (Id : E; V : E) is
@@ -10385,6 +10376,9 @@ package body Einfo is
    procedure Write_Field35_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when Type_Kind                                    =>
+            Write_Str ("Anonymous_Master");
+
          when Subprogram_Kind                              =>
             Write_Str ("Import_Pragma");
 
@@ -10398,19 +10392,9 @@ package body Einfo is
    ------------------------
 
    procedure Write_Field36_Name (Id : Entity_Id) is
+      pragma Unreferenced (Id);
    begin
-      case Ekind (Id) is
-         when E_Function                                   |
-              E_Operator                                   |
-              E_Package                                    |
-              E_Package_Body                               |
-              E_Procedure                                  |
-              E_Subprogram_Body                            =>
-            Write_Str ("Anonymous_Master");
-
-         when others                                       =>
-            Write_Str ("Field36??");
-      end case;
+      Write_Str ("Field36??");
    end Write_Field36_Name;
 
    ------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 98d5a53..9e28959 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -438,11 +438,11 @@ package Einfo is
 --       definition clause with an (obsolescent) mod clause is converted
 --       into an attribute definition clause for this purpose.
 
---    Anonymous_Master (Node36)
---       Defined in the entities of non-generic packages, subprograms and their
---       corresponding bodies. Contains the entity of a special heterogeneous
---       finalization master that services most anonymous access-to-controlled
---       allocations that occur within the unit.
+--    Anonymous_Master (Node35)
+--       Defined in all types. Contains the entity of an anonymous finalization
+--       master which services all anonymous access types associated with the
+--       same designated type within the current semantic unit. The attribute
+--       is set reactively during the expansion of allocators.
 
 --    Anonymous_Object (Node30)
 --       Present in protected and task type entities. Contains the entity of
@@ -5468,6 +5468,7 @@ package Einfo is
    --    Derived_Type_Link                   (Node31)
    --    No_Tagged_Streams_Pragma            (Node32)
    --    Linker_Section_Pragma               (Node33)
+   --    Anonymous_Master                    (Node35)
 
    --    Depends_On_Private                  (Flag14)
    --    Disable_Controlled                  (Flag253)
@@ -5668,8 +5669,8 @@ package Einfo is
    --    Cloned_Subtype                      (Node16)   (subtype case only)
    --    First_Entity                        (Node17)
    --    Equivalent_Type                     (Node18)   (always Empty for type)
-   --    Last_Entity                         (Node20)
    --    Non_Limited_View                    (Node19)
+   --    Last_Entity                         (Node20)
    --    SSO_Set_High_By_Default             (Flag273)  (base type only)
    --    SSO_Set_Low_By_Default              (Flag272)  (base type only)
    --    First_Component                     (synth)
@@ -5919,7 +5920,6 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
@@ -6141,7 +6141,6 @@ package Einfo is
    --    Current_Use_Clause                  (Node27)
    --    Finalizer                           (Node28)   (non-generic case only)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Delay_Subprogram_Descriptors        (Flag50)
@@ -6179,7 +6178,6 @@ package Einfo is
    --    Scope_Depth_Value                   (Uint22)
    --    Finalizer                           (Node28)   (non-generic case only)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Contains_Ignored_Ghost_Code         (Flag279)
@@ -6233,7 +6231,6 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Anonymous_Master                    (Node36)   (non-generic case only)
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
@@ -6419,7 +6416,6 @@ package Einfo is
    --    Scope_Depth_Value                   (Uint22)
    --    Extra_Formals                       (Node28)
    --    Contract                            (Node34)
-   --    Anonymous_Master                    (Node36)
    --    SPARK_Pragma                        (Node40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    SPARK_Pragma_Inherited              (Flag265)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7df8b5f..74d3902 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4600,8 +4600,6 @@ package body Exp_Ch3 is
 
       Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
 
-      Ins_Node : Node_Id;
-
    begin
       --  Ensure that all freezing activities are properly flagged as Ghost
 
@@ -4654,39 +4652,13 @@ package body Exp_Ch3 is
             end if;
          end if;
 
-         if Typ = Base then
-            if Has_Controlled_Component (Base) then
-               Build_Controlling_Procs (Base);
-
-               if not Is_Limited_Type (Comp_Typ)
-                 and then Number_Dimensions (Typ) = 1
-               then
-                  Build_Slice_Assignment (Typ);
-               end if;
-            end if;
-
-            --  Create a finalization master to service the anonymous access
-            --  components of the array.
+         if Typ = Base and then Has_Controlled_Component (Base) then
+            Build_Controlling_Procs (Base);
 
-            if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-              and then Needs_Finalization (Designated_Type (Comp_Typ))
+            if not Is_Limited_Type (Comp_Typ)
+              and then Number_Dimensions (Typ) = 1
             then
-               --  The finalization master is inserted before the declaration
-               --  of the array type. The only exception to this is when the
-               --  array type is an itype, in which case the master appears
-               --  before the related context.
-
-               if Is_Itype (Typ) then
-                  Ins_Node := Associated_Node_For_Itype (Typ);
-               else
-                  Ins_Node := Parent (Typ);
-               end if;
-
-               Build_Finalization_Master
-                 (Typ            => Comp_Typ,
-                  For_Anonymous  => True,
-                  Context_Scope  => Scope (Typ),
-                  Insertion_Node => Ins_Node);
+               Build_Slice_Assignment (Typ);
             end if;
          end if;
 
@@ -5044,13 +5016,12 @@ package body Exp_Ch3 is
          Append_To (Lst,
            Make_Case_Statement_Alternative (Loc,
              Discrete_Choices => New_List (Make_Others_Choice (Loc)),
-             Statements => New_List (
+             Statements       => New_List (
                Make_Raise_Constraint_Error (Loc,
                  Condition => Make_Identifier (Loc, Name_uF),
                  Reason    => CE_Invalid_Data),
                Make_Simple_Return_Statement (Loc,
-                 Expression =>
-                   Make_Integer_Literal (Loc, -1)))));
+                 Expression => Make_Integer_Literal (Loc, -1)))));
 
       --  If either of the restrictions No_Exceptions_Handlers/Propagation is
       --  active then return -1 (we cannot usefully raise Constraint_Error in
@@ -5060,10 +5031,9 @@ package body Exp_Ch3 is
          Append_To (Lst,
            Make_Case_Statement_Alternative (Loc,
              Discrete_Choices => New_List (Make_Others_Choice (Loc)),
-             Statements => New_List (
+             Statements       => New_List (
                Make_Simple_Return_Statement (Loc,
-                 Expression =>
-                   Make_Integer_Literal (Loc, -1)))));
+                 Expression => Make_Integer_Literal (Loc, -1)))));
       end if;
 
       --  Now we can build the function body
@@ -5137,9 +5107,11 @@ package body Exp_Ch3 is
 
       Comp        : Entity_Id;
       Comp_Typ    : Entity_Id;
-      Has_AACC    : Boolean;
       Predef_List : List_Id;
 
+      Wrapper_Decl_List : List_Id := No_List;
+      Wrapper_Body_List : List_Id := No_List;
+
       Renamed_Eq : Node_Id := Empty;
       --  Defining unit name for the predefined equality function in the case
       --  where the type has a primitive operation that is a renaming of
@@ -5147,9 +5119,6 @@ package body Exp_Ch3 is
       --  user-defined equality function). Used to pass this entity from
       --  Make_Predefined_Primitive_Specs to Predefined_Primitive_Bodies.
 
-      Wrapper_Decl_List : List_Id := No_List;
-      Wrapper_Body_List : List_Id := No_List;
-
    --  Start of processing for Expand_Freeze_Record_Type
 
    begin
@@ -5212,8 +5181,6 @@ package body Exp_Ch3 is
       --  of the component types may have been private at the point of the
       --  record declaration. Detect anonymous access-to-controlled components.
 
-      Has_AACC := False;
-
       Comp := First_Component (Typ);
       while Present (Comp) loop
          Comp_Typ := Etype (Comp);
@@ -5238,15 +5205,6 @@ package body Exp_Ch3 is
             Set_Has_Controlled_Component (Typ);
          end if;
 
-         --  Non-self-referential anonymous access-to-controlled component
-
-         if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-           and then Needs_Finalization (Designated_Type (Comp_Typ))
-           and then Designated_Type (Comp_Typ) /= Typ
-         then
-            Has_AACC := True;
-         end if;
-
          Next_Component (Comp);
       end loop;
 
@@ -5595,97 +5553,6 @@ package body Exp_Ch3 is
          end;
       end if;
 
-      --  Create a heterogeneous finalization master to service the anonymous
-      --  access-to-controlled components of the record type.
-
-      if Has_AACC then
-         declare
-            Encl_Scope : constant Entity_Id  := Scope (Typ);
-            Ins_Node   : constant Node_Id    := Parent (Typ);
-            Loc        : constant Source_Ptr := Sloc (Typ);
-            Fin_Mas_Id : Entity_Id;
-
-            Attributes_Set : Boolean := False;
-            Master_Built   : Boolean := False;
-            --  Two flags which control the creation and initialization of a
-            --  common heterogeneous master.
-
-         begin
-            Comp := First_Component (Typ);
-            while Present (Comp) loop
-               Comp_Typ := Etype (Comp);
-
-               --  A non-self-referential anonymous access-to-controlled
-               --  component.
-
-               if Ekind (Comp_Typ) = E_Anonymous_Access_Type
-                 and then Needs_Finalization (Designated_Type (Comp_Typ))
-                 and then Designated_Type (Comp_Typ) /= Typ
-               then
-                  --  Build a homogeneous master for the first anonymous
-                  --  access-to-controlled component. This master may be
-                  --  converted into a heterogeneous collection if more
-                  --  components are to follow.
-
-                  if not Master_Built then
-                     Master_Built := True;
-
-                     --  All anonymous access-to-controlled types allocate
-                     --  on the global pool. Note that the finalization
-                     --  master and the associated storage pool must be set
-                     --  on the root type (both are "root type only").
-
-                     Set_Associated_Storage_Pool
-                       (Root_Type (Comp_Typ), RTE (RE_Global_Pool_Object));
-
-                     Build_Finalization_Master
-                       (Typ            => Root_Type (Comp_Typ),
-                        For_Anonymous  => True,
-                        Context_Scope  => Encl_Scope,
-                        Insertion_Node => Ins_Node);
-
-                     Fin_Mas_Id := Finalization_Master (Comp_Typ);
-
-                  --  Subsequent anonymous access-to-controlled components
-                  --  reuse the available master.
-
-                  else
-                     --  All anonymous access-to-controlled types allocate
-                     --  on the global pool. Note that both the finalization
-                     --  master and the associated storage pool must be set
-                     --  on the root type (both are "root type only").
-
-                     Set_Associated_Storage_Pool
-                       (Root_Type (Comp_Typ), RTE (RE_Global_Pool_Object));
-
-                     --  Shared the master among multiple components
-
-                     Set_Finalization_Master
-                       (Root_Type (Comp_Typ), Fin_Mas_Id);
-
-                     --  Convert the master into a heterogeneous collection.
-                     --  Generate:
-                     --    Set_Is_Heterogeneous (<Fin_Mas_Id>);
-
-                     if not Attributes_Set then
-                        Attributes_Set := True;
-
-                        Insert_Action (Ins_Node,
-                          Make_Procedure_Call_Statement (Loc,
-                            Name                   =>
-                              New_Occurrence_Of
-                                (RTE (RE_Set_Is_Heterogeneous), Loc),
-                            Parameter_Associations => New_List (
-                              New_Occurrence_Of (Fin_Mas_Id, Loc))));
-                     end if;
-                  end if;
-               end if;
-
-               Next_Component (Comp);
-            end loop;
-         end;
-      end if;
-
       --  Check whether individual components have a defined invariant, and add
       --  the corresponding component invariant checks.
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 3a1b19a..ea59e6e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -44,7 +44,6 @@ with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
 with Inline;   use Inline;
-with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -57,7 +56,6 @@ with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
-with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
@@ -92,12 +90,6 @@ package body Exp_Ch4 is
    --  If a boolean array assignment can be done in place, build call to
    --  corresponding library procedure.
 
-   function Current_Anonymous_Master return Entity_Id;
-   --  Return the entity of the heterogeneous finalization master belonging to
-   --  the current unit (either function, package or procedure). This master
-   --  services all anonymous access-to-controlled types. If the current unit
-   --  does not have such master, create one.
-
    procedure Displace_Allocator_Pointer (N : Node_Id);
    --  Ada 2005 (AI-251): Subsidiary procedure to Expand_N_Allocator and
    --  Expand_Allocator_Expression. Allocating class-wide interface objects
@@ -410,202 +402,6 @@ package body Exp_Ch4 is
          return;
    end Build_Boolean_Array_Proc_Call;
 
-   ------------------------------
-   -- Current_Anonymous_Master --
-   ------------------------------
-
-   function Current_Anonymous_Master return Entity_Id is
-      function Create_Anonymous_Master
-        (Unit_Id   : Entity_Id;
-         Unit_Decl : Node_Id) return Entity_Id;
-      --  Create a new anonymous master for a compilation unit denoted by its
-      --  entity Unit_Id and declaration Unit_Decl. The declaration of the new
-      --  master along with any specialized initialization is inserted at the
-      --  top of the unit's declarations (see body for special cases). Return
-      --  the entity of the anonymous master.
-
-      -----------------------------
-      -- Create_Anonymous_Master --
-      -----------------------------
-
-      function Create_Anonymous_Master
-        (Unit_Id   : Entity_Id;
-         Unit_Decl : Node_Id) return Entity_Id
-      is
-         Insert_Nod : Node_Id := Empty;
-         --  The point of insertion into the declarative list of the unit. All
-         --  nodes are inserted before Insert_Nod.
-
-         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id);
-         --  Insert arbitrary node N in declarative list Decls and analyze it
-
-         ------------------------
-         -- Insert_And_Analyze --
-         ------------------------
-
-         procedure Insert_And_Analyze (Decls : List_Id; N : Node_Id) is
-         begin
-            --  The declarative list is already populated, the nodes are
-            --  inserted at the top of the list, preserving their order.
-
-            if Present (Insert_Nod) then
-               Insert_Before (Insert_Nod, N);
-
-            --  Otherwise append to the declarations to preserve order
-
-            else
-               Append_To (Decls, N);
-            end if;
-
-            Analyze (N);
-         end Insert_And_Analyze;
-
-         --  Local variables
-
-         Loc       : constant Source_Ptr := Sloc (Unit_Id);
-         Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Unit_Decl);
-         Decls     : List_Id;
-         FM_Id     : Entity_Id;
-         Pref      : Character;
-         Unit_Spec : Node_Id;
-
-      --  Start of processing for Create_Anonymous_Master
-
-      begin
-         --  Find the declarative list of the unit
-
-         if Nkind (Unit_Decl) = N_Package_Declaration then
-            Unit_Spec := Specification (Unit_Decl);
-            Decls := Visible_Declarations (Unit_Spec);
-
-            if No (Decls) then
-               Decls := New_List (Make_Null_Statement (Loc));
-               Set_Visible_Declarations (Unit_Spec, Decls);
-            end if;
-
-         --  Package or subprogram body
-
-         --  ??? A subprogram declaration that acts as a compilation unit may
-         --  contain a formal parameter of an anonymous access-to-controlled
-         --  type initialized by an allocator.
-
-         --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
-
-         --  There is no suitable place to create the anonymous master as the
-         --  subprogram is not in a declarative list.
-
-         else
-            Decls := Declarations (Unit_Decl);
-
-            if No (Decls) then
-               Decls := New_List (Make_Null_Statement (Loc));
-               Set_Declarations (Unit_Decl, Decls);
-            end if;
-         end if;
-
-         --  The anonymous master and all initialization actions are inserted
-         --  before the first declaration (if any).
-
-         Insert_Nod := First (Decls);
-
-         --  Since the anonymous master and all its initialization actions are
-         --  inserted at top level, use the scope of the unit when analyzing.
-
-         Push_Scope (Spec_Id);
-
-         --  Step 1: Anonymous master creation
-
-         --  Use a unique prefix in case the same unit requires two anonymous
-         --  masters, one for the spec (S) and one for the body (B).
-
-         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
-            Pref := 'S';
-         else
-            Pref := 'B';
-         end if;
-
-         FM_Id :=
-           Make_Defining_Identifier (Loc,
-             New_External_Name
-               (Related_Id => Chars (Unit_Id),
-                Suffix     => "AM",
-                Prefix     => Pref));
-
-         Set_Anonymous_Master (Unit_Id, FM_Id);
-
-         --  Generate:
-         --    <FM_Id> : Finalization_Master;
-
-         Insert_And_Analyze (Decls,
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => FM_Id,
-             Object_Definition   =>
-               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc)));
-
-         --  Step 2: Initialization actions
-
-         --  Generate:
-         --    Set_Base_Pool
-         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
-
-         Insert_And_Analyze (Decls,
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
-             Parameter_Associations => New_List (
-               New_Occurrence_Of (FM_Id, Loc),
-               Make_Attribute_Reference (Loc,
-                 Prefix         =>
-                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
-                 Attribute_Name => Name_Unrestricted_Access))));
-
-         --  Generate:
-         --    Set_Is_Heterogeneous (<FM_Id>);
-
-         Insert_And_Analyze (Decls,
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (RTE (RE_Set_Is_Heterogeneous), Loc),
-             Parameter_Associations => New_List (
-               New_Occurrence_Of (FM_Id, Loc))));
-
-         Pop_Scope;
-         return FM_Id;
-      end Create_Anonymous_Master;
-
-      --  Local declarations
-
-      Unit_Decl : Node_Id;
-      Unit_Id   : Entity_Id;
-
-   --  Start of processing for Current_Anonymous_Master
-
-   begin
-      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
-      Unit_Id   := Defining_Entity (Unit_Decl);
-
-      --  The compilation unit is a package instantiation. In this case the
-      --  anonymous master is associated with the package spec as both the
-      --  spec and body appear at the same level.
-
-      if Nkind (Unit_Decl) = N_Package_Body
-        and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
-      then
-         Unit_Id   := Corresponding_Spec (Unit_Decl);
-         Unit_Decl := Unit_Declaration_Node (Unit_Id);
-      end if;
-
-      if Present (Anonymous_Master (Unit_Id)) then
-         return Anonymous_Master (Unit_Id);
-
-      --  Create a new anonymous master when allocating an object of anonymous
-      --  access-to-controlled type for the first time.
-
-      else
-         return Create_Anonymous_Master (Unit_Id, Unit_Decl);
-      end if;
-   end Current_Anonymous_Master;
-
    --------------------------------
    -- Displace_Allocator_Pointer --
    --------------------------------
@@ -4296,8 +4092,7 @@ package body Exp_Ch4 is
             Set_Finalization_Master
               (Root_Type (PtrT), Finalization_Master (Rel_Typ));
          else
-            Set_Finalization_Master
-              (Root_Type (PtrT), Current_Anonymous_Master);
+            Build_Anonymous_Master (Root_Type (PtrT));
          end if;
       end if;
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index c34f17d..ad68f89 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -422,11 +422,7 @@ package body Exp_Ch6 is
                if Ekind (Ptr_Typ) = E_Anonymous_Access_Type
                  and then No (Finalization_Master (Ptr_Typ))
                then
-                  Build_Finalization_Master
-                    (Typ            => Ptr_Typ,
-                     For_Anonymous  => True,
-                     Context_Scope  => Scope (Ptr_Typ),
-                     Insertion_Node => Associated_Node_For_Itype (Ptr_Typ));
+                  Build_Anonymous_Master (Ptr_Typ);
                end if;
 
                --  Access-to-controlled types should always have a master
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 04b60b5..8f498ac 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -301,6 +301,9 @@ package body Exp_Ch7 is
                      Finalize_Case   => TSS_Deep_Finalize,
                      Address_Case    => TSS_Finalize_Address);
 
+   function Allows_Finalization_Master (Typ : Entity_Id) return Boolean;
+   --  Determine whether access type Typ may have a finalization master
+
    procedure Build_Array_Deep_Procs (Typ : Entity_Id);
    --  Build the deep Initialize/Adjust/Finalize for a record Typ with
    --  Has_Controlled_Component set and store them using the TSS mechanism.
@@ -427,6 +430,332 @@ package body Exp_Ch7 is
    --       [Deep_]Finalize (Acc_Typ (V).all);
    --    end;
 
+   --------------------------------
+   -- Allows_Finalization_Master --
+   --------------------------------
+
+   function Allows_Finalization_Master (Typ : Entity_Id) return Boolean is
+      function In_Deallocation_Instance (E : Entity_Id) return Boolean;
+      --  Determine whether entity E is inside a wrapper package created for
+      --  an instance of Ada.Unchecked_Deallocation.
+
+      ------------------------------
+      -- In_Deallocation_Instance --
+      ------------------------------
+
+      function In_Deallocation_Instance (E : Entity_Id) return Boolean is
+         Pkg : constant Entity_Id := Scope (E);
+         Par : Node_Id := Empty;
+
+      begin
+         if Ekind (Pkg) = E_Package
+           and then Present (Related_Instance (Pkg))
+           and then Ekind (Related_Instance (Pkg)) = E_Procedure
+         then
+            Par := Generic_Parent (Parent (Related_Instance (Pkg)));
+
+            return
+              Present (Par)
+                and then Chars (Par) = Name_Unchecked_Deallocation
+                and then Chars (Scope (Par)) = Name_Ada
+                and then Scope (Scope (Par)) = Standard_Standard;
+         end if;
+
+         return False;
+      end In_Deallocation_Instance;
+
+      --  Local variables
+
+      Desig_Typ : constant Entity_Id := Designated_Type (Typ);
+      Ptr_Typ   : constant Entity_Id :=
+                    Root_Type_Of_Full_View (Base_Type (Typ));
+
+   --  Start of processing for Allows_Finalization_Master
+
+   begin
+      --  Certain run-time configurations and targets do not provide support
+      --  for controlled types and therefore do not need masters.
+
+      if Restriction_Active (No_Finalization) then
+         return False;
+
+      --  Do not consider C and C++ types since it is assumed that the non-Ada
+      --  side will handle their clean up.
+
+      elsif Convention (Desig_Typ) = Convention_C
+        or else Convention (Desig_Typ) = Convention_CPP
+      then
+         return False;
+
+      --  Do not consider types that return on the secondary stack
+
+      elsif Present (Associated_Storage_Pool (Ptr_Typ))
+        and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
+      then
+         return False;
+
+      --  Do not consider types which may never allocate an object
+
+      elsif No_Pool_Assigned (Ptr_Typ) then
+         return False;
+
+      --  Do not consider access types coming from Ada.Unchecked_Deallocation
+      --  instances. Even though the designated type may be controlled, the
+      --  access type will never participate in allocation.
+
+      elsif In_Deallocation_Instance (Ptr_Typ) then
+         return False;
+
+      --  Do not consider non-library access types when restriction
+      --  No_Nested_Finalization is in effect since masters are controlled
+      --  objects.
+
+      elsif Restriction_Active (No_Nested_Finalization)
+        and then not Is_Library_Level_Entity (Ptr_Typ)
+      then
+         return False;
+
+      --  Do not create finalization masters in GNATprove mode because this
+      --  causes unwanted extra expansion. A compilation in this mode must
+      --  keep the tree as close as possible to the original sources.
+
+      elsif GNATprove_Mode then
+         return False;
+
+      --  Otherwise the access type may use a finalization master
+
+      else
+         return True;
+      end if;
+   end Allows_Finalization_Master;
+
+   ----------------------------
+   -- Build_Anonymous_Master --
+   ----------------------------
+
+   procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id) is
+      function Create_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id;
+      --  Create a new anonymous finalization master for access type Ptr_Typ
+      --  with designated type Desig_Typ. The declaration of the master along
+      --  with its specialized initialization is inserted in the declarative
+      --  part of unit Unit_Decl. Unit_Id denotes the entity of Unit_Decl.
+
+      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean;
+      --  Determine whether arbitrary node N appears within the subtree rooted
+      --  at node Root.
+
+      -----------------------------
+      -- Create_Anonymous_Master --
+      -----------------------------
+
+      function Create_Anonymous_Master
+        (Desig_Typ : Entity_Id;
+         Unit_Id   : Entity_Id;
+         Unit_Decl : Node_Id) return Entity_Id
+      is
+         Loc       : constant Source_Ptr := Sloc (Unit_Id);
+         Spec_Id   : constant Entity_Id  := Unique_Defining_Entity (Unit_Decl);
+         Decls     : List_Id;
+         FM_Decl   : Node_Id;
+         FM_Id     : Entity_Id;
+         FM_Init   : Node_Id;
+         Pref      : Character;
+         Unit_Spec : Node_Id;
+
+      begin
+         --  Find the declarative list of the unit
+
+         if Nkind (Unit_Decl) = N_Package_Declaration then
+            Unit_Spec := Specification (Unit_Decl);
+            Decls     := Visible_Declarations (Unit_Spec);
+
+            if No (Decls) then
+               Decls := New_List;
+               Set_Visible_Declarations (Unit_Spec, Decls);
+            end if;
+
+         --  Package body or subprogram case
+
+         --  ??? A subprogram spec or body that acts as a compilation unit may
+         --  contain a formal parameter of an anonymous access-to-controlled
+         --  type initialized by an allocator.
+
+         --    procedure Comp_Unit_Proc (Param : access Ctrl := new Ctrl);
+
+         --  There is no suitable place to create the anonymous master as the
+         --  subprogram is not in a declarative list.
+
+         else
+            Decls := Declarations (Unit_Decl);
+
+            if No (Decls) then
+               Decls := New_List;
+               Set_Declarations (Unit_Decl, Decls);
+            end if;
+         end if;
+
+         --  Step 1: Anonymous master creation
+
+         --  Use a unique prefix in case the same unit requires two anonymous
+         --  masters, one for the spec (S) and one for the body (B).
+
+         if Ekind_In (Unit_Id, E_Function, E_Package, E_Procedure) then
+            Pref := 'S';
+         else
+            Pref := 'B';
+         end if;
+
+         --  The name of the anonymous master has the following format:
+
+         --    [BS]scopN__scop1__chars_of_desig_typAM
+
+         --  The name utilizes the fully qualified name of the designated type
+         --  in case two controlled types with the same name are declared in
+         --  different scopes and both have anonymous access types.
+
+         FM_Id :=
+           Make_Defining_Identifier (Loc,
+             New_External_Name
+               (Related_Id => Get_Qualified_Name (Desig_Typ),
+                Suffix     => "AM",
+                Prefix     => Pref));
+
+         --  Associate the anonymous master with the designated type. This
+         --  ensures that any additional anonymous access types with the same
+         --  designated type will share the same anonymous paster within the
+         --  same unit.
+
+         Set_Anonymous_Master (Desig_Typ, FM_Id);
+
+         --  Generate:
+         --    <FM_Id> : Finalization_Master;
+
+         FM_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => FM_Id,
+             Object_Definition   =>
+               New_Occurrence_Of (RTE (RE_Finalization_Master), Loc));
+
+         --  Step 2: Initialization actions
+
+         --  Generate:
+         --    Set_Base_Pool
+         --      (<FM_Id>, Global_Pool_Object'Unrestricted_Access);
+
+         FM_Init :=
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Occurrence_Of (RTE (RE_Set_Base_Pool), Loc),
+             Parameter_Associations => New_List (
+               New_Occurrence_Of (FM_Id, Loc),
+               Make_Attribute_Reference (Loc,
+                 Prefix         =>
+                   New_Occurrence_Of (RTE (RE_Global_Pool_Object), Loc),
+                 Attribute_Name => Name_Unrestricted_Access)));
+
+         Prepend_To (Decls, FM_Init);
+         Prepend_To (Decls, FM_Decl);
+
+         --  Since the anonymous master and all its initialization actions are
+         --  inserted at top level, use the scope of the unit when analyzing.
+
+         Push_Scope (Spec_Id);
+         Analyze (FM_Decl);
+         Analyze (FM_Init);
+         Pop_Scope;
+
+         return FM_Id;
+      end Create_Anonymous_Master;
+
+      ----------------
+      -- In_Subtree --
+      ----------------
+
+      function In_Subtree (N : Node_Id; Root : Node_Id) return Boolean is
+         Par : Node_Id;
+
+      begin
+         --  Traverse the parent chain until reaching the same root
+
+         Par := N;
+         while Present (Par) loop
+            if Par = Root then
+               return True;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return False;
+      end In_Subtree;
+
+      --  Local variables
+
+      Desig_Typ : Entity_Id;
+      FM_Id     : Entity_Id;
+      Priv_View : Entity_Id;
+      Unit_Decl : Node_Id;
+      Unit_Id   : Entity_Id;
+
+   --  Start of processing for Build_Anonymous_Master
+
+   begin
+      --  Nothing to do if the circumstances do not allow for a finalization
+      --  master.
+
+      if not Allows_Finalization_Master (Ptr_Typ) then
+         return;
+      end if;
+
+      Unit_Decl := Unit (Cunit (Current_Sem_Unit));
+      Unit_Id   := Defining_Entity (Unit_Decl);
+
+      --  The compilation unit is a package instantiation. In this case the
+      --  anonymous master is associated with the package spec as both the
+      --  spec and body appear at the same level.
+
+      if Nkind (Unit_Decl) = N_Package_Body
+        and then Nkind (Original_Node (Unit_Decl)) = N_Package_Instantiation
+      then
+         Unit_Id   := Corresponding_Spec (Unit_Decl);
+         Unit_Decl := Unit_Declaration_Node (Unit_Id);
+      end if;
+
+      --  Use the initial declaration of the designated type when it denotes
+      --  the full view of an incomplete or private type. This ensures that
+      --  types with one and two views are treated the same.
+
+      Desig_Typ := Directly_Designated_Type (Ptr_Typ);
+      Priv_View := Incomplete_Or_Partial_View (Desig_Typ);
+
+      if Present (Priv_View) then
+         Desig_Typ := Priv_View;
+      end if;
+
+      FM_Id := Anonymous_Master (Desig_Typ);
+
+      --  The designated type already has at least one anonymous access type
+      --  pointing to it within the current unit. Reuse the anonymous master
+      --  because the designated type is the same.
+
+      if Present (FM_Id)
+        and then In_Subtree (Declaration_Node (FM_Id), Root => Unit_Decl)
+      then
+         null;
+
+      --  Otherwise the designated type lacks an anonymous master or it is
+      --  declared in a different unit. Create a brand new master.
+
+      else
+         FM_Id := Create_Anonymous_Master (Desig_Typ, Unit_Id, Unit_Decl);
+      end if;
+
+      Set_Finalization_Master (Ptr_Typ, FM_Id);
+   end Build_Anonymous_Master;
+
    ----------------------------
    -- Build_Array_Deep_Procs --
    ----------------------------
@@ -762,7 +1091,6 @@ package body Exp_Ch7 is
 
    procedure Build_Finalization_Master
      (Typ            : Entity_Id;
-      For_Anonymous  : Boolean   := False;
       For_Lib_Level  : Boolean   := False;
       For_Private    : Boolean   := False;
       Context_Scope  : Entity_Id := Empty;
@@ -773,10 +1101,6 @@ package body Exp_Ch7 is
          Ptr_Typ : Entity_Id);
       --  Add access type Ptr_Typ to the pending access type list for type Typ
 
-      function In_Deallocation_Instance (E : Entity_Id) return Boolean;
-      --  Determine whether entity E is inside a wrapper package created for
-      --  an instance of Ada.Unchecked_Deallocation.
-
       -----------------------------
       -- Add_Pending_Access_Type --
       -----------------------------
@@ -798,31 +1122,6 @@ package body Exp_Ch7 is
          Prepend_Elmt (Ptr_Typ, List);
       end Add_Pending_Access_Type;
 
-      ------------------------------
-      -- In_Deallocation_Instance --
-      ------------------------------
-
-      function In_Deallocation_Instance (E : Entity_Id) return Boolean is
-         Pkg : constant Entity_Id := Scope (E);
-         Par : Node_Id := Empty;
-
-      begin
-         if Ekind (Pkg) = E_Package
-           and then Present (Related_Instance (Pkg))
-           and then Ekind (Related_Instance (Pkg)) = E_Procedure
-         then
-            Par := Generic_Parent (Parent (Related_Instance (Pkg)));
-
-            return
-              Present (Par)
-                and then Chars (Par) = Name_Unchecked_Deallocation
-                and then Chars (Scope (Par)) = Name_Ada
-                and then Scope (Scope (Par)) = Standard_Standard;
-         end if;
-
-         return False;
-      end In_Deallocation_Instance;
-
       --  Local variables
 
       Desig_Typ : constant Entity_Id := Designated_Type (Typ);
@@ -836,18 +1135,10 @@ package body Exp_Ch7 is
    --  Start of processing for Build_Finalization_Master
 
    begin
-      --  Certain run-time configurations and targets do not provide support
-      --  for controlled types.
-
-      if Restriction_Active (No_Finalization) then
-         return;
+      --  Nothing to do if the circumstances do not allow for a finalization
+      --  master.
 
-      --  Do not process C, C++ types since it is assumed that the non-Ada side
-      --  will handle their clean up.
-
-      elsif Convention (Desig_Typ) = Convention_C
-        or else Convention (Desig_Typ) = Convention_CPP
-      then
+      if not Allows_Finalization_Master (Typ) then
          return;
 
       --  Various machinery such as freezing may have already created a
@@ -855,48 +1146,6 @@ package body Exp_Ch7 is
 
       elsif Present (Finalization_Master (Ptr_Typ)) then
          return;
-
-      --  Do not process types that return on the secondary stack
-
-      elsif Present (Associated_Storage_Pool (Ptr_Typ))
-        and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
-      then
-         return;
-
-      --  Do not process types which may never allocate an object
-
-      elsif No_Pool_Assigned (Ptr_Typ) then
-         return;
-
-      --  Do not process access types coming from Ada.Unchecked_Deallocation
-      --  instances. Even though the designated type may be controlled, the
-      --  access type will never participate in allocation.
-
-      elsif In_Deallocation_Instance (Ptr_Typ) then
-         return;
-
-      --  Ignore the general use of anonymous access types unless the context
-      --  requires a finalization master.
-
-      elsif Ekind (Ptr_Typ) = E_Anonymous_Access_Type
-        and then not For_Anonymous
-      then
-         return;
-
-      --  Do not process non-library access types when restriction No_Nested_
-      --  Finalization is in effect since masters are controlled objects.
-
-      elsif Restriction_Active (No_Nested_Finalization)
-        and then not Is_Library_Level_Entity (Ptr_Typ)
-      then
-         return;
-
-      --  Do not create finalization masters in GNATprove mode because this
-      --  unwanted extra expansion. A compilation in this mode keeps the tree
-      --  as close as possible to the original sources.
-
-      elsif GNATprove_Mode then
-         return;
       end if;
 
       declare
@@ -1013,11 +1262,11 @@ package body Exp_Ch7 is
             Add_Pending_Access_Type (Desig_Typ, Ptr_Typ);
          end if;
 
-         --  A finalization master created for an anonymous access type or an
-         --  access designating a type with private components must be inserted
-         --  before a context-dependent node.
+         --  A finalization master created for an access designating a type
+         --  with private components is inserted before a context-dependent
+         --  node.
 
-         if For_Anonymous or For_Private then
+         if For_Private then
 
             --  At this point both the scope of the context and the insertion
             --  mode must be known.
@@ -3693,15 +3942,6 @@ package body Exp_Ch7 is
       end if;
    end Check_Visibly_Controlled;
 
-   -------------------------------
-   -- CW_Or_Has_Controlled_Part --
-   -------------------------------
-
-   function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
-   begin
-      return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
-   end CW_Or_Has_Controlled_Part;
-
    ------------------
    -- Convert_View --
    ------------------
@@ -3764,6 +4004,15 @@ package body Exp_Ch7 is
       end if;
    end Convert_View;
 
+   -------------------------------
+   -- CW_Or_Has_Controlled_Part --
+   -------------------------------
+
+   function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
+   begin
+      return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
+   end CW_Or_Has_Controlled_Part;
+
    ------------------------
    -- Enclosing_Function --
    ------------------------
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index 3f90f31..3136934 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -35,6 +35,11 @@ package Exp_Ch7 is
    -- Finalization Management --
    -----------------------------
 
+   procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id);
+   --  Build a finalization master for an anonymous access-to-controlled type
+   --  denoted by Ptr_Typ. The master is inserted in the declarations of the
+   --  current unit.
+
    procedure Build_Controlling_Procs (Typ : Entity_Id);
    --  Typ is a record, and array type having controlled components.
    --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
@@ -99,22 +104,19 @@ package Exp_Ch7 is
 
    procedure Build_Finalization_Master
      (Typ            : Entity_Id;
-      For_Anonymous  : Boolean   := False;
       For_Lib_Level  : Boolean   := False;
       For_Private    : Boolean   := False;
       Context_Scope  : Entity_Id := Empty;
       Insertion_Node : Node_Id   := Empty);
    --  Build a finalization master for an access type. The designated type may
    --  not necessarely be controlled or need finalization actions depending on
-   --  the context. Flag For_Anonymous must be set when creating a master for
-   --  an anonymous access type. Flag For_Lib_Level must be set when creating
-   --  a master for a build-in-place function call access result type. Flag
-   --  For_Private must be set when the designated type contains a private
-   --  component. Parameters Context_Scope and Insertion_Node must be used in
-   --  conjunction with flags For_Anonymous and For_Private. Context_Scope is
-   --  the scope of the context where the finalization master must be analyzed.
-   --  Insertion_Node is the insertion point before which the master is to be
-   --  inserted.
+   --  the context. Flag For_Lib_Level must be set when creating a master for a
+   --  build-in-place function call access result type. Flag For_Private must
+   --  be set when the designated type contains a private component. Parameters
+   --  Context_Scope and Insertion_Node must be used in conjunction with flag
+   --  For_Private. Context_Scope is the scope of the context where the
+   --  finalization master must be analyzed. Insertion_Node is the insertion
+   --  point before which the master is to be inserted.
 
    procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
    --  Build one controlling procedure when a late body overrides one of
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 420482f..fdf8c8a 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -180,6 +180,12 @@ procedure Gnat1drv is
       if Operating_Mode = Check_Semantics and then Tree_Output then
          ASIS_Mode := True;
 
+         --  Set ASIS GNSA mode if -gnatd.H is set
+
+         if Debug_Flag_Dot_HH then
+            ASIS_GNSA_Mode := True;
+         end if;
+
          --  Turn off inlining in ASIS mode, since ASIS cannot handle the extra
          --  information in the trees caused by inlining being active.
 
@@ -1054,7 +1060,7 @@ begin
       if GNATprove_Mode then
          declare
             Unused_E : constant Entity_Id :=
-              Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority);
+                         Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority);
          begin
             null;
          end;
@@ -1176,13 +1182,11 @@ begin
       --  We can generate code for a package declaration or a subprogram
       --  declaration only if it does not required a body.
 
-      elsif Nkind_In (Main_Kind,
-              N_Package_Declaration,
-              N_Subprogram_Declaration)
+      elsif Nkind_In (Main_Kind, N_Package_Declaration,
+                                 N_Subprogram_Declaration)
         and then
           (not Body_Required (Main_Unit_Node)
-             or else
-           Distribution_Stub_Mode = Generate_Caller_Stub_Body)
+             or else Distribution_Stub_Mode = Generate_Caller_Stub_Body)
       then
          Back_End_Mode := Generate_Object;
 
@@ -1247,8 +1251,7 @@ begin
 
       if Back_End_Mode = Skip then
          Set_Standard_Error;
-         Write_Str ("cannot generate code for ");
-         Write_Str ("file ");
+         Write_Str ("cannot generate code for file ");
          Write_Name (Unit_File_Name (Main_Unit));
 
          if Subunits_Missing then
@@ -1320,11 +1323,16 @@ begin
       --  Annotation is suppressed for targets where front-end layout is
       --  enabled, because the front end determines representations.
 
+      --  The back-end is not invoked in ASIS mode with GNSA because all type
+      --  representation information will be provided by the GNSA back-end, not
+      --  gigi.
+
       if Back_End_Mode = Declarations_Only
         and then
           (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode)
             or else Main_Kind = N_Subunit
-            or else Frontend_Layout_On_Target)
+            or else Frontend_Layout_On_Target
+            or else ASIS_GNSA_Mode)
       then
          Post_Compilation_Validation_Checks;
          Errout.Finalize (Last_Call => True);
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 6feb21c..402a9e5 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -208,6 +208,11 @@ package Opt is
    --  Set to non-null when Bind_Alternate_Main_Name is True. This value
    --  is modified as needed by Gnatbind.Scan_Bind_Arg.
 
+   ASIS_GNSA_Mode : Boolean := False;
+   --  GNAT
+   --  Enable GNSA back-end processing assuming ASIS_Mode is already set to
+   --  True. ASIS_GNSA mode suppresses the call to gigi.
+
    ASIS_Mode : Boolean := False;
    --  GNAT
    --  Enable semantic checks and tree transformations that are important
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 875c166..8f078fd 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4758,9 +4758,8 @@ package body Sem_Ch13 is
             elsif Is_Subprogram (U_Ent) then
                if Has_Homonym (U_Ent) then
                   Error_Msg_N
-                    ("address clause cannot be given " &
-                     "for overloaded subprogram",
-                     Nam);
+                    ("address clause cannot be given for overloaded "
+                     & "subprogram", Nam);
                   return;
                end if;
 
@@ -4802,8 +4801,8 @@ package body Sem_Ch13 is
 
                if Warn_On_Obsolescent_Feature then
                   Error_Msg_N
-                    ("?j?attaching interrupt to task entry is an " &
-                     "obsolescent feature (RM J.7.1)", N);
+                    ("?j?attaching interrupt to task entry is an obsolescent "
+                     & "feature (RM J.7.1)", N);
                   Error_Msg_N
                     ("\?j?use interrupt procedure instead", N);
                end if;
@@ -5022,12 +5021,17 @@ package body Sem_Ch13 is
                Set_Has_Alignment_Clause (U_Ent);
 
                --  Tagged type case, check for attempt to set alignment to a
-               --  value greater than Max_Align, and reset if so.
+               --  value greater than Max_Align, and reset if so. This error
+               --  is suppressed in ASIS mode to allow for different ASIS
+               --  back-ends or ASIS-based tools to query the illegal clause.
 
-               if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
+               if Is_Tagged_Type (U_Ent)
+                 and then Align > Max_Align
+                 and then not ASIS_Mode
+               then
                   Error_Msg_N
                     ("alignment for & set to Maximum_Aligment??", Nam);
-                     Set_Alignment (U_Ent, Max_Align);
+                  Set_Alignment (U_Ent, Max_Align);
 
                --  All other cases
 
@@ -5100,7 +5104,7 @@ package body Sem_Ch13 is
             end if;
 
             Btype := Base_Type (U_Ent);
-            Ctyp := Component_Type (Btype);
+            Ctyp  := Component_Type (Btype);
 
             if Duplicate_Clause then
                null;
@@ -5324,8 +5328,8 @@ package body Sem_Ch13 is
                   Error_Msg_NE
                     ("??non-unique external tag supplied for &", N, U_Ent);
                   Error_Msg_N
-                       ("\??same external tag applies to all "
-                        & "subprogram calls", N);
+                    ("\??same external tag applies to all subprogram calls",
+                     N);
                   Error_Msg_N
                     ("\??corresponding internal tag cannot be obtained", N);
                end if;
@@ -5363,8 +5367,8 @@ package body Sem_Ch13 is
             if From_Aspect_Specification (N) then
                if not Is_Concurrent_Type (U_Ent) then
                   Error_Msg_N
-                    ("Interrupt_Priority can only be defined for task "
-                     & "and protected object", Nam);
+                    ("Interrupt_Priority can only be defined for task and "
+                     & "protected object", Nam);
 
                elsif Duplicate_Clause then
                   null;
@@ -5456,9 +5460,15 @@ package body Sem_Ch13 is
 
                if Radix = 2 then
                   null;
+
                elsif Radix = 10 then
                   Set_Machine_Radix_10 (U_Ent);
-               else
+
+               --  The following error is suppressed in ASIS mode to allow for
+               --  different ASIS back-ends or ASIS-based tools to query the
+               --  illegal clause.
+
+               elsif not ASIS_Mode then
                   Error_Msg_N ("machine radix value must be 2 or 10", Expr);
                end if;
             end if;
@@ -5486,7 +5496,14 @@ package body Sem_Ch13 is
             else
                Check_Size (Expr, U_Ent, Size, Biased);
 
-               if Is_Scalar_Type (U_Ent) then
+               --  The following errors are suppressed in ASIS mode to allow
+               --  for different ASIS back-ends or ASIS-based tools to query
+               --  the illegal clause.
+
+               if ASIS_Mode then
+                  null;
+
+               elsif Is_Scalar_Type (U_Ent) then
                   if Size /= 8 and then Size /= 16 and then Size /= 32
                     and then UI_Mod (Size, 64) /= 0
                   then
@@ -5573,8 +5590,8 @@ package body Sem_Ch13 is
          begin
             if not (Is_Record_Type (U_Ent) or else Is_Array_Type (U_Ent)) then
                Error_Msg_N
-                 ("Scalar_Storage_Order can only be defined for "
-                  & "record or array type", Nam);
+                 ("Scalar_Storage_Order can only be defined for record or "
+                  & "array type", Nam);
 
             elsif Duplicate_Clause then
                null;
@@ -5598,8 +5615,8 @@ package body Sem_Ch13 is
                      Set_Reverse_Storage_Order (Base_Type (U_Ent), True);
                   else
                      Error_Msg_N
-                       ("non-default Scalar_Storage_Order "
-                        & "not supported on target", Expr);
+                       ("non-default Scalar_Storage_Order not supported on "
+                        & "target", Expr);
                   end if;
                end if;
 
@@ -5696,21 +5713,22 @@ package body Sem_Ch13 is
                --  For objects, set Esize only
 
                else
-                  if Is_Elementary_Type (Etyp) then
-                     if Size /= System_Storage_Unit
-                          and then
-                        Size /= System_Storage_Unit * 2
-                          and then
-                        Size /= System_Storage_Unit * 4
-                           and then
-                        Size /= System_Storage_Unit * 8
-                     then
-                        Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
-                        Error_Msg_Uint_2 := Error_Msg_Uint_1 * 8;
-                        Error_Msg_N
-                          ("size for primitive object must be a power of 2"
-                            & " in the range ^-^", N);
-                     end if;
+                  --  The following error is suppressed in ASIS mode to allow
+                  --  for different ASIS back-ends or ASIS-based tools to query
+                  --  the illegal clause.
+
+                  if Is_Elementary_Type (Etyp)
+                    and then Size /= System_Storage_Unit
+                    and then Size /= System_Storage_Unit * 2
+                    and then Size /= System_Storage_Unit * 4
+                    and then Size /= System_Storage_Unit * 8
+                    and then not ASIS_Mode
+                  then
+                     Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
+                     Error_Msg_Uint_2 := Error_Msg_Uint_1 * 8;
+                     Error_Msg_N
+                       ("size for primitive object must be a power of 2 in "
+                        & "the range ^-^", N);
                   end if;
 
                   Set_Esize (U_Ent, Size);
@@ -5955,8 +5973,8 @@ package body Sem_Ch13 is
 
                   if Warn_On_Obsolescent_Feature then
                      Error_Msg_N
-                       ("?j?storage size clause for task is an " &
-                        "obsolescent feature (RM J.9)", N);
+                       ("?j?storage size clause for task is an obsolescent "
+                        & "feature (RM J.9)", N);
                      Error_Msg_N ("\?j?use Storage_Size pragma instead", N);
                   end if;
                end if;
@@ -6024,24 +6042,29 @@ package body Sem_Ch13 is
                null;
 
             elsif Is_Elementary_Type (U_Ent) then
-               if Size /= System_Storage_Unit
-                    and then
-                  Size /= System_Storage_Unit * 2
-                    and then
-                  Size /= System_Storage_Unit * 4
-                     and then
-                  Size /= System_Storage_Unit * 8
+
+               --  The following errors are suppressed in ASIS mode to allow
+               --  for different ASIS back-ends or ASIS-based tools to query
+               --  the illegal clause.
+
+               if ASIS_Mode then
+                  null;
+
+               elsif Size /= System_Storage_Unit
+                 and then Size /= System_Storage_Unit * 2
+                 and then Size /= System_Storage_Unit * 4
+                 and then Size /= System_Storage_Unit * 8
                then
                   Error_Msg_Uint_1 := UI_From_Int (System_Storage_Unit);
                   Error_Msg_N
-                    ("stream size for elementary type must be a"
-                       & " power of 2 and at least ^", N);
+                    ("stream size for elementary type must be a power of 2 "
+                     & "and at least ^", N);
 
                elsif RM_Size (U_Ent) > Size then
                   Error_Msg_Uint_1 := RM_Size (U_Ent);
                   Error_Msg_N
-                    ("stream size for elementary type must be a"
-                       & " power of 2 and at least ^", N);
+                    ("stream size for elementary type must be a power of 2 "
+                     & "and at least ^", N);
                end if;
 
                Set_Has_Stream_Size_Clause (U_Ent);
@@ -6787,12 +6810,10 @@ package body Sem_Ch13 is
               and then Lbit /= No_Uint
             then
                if Posit < 0 then
-                  Error_Msg_N
-                    ("position cannot be negative", Position (CC));
+                  Error_Msg_N ("position cannot be negative", Position (CC));
 
                elsif Fbit < 0 then
-                  Error_Msg_N
-                    ("first bit cannot be negative", First_Bit (CC));
+                  Error_Msg_N ("first bit cannot be negative", First_Bit (CC));
 
                --  The Last_Bit specified in a component clause must not be
                --  less than the First_Bit minus one (RM-13.5.1(10)).
@@ -6885,8 +6906,8 @@ package body Sem_Ch13 is
                                                    Intval (Last_Bit (CC))
                            then
                               Error_Msg_N
-                                ("component clause inconsistent "
-                                 & "with representation of ancestor", CC);
+                                ("component clause inconsistent with "
+                                 & "representation of ancestor", CC);
 
                            elsif Warn_On_Redundant_Constructs then
                               Error_Msg_N
@@ -10870,13 +10891,36 @@ package body Sem_Ch13 is
       Siz    : Uint;
       Biased : out Boolean)
    is
+      procedure Size_Too_Small_Error (Min_Siz : Uint);
+      --  Emit an error concerning illegal size Siz. Min_Siz denotes the
+      --  minimum size.
+
+      --------------------------
+      -- Size_Too_Small_Error --
+      --------------------------
+
+      procedure Size_Too_Small_Error (Min_Siz : Uint) is
+      begin
+         --  This error is suppressed in ASIS mode to allow for different ASIS
+         --  back-ends or ASIS-based tools to query the illegal clause.
+
+         if not ASIS_Mode then
+            Error_Msg_Uint_1 := Min_Siz;
+            Error_Msg_NE ("size for & too small, minimum allowed is ^", N, T);
+         end if;
+      end Size_Too_Small_Error;
+
+      --  Local variables
+
       UT : constant Entity_Id := Underlying_Type (T);
       M  : Uint;
 
+   --  Start of processing for Check_Size
+
    begin
       Biased := False;
 
-      --  Reject patently improper size values.
+      --  Reject patently improper size values
 
       if Is_Elementary_Type (T)
         and then Siz > UI_From_Int (Int'Last)
@@ -10945,9 +10989,7 @@ package body Sem_Ch13 is
                return;
 
             else
-               Error_Msg_Uint_1 := Asiz;
-               Error_Msg_NE
-                 ("size for& too small, minimum allowed is ^", N, T);
+               Size_Too_Small_Error (Asiz);
                Set_Esize   (T, Asiz);
                Set_RM_Size (T, Asiz);
             end if;
@@ -10962,9 +11004,7 @@ package body Sem_Ch13 is
       --  since we don't know all the characteristics of the type that can
       --  affect the size (e.g. a specified small) till freeze time.
 
-      elsif Is_Fixed_Point_Type (UT)
-        and then not Is_Frozen (UT)
-      then
+      elsif Is_Fixed_Point_Type (UT) and then not Is_Frozen (UT) then
          null;
 
       --  Cases for which a minimum check is required
@@ -10988,10 +11028,8 @@ package body Sem_Ch13 is
             M := UI_From_Int (Minimum_Size (UT, Biased => True));
 
             if Siz < M then
-               Error_Msg_Uint_1 := M;
-               Error_Msg_NE
-                 ("size for& too small, minimum allowed is ^", N, T);
-               Set_Esize (T, M);
+               Size_Too_Small_Error (M);
+               Set_Esize   (T, M);
                Set_RM_Size (T, M);
             else
                Biased := True;
@@ -11513,14 +11551,36 @@ package body Sem_Ch13 is
    -------------------------
 
    function Get_Alignment_Value (Expr : Node_Id) return Uint is
+      procedure Alignment_Error;
+      --  Issue an error concerning a negatize or zero alignment represented by
+      --  expression Expr.
+
+      ---------------------
+      -- Alignment_Error --
+      ---------------------
+
+      procedure Alignment_Error is
+      begin
+         --  This error is suppressed in ASIS mode to allow for different ASIS
+         --  back-ends or ASIS-based tools to query the illegal clause.
+
+         if not ASIS_Mode then
+            Error_Msg_N ("alignment value must be positive", Expr);
+         end if;
+      end Alignment_Error;
+
+      --  Local variables
+
       Align : constant Uint := Static_Integer (Expr);
 
+   --  Start of processing for Get_Alignment_Value
+
    begin
       if Align = No_Uint then
          return No_Uint;
 
       elsif Align <= 0 then
-         Error_Msg_N ("alignment value must be positive", Expr);
+         Alignment_Error;
          return No_Uint;
 
       else
@@ -11532,8 +11592,7 @@ package body Sem_Ch13 is
                exit when M = Align;
 
                if M > Align then
-                  Error_Msg_N
-                    ("alignment value must be power of 2", Expr);
+                  Alignment_Error;
                   return No_Uint;
                end if;
             end;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9ed1301..46079c5 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3560,9 +3560,7 @@ package body Sem_Ch3 is
 
       --  Special checks for protected objects not at library level
 
-      if Is_Protected_Type (T)
-        and then not Is_Library_Level_Entity (Id)
-      then
+      if Has_Protected (T) and then not Is_Library_Level_Entity (Id) then
          Check_Restriction (No_Local_Protected_Objects, Id);
 
          --  Protected objects with interrupt handlers must be at library level
@@ -3574,7 +3572,10 @@ package body Sem_Ch3 is
          --  AI05-0303: The AI is in fact a binding interpretation, and thus
          --  applies to the '95 version of the language as well.
 
-         if Has_Interrupt_Handler (T) and then Ada_Version < Ada_95 then
+         if Is_Protected_Type (T)
+           and then Has_Interrupt_Handler (T)
+           and then Ada_Version < Ada_95
+         then
             Error_Msg_N
               ("interrupt object can only be declared at library level", Id);
          end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 34f3a20..371c147 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8322,6 +8322,73 @@ package body Sem_Util is
       return Get_Pragma_Id (Pragma_Name (N));
    end Get_Pragma_Id;
 
+   ------------------------
+   -- Get_Qualified_Name --
+   ------------------------
+
+   function Get_Qualified_Name
+     (Id     : Entity_Id;
+      Suffix : Entity_Id := Empty) return Name_Id
+   is
+      Suffix_Nam : Name_Id := No_Name;
+
+   begin
+      if Present (Suffix) then
+         Suffix_Nam := Chars (Suffix);
+      end if;
+
+      return Get_Qualified_Name (Chars (Id), Suffix_Nam, Scope (Id));
+   end Get_Qualified_Name;
+
+   function Get_Qualified_Name
+     (Nam    : Name_Id;
+      Suffix : Name_Id   := No_Name;
+      Scop   : Entity_Id := Current_Scope) return Name_Id
+   is
+      procedure Add_Scope (S : Entity_Id);
+      --  Add the fully qualified form of scope S to the name buffer. The
+      --  format is:
+      --    s-1__s__
+
+      ---------------
+      -- Add_Scope --
+      ---------------
+
+      procedure Add_Scope (S : Entity_Id) is
+      begin
+         if S = Empty then
+            null;
+
+         elsif S = Standard_Standard then
+            null;
+
+         else
+            Add_Scope (Scope (S));
+            Get_Name_String_And_Append (Chars (S));
+            Add_Str_To_Name_Buffer ("__");
+         end if;
+      end Add_Scope;
+
+   --  Start of processing for Get_Qualified_Name
+
+   begin
+      Name_Len := 0;
+      Add_Scope (Scop);
+
+      --  Append the base name after all scopes have been chained
+
+      Get_Name_String_And_Append (Nam);
+
+      --  Append the suffix (if present)
+
+      if Suffix /= No_Name then
+         Add_Str_To_Name_Buffer ("__");
+         Get_Name_String_And_Append (Suffix);
+      end if;
+
+      return Name_Find;
+   end Get_Qualified_Name;
+
    -----------------------
    -- Get_Reason_String --
    -----------------------
@@ -17762,39 +17829,13 @@ package body Sem_Util is
    -----------------
 
    procedure Output_Name (Nam : Name_Id; Scop : Entity_Id := Current_Scope) is
-      procedure Output_Scope (S : Entity_Id);
-      --  Add the fully qualified form of scope S to the name buffer. The
-      --  qualification format is:
-      --    scope1__scopeN__
-
-      ------------------
-      -- Output_Scope --
-      ------------------
-
-      procedure Output_Scope (S : Entity_Id) is
-      begin
-         if S = Empty then
-            null;
-
-         elsif S = Standard_Standard then
-            null;
-
-         else
-            Output_Scope (Scope (S));
-            Add_Str_To_Name_Buffer (Get_Name_String (Chars (S)));
-            Add_Str_To_Name_Buffer ("__");
-         end if;
-      end Output_Scope;
-
-   --  Start of processing for Output_Name
-
    begin
-      Name_Len := 0;
-      Output_Scope (Scop);
-
-      Add_Str_To_Name_Buffer (Get_Name_String (Nam));
-
-      Write_Str (Name_Buffer (1 .. Name_Len));
+      Write_Str
+        (Get_Name_String
+          (Get_Qualified_Name
+            (Nam    => Nam,
+             Suffix => No_Name,
+             Scop   => Scop)));
       Write_Eol;
    end Output_Name;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index fb049ef..c7fdc81 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -950,6 +950,20 @@ package Sem_Util is
    pragma Inline (Get_Pragma_Id);
    --  Obtains the Pragma_Id from the Chars field of Pragma_Identifier (N)
 
+   function Get_Qualified_Name
+     (Id     : Entity_Id;
+      Suffix : Entity_Id := Empty) return Name_Id;
+   --  Obtain the fully qualified form of entity Id. The format is:
+   --    scope_of_id-1__scope_of_id__chars_of_id__chars_of_suffix
+
+   function Get_Qualified_Name
+     (Nam    : Name_Id;
+      Suffix : Name_Id   := No_Name;
+      Scop   : Entity_Id := Current_Scope) return Name_Id;
+   --  Obtain the fully qualified form of name Nam assuming it appears in scope
+   --  Scop. The format is:
+   --    scop-1__scop__nam__suffix
+
    procedure Get_Reason_String (N : Node_Id);
    --  Recursive routine to analyze reason argument for pragma Warnings. The
    --  value of the reason argument is appended to the current string using