[Ada] Iterators are view-specific

Operational aspects, such as Default_Iterator, are view-specific, and if
such an aspect appears on the full view of a private type, an object of
the type cannot be iterated upon if it is not in the scope of the full
view, This patch diagnoses properly an attempt to iterate over such an
object.

2019-07-23  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* aspects.ads: New table Operational_Aspect, used to distinguish
	between aspects that are view-specific, such as those related to
	iterators, and representation aspects that apply to all views of
	a type.
	* aspects.adb (Find_Aspect): If the aspect being sought is
	operational, do not ecamine the full view of a private type to
	retrieve it.
	* sem_ch5.adb (Analyze_Iterator_Specification): Improve error
	message when the intended domain of iteration does not implement
	the required iterator aspects.

gcc/testsuite/

	* gnat.dg/iter5.adb: Add an expected error.
	* gnat.dg/iter6.adb: New testcase.

From-SVN: r273722

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 748f1bfd681938e5db6a2de40ce859c379eda0b6..a40a774f0d610073705ef281d552fb336edb3f68 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2019-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * aspects.ads: New table Operational_Aspect, used to distinguish
+       between aspects that are view-specific, such as those related to
+       iterators, and representation aspects that apply to all views of
+       a type.
+       * aspects.adb (Find_Aspect): If the aspect being sought is
+       operational, do not ecamine the full view of a private type to
+       retrieve it.
+       * sem_ch5.adb (Analyze_Iterator_Specification): Improve error
+       message when the intended domain of iteration does not implement
+       the required iterator aspects.
+
 2019-07-23  Yannick Moy  <moy@adacore.com>
 
        * sem_spark.ads (Is_Local_Context): New function.

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 76fa6c828d3979331f4f46ae54ec628df2a9b555..54c0e566ab00bbb9219c53ff67f0933ebc251023 100644 (file)
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -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;

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 9190a6357122a5201643407a9a9e508faae068e0..2a6acc297a37e0a9cb5e5d45a02113c1c44b81c1 100644 (file)
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -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.
 

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b77bd7e77685223bf0cc2492c2e7b763e370e73d..ebe610b88e834a7352a5d273345605cb634c84f4 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -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));

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0ef05ddfa7344855794a160dec370c9fa83dafae..03cf4bb52ddf0f67e48f37d38da7e9a170840632 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-23  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/iter5.adb: Add an expected error.
+       * gnat.dg/iter6.adb: New testcase.
+
 2019-07-23  Yannick Moy  <moy@adacore.com>
 
        * gnat.dg/ghost6.adb, gnat.dg/ghost6_pkg.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/iter5.adb b/gcc/testsuite/gnat.dg/iter5.adb
index b17b43517c4fc06dd5191c9361909daf85847ed1..fa21715d73dcefec43297cab8cbab9082a719bba 100644 (file)
--- a/gcc/testsuite/gnat.dg/iter5.adb
+++ b/gcc/testsuite/gnat.dg/iter5.adb
@@ -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;

diff --git a/gcc/testsuite/gnat.dg/iter6.adb b/gcc/testsuite/gnat.dg/iter6.adb
new file mode 100644 (file)
index 0000000..371352b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iter6.adb
@@ -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;