This patch fixes a bug in which if a type implements interfaces, the Default_Iterator aspect is not inherited from all interfaces, but only from the parent type.
The following test should compile and run quietly. with Ada.Iterator_Interfaces; procedure Main is type Element_Type is null record; type Cursor is null record; function Has_Element (Position : in Cursor) return Boolean is (False); package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element); type Iterable_Base is limited interface with Default_Iterator => Iterate, Iterator_Element => Element_Type, Constant_Indexing => Element; type Iterator is new Iterators.Forward_Iterator with null record; function First (This : in Iterator) return Cursor is ((others => <>)); function Next (This : in Iterator; Position : in Cursor) return Cursor is (Position); function Iterate (This : in Iterable_Base'Class) return Iterators.Forward_Iterator'Class is (Iterator'(others => <>)); function Element (This : in Iterable_Base'Class; Position : in Cursor) return Element_Type is ((others => <>)); type IDummy is limited interface; type Iterator_First is new Iterable_Base and IDummy with null record; type Iterator_Last is new IDummy and Iterable_Base with null record; A : Iterator_First; B : Iterator_Last; begin for El of A loop null; end loop; for El of B loop null; end loop; end Main; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-08 Bob Duff <d...@adacore.com> * sem_ch3.adb (Build_Derived_Private_Type): Inherit representation items from interfaces that the derived type implements, not just from the parent type. * sem_util.ads, sem_util.adb (Abstract_Interface_List): Change this to return an empty list when there are no interfaces. * einfo.ads, sem_ch13.adb: Minor comment fixes.
Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 251863) +++ sem_ch3.adb (working copy) @@ -9576,9 +9576,18 @@ Set_Has_Predicates (Derived_Type); end if; - -- The derived type inherits the representation clauses of the parent + -- The derived type inherits representation clauses from the parent + -- type, and from any interfaces. Inherit_Rep_Item_Chain (Derived_Type, Parent_Type); + declare + Iface : Node_Id := First (Abstract_Interface_List (Derived_Type)); + begin + while Present (Iface) loop + Inherit_Rep_Item_Chain (Derived_Type, Entity (Iface)); + Next (Iface); + end loop; + end; -- If the parent type has delayed rep aspects, then mark the derived -- type as possibly inheriting a delayed rep aspect. Index: einfo.ads =================================================================== --- einfo.ads (revision 251863) +++ einfo.ads (working copy) @@ -2730,8 +2730,8 @@ -- Is_Interface (Flag186) -- Defined in record types and subtypes. Set to indicate that the current --- entity corresponds with an abstract interface. Because abstract --- interfaces are conceptually a special kind of abstract tagged types +-- entity corresponds to an abstract interface. Because abstract +-- interfaces are conceptually a special kind of abstract tagged type -- we represent them by means of tagged record types and subtypes -- marked with this attribute. This allows us to reuse most of the -- compiler support for abstract tagged types to implement interfaces Index: sem_util.adb =================================================================== --- sem_util.adb (revision 251869) +++ sem_util.adb (working copy) @@ -198,12 +198,17 @@ return Abstract_Interface_List (Etype (Typ)); - else pragma Assert ((Ekind (Typ)) = E_Record_Type); + elsif Ekind (Typ) = E_Record_Type then if Nkind (Parent (Typ)) = N_Formal_Type_Declaration then Nod := Formal_Type_Definition (Parent (Typ)); else Nod := Type_Definition (Parent (Typ)); end if; + + -- It's not the kind of type that can implement interfaces + + else + return Empty_List; end if; return Interface_List (Nod); Index: sem_util.ads =================================================================== --- sem_util.ads (revision 251868) +++ sem_util.ads (working copy) @@ -37,8 +37,9 @@ package Sem_Util is function Abstract_Interface_List (Typ : Entity_Id) return List_Id; - -- Given a type that implements interfaces look for its associated - -- definition node and return its list of interfaces. + -- The list of interfaces implemented by Typ. Empty if there are none, + -- including the cases where there can't be any because e.g. the type is + -- not tagged. procedure Add_Access_Type_To_Process (E : Entity_Id; A : Entity_Id); -- Add A to the list of access types to process when expanding the Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 251868) +++ sem_ch13.adb (working copy) @@ -3974,7 +3974,7 @@ procedure Check_Iterator_Functions; -- Check that there is a single function in Default_Iterator attribute - -- has the proper type structure. + -- that has the proper type structure. function Check_Primitive_Function (Subp : Entity_Id) return Boolean; -- Common legality check for the previous two