[Ada] Compiler crash on -gnata -O2

gcc/ada/

	* contracts.adb (Build_Unique_Name): New subprogram.
	(Make_Class_Precondition_Subps): Use Build_Unique_Name to
	generate the names of the call helpers and the name of indirect
	call wrappers.
	* freeze.adb (Needs_Wrapper): Remove dead code.
	(Check_Inherited_Conditions): Defer building helpers and ICW
	until all the dispatch table wrappers have been built and
	analyzed. Required to ensure uniqueness in their names because
	when building these wrappers for overlapped subprograms their
	homonym number is not definite until they have been analyzed.

2 files changed, 88 insertions, 53 deletions

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 3cda36a..7ce3cfa 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -3630,6 +3630,10 @@ package body Contracts is
       --  and append it to the freezing actions of Tagged_Type. Is_Dynamic
       --  controls building the static or dynamic version of the helper.
 
+      function Build_Unique_Name (Suffix : String) return Name_Id;
+      --  Build an unique new name adding suffix to Subp_Id name (plus its
+      --  homonym number for values bigger than 1).
+
       -------------------------------
       -- Add_Indirect_Call_Wrapper --
       -------------------------------
@@ -3710,9 +3714,7 @@ package body Contracts is
          function Build_ICW_Decl return Node_Id is
             ICW_Id : constant Entity_Id  :=
                        Make_Defining_Identifier (Loc,
-                         New_External_Name (Chars (Subp_Id),
-                           Suffix       => "ICW",
-                           Suffix_Index => Source_Offset (Loc)));
+                         Build_Unique_Name (Suffix => "ICW"));
             Decl   : Node_Id;
             Spec   : Node_Id;
 
@@ -4049,6 +4051,29 @@ package body Contracts is
          end if;
       end Add_Call_Helper;
 
+      -----------------------
+      -- Build_Unique_Name --
+      -----------------------
+
+      function Build_Unique_Name (Suffix : String) return Name_Id is
+      begin
+         --  Append the homonym number. Strip the leading space character in
+         --  the image of natural numbers. Also do not add the homonym value
+         --  of 1.
+
+         if Has_Homonym (Subp_Id) and then Homonym_Number (Subp_Id) > 1 then
+            declare
+               S : constant String := Homonym_Number (Subp_Id)'Img;
+
+            begin
+               return New_External_Name (Chars (Subp_Id),
+                        Suffix => Suffix & "_" & S (2 .. S'Last));
+            end;
+         end if;
+
+         return New_External_Name (Chars (Subp_Id), Suffix);
+      end Build_Unique_Name;
+
       --  Local variables
 
       Helper_Id : Entity_Id;
@@ -4070,9 +4095,7 @@ package body Contracts is
 
             Helper_Id :=
               Make_Defining_Identifier (Loc,
-                New_External_Name (Chars (Subp_Id),
-                Suffix       => "DP",
-                Suffix_Index => Source_Offset (Loc)));
+                Build_Unique_Name (Suffix => "DP"));
             Add_Call_Helper (Helper_Id, Is_Dynamic => True);
 
             --  Link original subprogram to helper and vice versa
@@ -4089,9 +4112,7 @@ package body Contracts is
 
             Helper_Id :=
               Make_Defining_Identifier (Loc,
-                New_External_Name (Chars (Subp_Id),
-                Suffix       => "SP",
-                Suffix_Index => Source_Offset (Loc)));
+                Build_Unique_Name (Suffix => "SP"));
 
             Add_Call_Helper (Helper_Id, Is_Dynamic => False);
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index bc8d958..7d90f51 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1741,17 +1741,6 @@ package body Freeze is
                 (Nkind (Parent (N)) /= N_Attribute_Reference
                   or else Attribute_Name (Parent (N)) /= Name_Class)
             then
-               --  The check does not apply to dispatching calls within the
-               --  condition, but only to calls whose static tag is that of
-               --  the parent type.
-
-               if Is_Subprogram (Entity (N))
-                 and then Nkind (Parent (N)) = N_Function_Call
-                 and then Present (Controlling_Argument (Parent (N)))
-               then
-                  return OK;
-               end if;
-
                --  Determine whether entity has a renaming
 
                New_E := Get_Mapped_Entity (Entity (N));
@@ -1795,6 +1784,10 @@ package body Freeze is
       Ifaces_Listed  : Boolean := False;
       --  Cache the list of interface operations inherited by R
 
