@@ -225,7 +225,10 @@ package body Aspects is
Owner := Root_Type (Owner);
end if;
- if Is_Private_Type (Owner) and then Present (Full_View (Owner)) then
+ if Is_Private_Type (Owner)
+ and then Present (Full_View (Owner))
+ and then not Operational_Aspect (A)
+ then
Owner := Full_View (Owner);
end if;
end if;
@@ -277,6 +277,20 @@ package Aspects is
Aspect_Warnings => True,
others => False);
+ -- The following array indicates aspects that specify operational
+ -- characteristics, and thus are view-specific. Representation
+ -- aspects break privacy, as they are needed during expansion and
+ -- code generation.
+ -- List is currently incomplete ???
+
+ Operational_Aspect : constant array (Aspect_Id) of Boolean :=
+ (Aspect_Constant_Indexing => True,
+ Aspect_Default_Iterator => True,
+ Aspect_Iterator_Element => True,
+ Aspect_Iterable => True,
+ Aspect_Variable_Indexing => True,
+ others => False);
+
-- The following array indicates aspects for which multiple occurrences of
-- the same aspect attached to the same declaration are allowed.
@@ -2234,8 +2234,17 @@ package body Sem_Ch5 is
It : Interp;
begin
+ -- THe domain of iteralion must implement either the RM
+ -- iterator interface, or the SPARK Iterable aspect.
+
if No (Iterator) then
- null; -- error reported below
+ if No
+ (Find_Aspect (Etype (Iter_Name), Aspect_Iterable))
+ then
+ Error_Msg_NE ("cannot iterate over&",
+ N, Base_Type (Etype (Iter_Name)));
+ return;
+ end if;
elsif not Is_Overloaded (Iterator) then
Check_Reverse_Iteration (Etype (Iterator));
@@ -4,7 +4,7 @@ with Iter5_Pkg;
procedure Iter5 is
begin
- for The_Filename of Iter5_Pkg.Iterator_For ("C:\Program_Files") loop
+ for The_Filename of Iter5_Pkg.Iterator_For ("C:\Program_Files") loop -- { dg-error "cannot iterate over \"Item\"" }
null;
end loop;
end Iter5;
new file mode 100644
@@ -0,0 +1,40 @@
+-- { dg-do compile }
+
+with Ada.Iterator_Interfaces;
+
+procedure Iter6 is
+ package Pkg is
+ type Item (<>) is limited private;
+ private
+
+ type Cursor is null record;
+
+ function Constant_Reference (The_Item : aliased Item;
+ Unused_Index : Cursor) return String
+ is ("");
+
+ function Has_More (Data : Cursor) return Boolean is (False);
+
+ package List_Iterator_Interfaces is new Ada.Iterator_Interfaces
+ (Cursor, Has_More);
+
+ function Iterate (The_Item : Item)
+ return List_Iterator_Interfaces.Forward_Iterator'class
+ is (raise Program_Error);
+
+ type Item (Name_Length : Natural) is tagged limited record
+ null;
+ end record
+ with
+ Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => String;
+ end Pkg; use Pkg;
+
+ type Item_Ref is access Item;
+ function F return Item_Ref is (null);
+begin
+ for I of F.all loop -- { dg-error "cannot iterate over \"Item\"" }
+ null;
+ end loop;
+end;