[COMMITTED] ada: Compiler error reporting illegal prefix on legal loop iterator with "in"
Checks
Commit Message
From: Gary Dismukes <dismukes@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch5.adb | 42 +++++++++++++++++++++---------------------
gcc/ada/sem_ch5.adb | 23 ++++++++++++++++++++---
gcc/ada/sem_util.adb | 34 ++++++++++++++++++++++++++++++++++
gcc/ada/sem_util.ads | 7 +++++++
4 files changed, 82 insertions(+), 24 deletions(-)
@@ -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;
@@ -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;
@@ -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 --
-------------------------
@@ -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