+      Wrappers_List  : Elist_Id := No_Elist;
+      --  List containing identifiers of built wrappers. Used to defer building
+      --  and analyzing their class-wide precondition subprograms.
+
    --  Start of processing for Check_Inherited_Conditions
 
    begin
@@ -1985,16 +1978,21 @@ package body Freeze is
                Prim_Prev_E : constant Entity_Id := Prev_Entity (Prim);
 
             begin
-               --  The wrapper must be analyzed in the scope of its wrapped
-               --  primitive (to ensure its correct decoration).
-
-               Push_Scope (Scope (Prim));
-
                DTW_Spec := Build_DTW_Spec (Par_Prim);
                DTW_Id   := Defining_Entity (DTW_Spec);
                DTW_Decl := Make_Subprogram_Declaration (Loc,
                              Specification => DTW_Spec);
 
+               --  The spec of the wrapper has been built using the source
+               --  location of its parent primitive; we must update it now
+               --  (with the source location of the internal primitive built
+               --  by Derive_Subprogram that will override this wrapper) to
+               --  avoid inlining conflicts between internally built helpers
+               --  for class-wide pre/postconditions of the parent and the
+               --  helpers built for this wrapper.
+
+               Set_Sloc (DTW_Id, Sloc (Prim));
+
                --  For inherited class-wide preconditions the DTW wrapper
                --  reuses the ICW of the parent (which checks the parent
                --  interpretation of the class-wide preconditions); the
@@ -2121,42 +2119,58 @@ package body Freeze is
                     Register_Primitive (Loc, DTW_Id));
                end if;
 
-               --  Build the helper and ICW for the DTW
+               --  Defer building helpers and ICW for the DTW. Required to
+               --  ensure uniqueness in their names because when building
+               --  these wrappers for overlapped subprograms their homonym
+               --  number is not definite until all these dispatch table
+               --  wrappers of tagged type R have been analyzed.
 
                if Present (Indirect_Call_Wrapper (Par_Prim)) then
-                  declare
-                     CW_Subp : Entity_Id;
-                     Decl_N  : Node_Id;
-                     Body_N  : Node_Id;
-
-                  begin
-                     Merge_Class_Conditions (DTW_Id);
-                     Make_Class_Precondition_Subps (DTW_Id,
-                       Late_Overriding => Late_Overriding);
-
-                     CW_Subp := Static_Call_Helper (DTW_Id);
-                     Decl_N  := Unit_Declaration_Node (CW_Subp);
-                     Analyze (Decl_N);
-
-                     --  If the DTW was built for a late-overriding primitive
-                     --  its body must be analyzed now (since the tagged type
-                     --  is already frozen).
-
-                     if Late_Overriding then
-                        Body_N :=
-                          Unit_Declaration_Node
-                            (Corresponding_Body (Decl_N));
-                        Analyze (Body_N);
-                     end if;
-                  end;
+                  Append_New_Elmt (DTW_Id, Wrappers_List);
                end if;
-
-               Pop_Scope;
             end;
          end if;
 
          Next_Elmt (Op_Node);
       end loop;
+
+      --  Build and analyze deferred class-wide precondition subprograms of
+      --  built wrappers.
+
+      if Present (Wrappers_List) then
+         declare
+            Body_N  : Node_Id;
+            CW_Subp : Entity_Id;
+            Decl_N  : Node_Id;
+            DTW_Id  : Entity_Id;
+            Elmt    : Elmt_Id;
+
+         begin
+            Elmt := First_Elmt (Wrappers_List);
+
+            while Present (Elmt) loop
+               DTW_Id := Node (Elmt);
+               Next_Elmt (Elmt);
+
+               Merge_Class_Conditions (DTW_Id);
+               Make_Class_Precondition_Subps (DTW_Id, Late_Overriding);
+
+               CW_Subp := Static_Call_Helper (DTW_Id);
+               Decl_N  := Unit_Declaration_Node (CW_Subp);
+               Analyze (Decl_N);
+
+               --  If the DTW was built for a late-overriding primitive
+               --  its body must be analyzed now (since the tagged type
+               --  is already frozen).
+
+               if Late_Overriding then
+                  Body_N :=
+                    Unit_Declaration_Node (Corresponding_Body (Decl_N));
+                  Analyze (Body_N);
+               end if;
+            end loop;
+         end;
+      end if;
    end Check_Inherited_Conditions;
 
    ----------------------------