[Ada] Crash on interface equality covered by a renaming declaration

[Pierre-Marie de Rodat <derodat at adacore dot com>]

The frontend crashes processing a tagged type that implements an
interface which has an equality primitive (that is, "=") and covers such
primitive by means of a renaming declaration.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-11-14  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_disp.adb (Expand_Interface_Thunk): Extend handling of
	renamings of the predefined equality primitive.
	(Make_Secondary_DT): When calling Expand_Interface_Thunk() pass
	it the primitive, instead of its Ultimate_Alias; required to
	allow the called routine to identify renamings of the predefined
	equality operation.

gcc/testsuite/

	* gnat.dg/equal5.adb, gnat.dg/equal5.ads: New testcase.

--- gcc/ada/exp_disp.adb
+++ gcc/ada/exp_disp.adb
@@ -1828,6 +1828,9 @@ package body Exp_Disp is
       Formal        : Node_Id;
       Ftyp          : Entity_Id;
       Iface_Formal  : Node_Id := Empty;  -- initialize to prevent warning
+      Is_Predef_Op  : constant Boolean :=
+                        Is_Predefined_Dispatching_Operation (Prim)
+                          or else Is_Predefined_Dispatching_Operation (Target);
       New_Arg       : Node_Id;
       Offset_To_Top : Node_Id;
       Target_Formal : Entity_Id;
@@ -1838,7 +1841,7 @@ package body Exp_Disp is
 
       --  No thunk needed if the primitive has been eliminated
 
-      if Is_Eliminated (Ultimate_Alias (Prim)) then
+      if Is_Eliminated (Target) then
          return;
 
       --  In case of primitives that are functions without formals and a
@@ -1859,9 +1862,10 @@ package body Exp_Disp is
       --  actual object) generate code that modify its contents.
 
       --  Note: This special management is not done for predefined primitives
-      --  because???
+      --  because they don't have available the Interface_Alias attribute (see
+      --  Sem_Ch3.Add_Internal_Interface_Entities).
 
-      if not Is_Predefined_Dispatching_Operation (Prim) then
+      if not Is_Predef_Op then
          Iface_Formal := First_Formal (Interface_Alias (Prim));
       end if;
 
@@ -1872,9 +1876,7 @@ package body Exp_Disp is
          --  Use the interface type as the type of the controlling formal (see
          --  comment above).
 
-         if not Is_Controlling_Formal (Formal)
-           or else Is_Predefined_Dispatching_Operation (Prim)
-         then
+         if not Is_Controlling_Formal (Formal) or else Is_Predef_Op then
             Ftyp := Etype (Formal);
             Expr := New_Copy_Tree (Expression (Parent (Formal)));
          else
@@ -1892,7 +1894,7 @@ package body Exp_Disp is
              Parameter_Type => New_Occurrence_Of (Ftyp, Loc),
              Expression => Expr));
 
-         if not Is_Predefined_Dispatching_Operation (Prim) then
+         if not Is_Predef_Op then
             Next_Formal (Iface_Formal);
          end if;
 
@@ -4061,8 +4063,7 @@ package body Exp_Disp is
                           Alias (Prim);
 
                      else
-                        Expand_Interface_Thunk
-                          (Ultimate_Alias (Prim), Thunk_Id, Thunk_Code);
+                        Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code);
 
                         if Present (Thunk_Id) then
                            Append_To (Result, Thunk_Code);

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/equal5.adb
@@ -0,0 +1,13 @@
+--  { dg-do compile }
+
+package body Equal5 is
+   function "="
+     (Left  : Eq_Parent;
+      Right : Eq_Parent) return Boolean is (True);
+
+   procedure Op (Obj : Child_6) is null;
+
+   function Equals
+     (Left  : Child_6;
+      Right : Child_6) return Boolean is (True);
+end Equal5;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/equal5.ads
@@ -0,0 +1,31 @@
+package Equal5 is
+   type Eq_Parent is tagged null record;
+
+   function "="
+     (Left  : Eq_Parent;
+      Right : Eq_Parent) return Boolean;
+
+   type Eq_Iface is interface;
+
+   function "="
+     (Left  : Eq_Iface;
+      Right : Eq_Iface) return Boolean is abstract;
+   procedure Op (Obj : Eq_Iface) is abstract;
+
+   -----------------
+   -- Derivations --
+   -----------------
+
+   type Child_6 is new Eq_Parent and Eq_Iface with null record;
+
+   procedure Op (Obj : Child_6);
+
+   function Equals
+     (Left  : Child_6;
+      Right : Child_6) return Boolean;
+
+   function "="
+     (Left  : Child_6;
+      Right : Child_6) return Boolean renames Equals;  --  Test
+
+end Equal5;