[Ada] Checks on instantiations with formal derived types with interfaces

This patch implements the rule stated in RM 12.5.5 : the actual shall be
a descendant of very progenitor of the formal type.

2018-05-25  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch12.adb (Validate_Derived_Type_Instance): Verify that the actual
	for a formal derived type implements all the interfaces declared for
	the formal.

gcc/testsuite/

	* gnat.dg/interface6.adb: New testcase.

From-SVN: r260723

2 files changed, 48 insertions, 0 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a6fb325..adb62f5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Validate_Derived_Type_Instance): Verify that the actual
+	for a formal derived type implements all the interfaces declared for
+	the formal.
+
 2018-05-25  Yannick Moy  <moy@adacore.com>
 
 	* sem_prag.adb (Check_Applicable_Policy): Deal specially with CodePeer
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index c8d4df0..bc7dd13 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -12356,6 +12356,48 @@ package body Sem_Ch12 is
          Ancestor_Discr : Entity_Id;
 
       begin
+         --  Verify that the actual includes the progenitors of the formal,
+         --  if any. The formal may depend on previous formals and their
+         --  instance, so we must examine instance of interfaces if present.
+         --  The actual may be an extension of an interface, in which case
+         --  it does not appear in the interface list, so this must be
+         --  checked separately.
+         --  We omit the check if the interface is declared in an (enclosing)
+         --  generic because the interface implemented by the actual may have
+         --  the same name but a different entity. A small remaining gap ???
+
+         if Present (Interface_List (Def)) then
+            if not Has_Interfaces (Act_T) then
+               Error_Msg_NE
+                 ("actual must implement all interfaces of formal&",
+                   Actual, A_Gen_T);
+
+            else
+               declare
+                  Iface : Node_Id;
+                  Iface_Ent : Entity_Id;
+
+               begin
+                  Iface := First (Abstract_Interface_List (A_Gen_T));
+
+                  while Present (Iface) loop
+                     Iface_Ent := Get_Instance_Of (Entity (Iface));
+                     if not Is_Progenitor (Iface_Ent, Act_T)
+                     and then not Is_Ancestor (Iface_Ent, Act_T)
+                     and then Ekind (Scope (Iface_Ent)) /= E_Generic_Package
+                     then
+                        Error_Msg_Name_1 := Chars (Act_T);
+                        Error_Msg_NE
+                          ("Actual% must implement interface&",
+                            Actual,  Etype (Iface));
+                     end if;
+
+                     Next (Iface);
+                  end loop;
+               end;
+            end if;
+         end if;
+
          --  If the parent type in the generic declaration is itself a previous
          --  formal type, then it is local to the generic and absent from the
          --  analyzed generic definition. In that case the ancestor is the