===================================================================
@@ -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.
===================================================================
@@ -2730,8 +2730,8 @@
-- Is_Interface (Flag186)
-- Defined in record types and subtypes. Set to indicate that the current
+-- 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
===================================================================
@@ -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);
===================================================================
@@ -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
===================================================================
@@ -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
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 <duff@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.