ada: Compiler error reporting illegal prefix on legal loop iterator with "in"

During semantic analysis, the compiler fails to determine the cursor type
in the case of a generalized iterator loop with "in", in the case where the
iterator type has a parent type that is a controlled type (for example) and
its ancestor iterator interface type is given after as a progenitor. It also
improperly determines the ancestor interface type during expansion (within
Expand_Iterator_Loop_Over_Container), for both "in" and "of" iterator forms.
The FE was assuming that the iterator interface is simply the parent type
of the iterator type, but that type can occur later in the interface list,
or be inherited. A new function is added that properly locates a type's
iterator interface ancestor, if any, and is called for analysis and expansion.

gcc/ada/

	* exp_ch5.adb (Expand_Iterator_Loop_Over_Container): Retrieve the
	iteration type's iteration interface progenitor via
	Iterator_Interface_Ancestor, in the case of both "in" and "of"
	iterators. Narrow the scope of Pack, so it's declared and
	initialized only within the code related to "of" iterators, and
	change its name to Cont_Type_Pack. Adjust comments.
	* sem_ch5.adb (Get_Cursor_Type): In the case of a derived type,
	retrieve the iteration type's iterator interface progenitor (if it
	exists) via Iterator_Interface_Ancestor rather than assuming that
	the parent type is the interface progenitor.
	* sem_util.ads (Iterator_Interface_Ancestor): New function.
	* sem_util.adb (Iterator_Interface_Ancestor): New function
	returning a type's associated iterator interface type, if any, by
	collecting and traversing the type's interfaces.

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index cd3b02b9360c4982a2e4573263ff54827159dcbc..d946f6dda5e175eccd8b6d4dfc57b987fc217738 100644 (file)
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -5158,9 +5158,6 @@ package body Exp_Ch5 is
       --  The package in which the iterator interface is instantiated. This is
       --  typically an instance within the container package.
 
-      Pack : Entity_Id;
-      --  The package in which the container type is declared
-
    begin
       if Present (Iterator_Filter (I_Spec)) then
          pragma Assert (Ada_Version >= Ada_2022);
@@ -5195,15 +5192,6 @@ package body Exp_Ch5 is
       --    package Vector_Iterator_Interfaces is new
       --      Ada.Iterator_Interfaces (Cursor, Has_Element);
 
-      --  If the container type is a derived type, the cursor type is found in
-      --  the package of the ultimate ancestor type.
-
-      if Is_Derived_Type (Container_Typ) then
-         Pack := Scope (Root_Type (Container_Typ));
-      else
-         Pack := Scope (Container_Typ);
-      end if;
-
       if Of_Present (I_Spec) then
          Handle_Of : declare
             Container_Arg : Node_Id;
@@ -5289,6 +5277,9 @@ package body Exp_Ch5 is
             Default_Iter : Entity_Id;
             Ent          : Entity_Id;
 
+            Cont_Type_Pack         : Entity_Id;
+            --  The package in which the container type is declared
+
             Reference_Control_Type : Entity_Id := Empty;
             Pseudo_Reference       : Entity_Id := Empty;
 
@@ -5312,11 +5303,14 @@ package body Exp_Ch5 is
 
             Iter_Type := Etype (Default_Iter);
 
-            --  The iterator type, which is a class-wide type, may itself be
-            --  derived locally, so the desired instantiation is the scope of
-            --  the root type of the iterator type.
+            --  If the container type is a derived type, the cursor type is
+            --  found in the package of the ultimate ancestor type.
 
-            Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
+            if Is_Derived_Type (Container_Typ) then
+               Cont_Type_Pack := Scope (Root_Type (Container_Typ));
+            else
+               Cont_Type_Pack := Scope (Container_Typ);
+            end if;
 
             --  Find declarations needed for "for ... of" optimization.
             --  These declarations come from GNAT sources or sources
@@ -5326,7 +5320,7 @@ package body Exp_Ch5 is
             --  Note that we use _Next or _Previous to avoid picking up
             --  some arbitrary user-defined Next or Previous.
 
-            Ent := First_Entity (Pack);
+            Ent := First_Entity (Cont_Type_Pack);
             while Present (Ent) loop
                --  Get_Element_Access function with one parameter called
                --  Position.
@@ -5400,6 +5394,11 @@ package body Exp_Ch5 is
 
             Analyze_And_Resolve (Name (I_Spec));
 
