This patch avoids incorrect compilation errors if a derived type has a
parent type for which the Iterable aspect is specified, and a "for
... of" loop is used on an object of the derived type.
The following test should compile quietly.
gcc -c seqs-main.adb
package Seqs is
type Container is null record
with Iterable =>
(First => First_Element,
Next => Next,
Has_Element => Has_Element,
Element => Get_Element);
type Cursor is new Integer;
type Element is new Boolean;
type Element_Access is access all Element;
function First_Element (Self : Container) return Cursor;
function Next (Self : Container; C : Cursor) return Cursor;
function Has_Element (Self : Container; C : Cursor) return Boolean;
function Get_Element (Self : Container; C : Cursor) return Element_Access;
type Derived is new Container;
end Seqs;
procedure Seqs.Main is
S : Derived;
begin
for X of S loop
null;
end loop;
end Seqs.Main;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-18 Bob Duff <[email protected]>
* exp_ch5.adb (Build_Formal_Container_Iteration,
Expand_Formal_Container_Element_Loop): Convert the container to the
root type before passing it to the iteration operations, so it will be
of the right type.
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 252907)
+++ exp_ch5.adb (working copy)
@@ -74,6 +74,12 @@
-- Utility to create declarations and loop statement for both forms
-- of formal container iterators.
+ function Convert_To_Iterable_Type
+ (Container : Entity_Id; Loc : Source_Ptr) return Node_Id;
+ -- Returns New_Occurrence_Of (Container), possibly converted to an
+ -- ancestor type, if the type of Container inherited the Iterable
+ -- aspect_specification from that ancestor.
+
function Change_Of_Representation (N : Node_Id) return Boolean;
-- Determine if the right-hand side of assignment N is a type conversion
-- which requires a change of representation. Called only for the array
@@ -189,7 +195,7 @@
Make_Function_Call (Loc,
Name => New_Occurrence_Of (First_Op, Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Container, Loc))));
+ Convert_To_Iterable_Type (Container, Loc))));
-- Statement that advances cursor in loop
@@ -200,7 +206,7 @@
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Next_Op, Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Container, Loc),
+ Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
-- Iterator is rewritten as a while_loop
@@ -211,13 +217,12 @@
Make_Iteration_Scheme (Loc,
Condition =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (Has_Element_Op, Loc),
+ Name => New_Occurrence_Of (Has_Element_Op, Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Container, Loc),
+ Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc)))),
- Statements => Stats,
- End_Label => Empty);
+ Statements => Stats,
+ End_Label => Empty);
end Build_Formal_Container_Iteration;
------------------------------
@@ -233,6 +238,26 @@
not Same_Representation (Etype (Rhs), Etype (Expression (Rhs)));
end Change_Of_Representation;
+ ------------------------------
+ -- Convert_To_Iterable_Type --
+ ------------------------------
+
+ function Convert_To_Iterable_Type
+ (Container : Entity_Id; Loc : Source_Ptr) return Node_Id
+ is
+ Typ : constant Entity_Id := Base_Type (Etype (Container));
+ Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
+ Result : Node_Id := New_Occurrence_Of (Container, Loc);
+ begin
+ if Entity (Aspect) /= Typ then
+ Result := Make_Type_Conversion (Loc,
+ Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
+ Expression => Result);
+ end if;
+
+ return Result;
+ end Convert_To_Iterable_Type;
+
-------------------------
-- Expand_Assign_Array --
-------------------------
@@ -3207,7 +3232,7 @@
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Element_Op, Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Container, Loc),
+ Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Set_Statements (New_Loop,
@@ -3226,7 +3251,7 @@
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Element_Op, Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Container, Loc),
+ Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Prepend (Elmt_Ref, Stats);
