diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 54 |
2 files changed, 58 insertions, 8 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0095f85..5cd546a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2018-05-25 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb (Instance_Exists): New function, subsidiary of + Validate_Derived_Type_Instance, to verify that all interfaces + implemented by the formal type are also implemented by the actual. The + verification is complicated when an interface of the formal is declared + in a generic unit and the actual is declared in an instance of it. + There is currently no mechanism to relate an interface declared within + a generic to the corresponding interface in an instance, so we must + traverse the list of interfaces of the actual, looking for a name + match, and verifying that that interface is declared in an instance. + 2018-05-25 Piotr Trojanek <trojanek@adacore.com> * sem_util.adb (Iterate_Call_Parameters): Rewrite with extra diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index bc7dd13..f97f083 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12362,9 +12362,6 @@ package body Sem_Ch12 is -- 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 @@ -12374,18 +12371,59 @@ package body Sem_Ch12 is else declare - Iface : Node_Id; - Iface_Ent : Entity_Id; + Iface : Node_Id; + Iface_Ent : Entity_Id; + Act_Iface_List : Elist_Id; + + function Instance_Exists (I : Entity_Id) return Boolean; + -- If the interface entity is declared in a generic unit, + -- this can only be legal if we are within an instantiation + -- of a child of that generic. There is currently no + -- mechanism to relate an interface declared within a + -- generic to the corresponding interface in an instance, + -- so we traverse the list of interfaces of the actual, + -- looking for a name match. + + --------------------- + -- Instance_Exists -- + --------------------- + + function Instance_Exists (I : Entity_Id) return Boolean is + Iface_Elmt : Elmt_Id; + + begin + Iface_Elmt := First_Elmt (Act_Iface_List); + while Present (Iface_Elmt) loop + if Is_Generic_Instance (Scope (Node (Iface_Elmt))) + and then Chars (Node (Iface_Elmt)) = Chars (I) + then + return True; + end if; + + Next_Elmt (Iface_Elmt); + end loop; + + return False; + end Instance_Exists; begin Iface := First (Abstract_Interface_List (A_Gen_T)); + Collect_Interfaces (Act_T, Act_Iface_List); 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 + + if Is_Ancestor (Iface_Ent, Act_T) + or else Is_Progenitor (Iface_Ent, Act_T) + then + null; + + elsif Ekind (Scope (Iface_Ent)) = E_Generic_Package + and then Instance_Exists (Iface_Ent) then + null; + + else Error_Msg_Name_1 := Chars (Act_T); Error_Msg_NE ("Actual% must implement interface&", |