+            --  The desired instantiation is the scope of an iterator interface
+            --  type that is an ancestor of the iterator type.
+
+            Iter_Pack := Scope (Iterator_Interface_Ancestor (Iter_Type));
+
             --  Find cursor type in proper iterator package, which is an
             --  instantiation of Iterator_Interfaces.
 
@@ -5469,11 +5468,12 @@ package body Exp_Ch5 is
       else
          Iter_Type := Etype (Name (I_Spec));
 
-         --  The iterator type, which is a class-wide type, may itself be
-         --  derived locally, so the desired instantiation is the scope of
-         --  the root type of the iterator type, as in the "of" case.
+         --  The instantiation in which to locate the Has_Element function
+         --  is the scope containing an iterator interface type that is
+         --  an ancestor of the iterator type.
+
+         Iter_Pack := Scope (Iterator_Interface_Ancestor (Iter_Type));
 
-         Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
          Cursor := Id;
       end if;
 

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 72e7d186baa848fa7a6e318858d1e003651d195f..de38ddf4fa8e9f7e358029a76aff549f4d8da8d1 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2113,11 +2113,28 @@ package body Sem_Ch5 is
          Ent : Entity_Id;
 
       begin
-         --  If iterator type is derived, the cursor is declared in the scope
-         --  of the parent type.
+         --  If the iterator type is derived and it has an iterator interface
+         --  type as an ancestor, then the cursor type is declared in the scope
+         --  of that interface type.
 
          if Is_Derived_Type (Typ) then
-            Ent := First_Entity (Scope (Etype (Typ)));
+            declare
+               Iter_Iface : constant Entity_Id :=
+                              Iterator_Interface_Ancestor (Typ);
+
+            begin
+               if Present (Iter_Iface) then
+                  Ent := First_Entity (Scope (Iter_Iface));
+
+               --  If there's not an iterator interface, then retrieve the
+               --  scope associated with the parent type and start from its
+               --  first entity.
+
+               else
+                  Ent := First_Entity (Scope (Etype (Typ)));
+               end if;
+            end;
+
          else
             Ent := First_Entity (Scope (Typ));
          end if;

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index eb2d83a4d6d3171f99f4248a65311ece3221f19a..423b8d3f936d4221f94ef707e81f7a8f6b9a18a4 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -21496,6 +21496,40 @@ package body Sem_Util is
       pragma Assert (No (Actual));
    end Iterate_Call_Parameters;
 
+   --------------------------------
+   -- Iterate_Interface_Ancestor --
+   --------------------------------
+
+   function Iterator_Interface_Ancestor (Typ : Entity_Id) return Entity_Id is
+   begin
+      if Has_Interfaces (Typ) then
+         declare
+            Iface_Elmt : Elmt_Id;
+            Ifaces     : Elist_Id;
+            Root_Iface : Entity_Id;
+
+         begin
+            Collect_Interfaces (Typ, Ifaces);
+
+            Iface_Elmt := First_Elmt (Ifaces);
+            while Present (Iface_Elmt) loop
+               Root_Iface := Root_Type (Node (Iface_Elmt));
+
+               if Chars (Root_Iface)
+                    in Name_Forward_Iterator | Name_Reversible_Iterator
+                 and then In_Predefined_Unit (Root_Iface)
+               then
+                  return Root_Iface;
+               end if;
+
+               Next_Elmt (Iface_Elmt);
+            end loop;
+         end;
+      end if;
+
+      return Empty;
+   end Iterator_Interface_Ancestor;
+
    -------------------------
    -- Kill_Current_Values --
    -------------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index caf6a6624e4beed2462713a2888d7afd260762c6..96b4730f4af86be296d42933c8d12dff5f2d39d8 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2480,6 +2480,13 @@ package Sem_Util is
    --  Calls Handle_Parameter for each pair of formal and actual parameters of
    --  a function, procedure, or entry call.
 
+   function Iterator_Interface_Ancestor (Typ : Entity_Id) return Entity_Id;
+   --  If Typ has an ancestor that is an iterator interface type declared in
+   --  an instance of Ada.Iterator_Interfaces, then returns that interface
+   --  type. Otherwise returns Empty. (It's not clear what it means if there
+   --  is more than one such ancestor, perhaps coming from multiple instances,
+   --  but this function returns the first such ancestor it finds. ???)
+
    procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False);
    --  This procedure is called to clear all constant indications from all
    --  entities in the current scope and in any parent scopes if the current