This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Checks on instantiations with formal derived types with interfaces
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Ed Schonberg <schonberg at adacore dot com>
- Date: Fri, 25 May 2018 05:07:06 -0400
- Subject: [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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
--- gcc/ada/sem_ch12.adb
+++ 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
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/interface6.adb
@@ -0,0 +1,44 @@
+-- { dg-do compile }
+
+procedure Interface6 is
+
+ type TI is interface;
+ type TI2 is interface;
+
+ type Rec_Type is tagged null record;
+
+ type Rec_Type1 is new TI
+ with
+ record
+ A : Integer;
+ end record;
+
+ type Rec_Type2 is new Rec_Type1 and TI2
+ with
+ record
+ B : Integer;
+ end record;
+
+ type Rec_Type12 is new Rec_Type1 and TI and TI2
+ with
+ record
+ C : Integer;
+ end record;
+
+ generic
+ type T is new Rec_Type1 and TI2 with private;
+ procedure Test;
+
+ procedure Test is
+ begin
+ null;
+ end Test;
+
+ procedure Test_Instance1 is new Test (T => Rec_Type); -- { dg-error "actual must implement all interfaces of formal \"T\"" }
+ procedure Test_Instance1 is new Test (T => Rec_Type1); -- { dg-error "Actual \"Rec_Type1\" must implement interface \"TI2\"" }
+ procedure Test_Instance2 is new Test (T => Rec_Type2);
+ procedure Test_Instance12 is new Test (T => Rec_Type12);
+
+begin
+ null;
+end Interface6;