mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-30 23:35:00 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Gary Dismukes 2023-10-31 19:50:46 +00:00 committed by Marc Poulhiès
parent 35510341fc
commit ea60a4cd19
4 changed files with 82 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gcc/ada/exp_ch5.adb
View File

@ -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;

23
gcc/ada/sem_ch5.adb
View File

@ -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;

34
gcc/ada/sem_util.adb
View File

@ -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 --
-------------------------

7
gcc/ada/sem_util.ads
View File

@ -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