===================================================================
@@ -2770,14 +2770,13 @@
I_Spec : constant Node_Id := Iterator_Specification (Isc);
Id : constant Entity_Id := Defining_Identifier (I_Spec);
Loc : constant Source_Ptr := Sloc (N);
- Stats : constant List_Id := Statements (N);
Container : constant Node_Id := Name (I_Spec);
Container_Typ : constant Entity_Id := Etype (Container);
+ Cursor : Entity_Id;
+ New_Loop : Node_Id;
+ Stats : List_Id := Statements (N);
- Cursor : Entity_Id;
- New_Loop : Node_Id;
-
begin
-- Processing for arrays
@@ -2839,25 +2838,32 @@
-- Processing for containers
else
- -- In both cases these require a cursor of the proper type
+ -- The for loop is expanded into a while loop which uses a container
+ -- specific cursor to examine each element.
-- Cursor : Pack.Cursor := Container.First;
-- while Cursor /= Pack.No_Element loop
- -- Obj : Pack.Element_Type renames Element (Cursor);
- -- -- for the "of" form
+ -- declare
+ -- -- the block is added when Element_Type is controlled
- -- <original loop statements>
+ -- Obj : Pack.Element_Type := Element (Cursor);
+ -- -- for the "of" loop form
+ -- begin
+ -- <original loop statements>
+ -- end;
-- Pack.Next (Cursor);
-- end loop;
- -- with the obvious replacements if "reverse" is specified. Pack is
- -- the name of the package which instantiates the container.
+ -- If "reverse" is present, then the initialization of the cursor
+ -- uses Last and the step becomes Prev. Pack is the name of the
+ -- package which instantiates the container.
declare
Element_Type : constant Entity_Id := Etype (Id);
Pack : constant Entity_Id :=
Scope (Base_Type (Container_Typ));
+ Decl : Node_Id;
Cntr : Node_Id;
Name_Init : Name_Id;
Name_Step : Name_Id;
@@ -2873,26 +2879,52 @@
-- The code below only handles containers where Element is not a
-- primitive operation of the container. This excludes for now the
- -- Hi-Lite formal containers. Generate:
- --
- -- Id : Element_Type renames Container.Element (Cursor);
+ -- Hi-Lite formal containers.
if Of_Present (I_Spec) then
- Prepend_To (Stats,
+
+ -- Generate:
+ -- Id : Element_Type := Pack.Element (Cursor);
+
+ Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
Subtype_Mark =>
- New_Occurrence_Of (Element_Type, Loc),
+ New_Reference_To (Element_Type, Loc),
Name =>
Make_Indexed_Component (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
- New_Occurrence_Of (Pack, Loc),
+ New_Reference_To (Pack, Loc),
Selector_Name =>
Make_Identifier (Loc, Chars => Name_Element)),
Expressions => New_List (
- New_Occurrence_Of (Cursor, Loc)))));
+ New_Reference_To (Cursor, Loc))));
+
+ -- When the container holds controlled objects, wrap the loop
+ -- statements and element renaming declaration with a block.
+ -- This ensures that the transient result of Element (Cursor)
+ -- is cleaned up after each iteration of the loop.
+
+ if Needs_Finalization (Element_Type) then
+
+ -- Generate:
+ -- declare
+ -- Id : Element_Type := Pack.Element (Cursor);
+ -- begin
+ -- <original loop statments>
+ -- end;
+
+ Stats := New_List (
+ Make_Block_Statement (Loc,
+ Declarations => New_List (Decl),
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Stats)));
+ else
+ Prepend_To (Stats, Decl);
+ end if;
end if;
-- Determine the advancement and initialization steps for the
@@ -2918,12 +2950,12 @@
Name =>
Make_Selected_Component (Loc,
Prefix =>
- New_Occurrence_Of (Pack, Loc),
+ New_Reference_To (Pack, Loc),
Selector_Name =>
Make_Identifier (Loc, Name_Step)),
Parameter_Associations => New_List (
- New_Occurrence_Of (Cursor, Loc))));
+ New_Reference_To (Cursor, Loc))));
-- Generate:
-- while Cursor /= Pack.No_Element loop
@@ -2937,11 +2969,11 @@
Condition =>
Make_Op_Ne (Loc,
Left_Opnd =>
- New_Occurrence_Of (Cursor, Loc),
+ New_Reference_To (Cursor, Loc),
Right_Opnd =>
Make_Selected_Component (Loc,
Prefix =>
- New_Occurrence_Of (Pack, Loc),
+ New_Reference_To (Pack, Loc),
Selector_Name =>
Make_Identifier (Loc, Name_No_Element)))),
Statements => Stats,
@@ -2985,7 +3017,7 @@
Object_Definition =>
Make_Selected_Component (Loc,
Prefix =>
- New_Occurrence_Of (Pack, Loc),
+ New_Reference_To (Pack, Loc),
Selector_Name =>
Make_Identifier (Loc, Name_Cursor)),
This patch adds code to ensure the timely finalization of a local element copy when iterating over a container. ------------ -- Source -- ------------ -- types.ads with Ada.Containers.Doubly_Linked_Lists; package Types is package Lists is new Ada.Containers.Doubly_Linked_Lists (Integer); use Lists; function Get_List (L : List) return List; procedure Print_List (L : List); procedure Zero_List (L : in out List) with Post => (for all Index in Get_List (L) => Element (Index) = 0); end Types; -- types.adb with Ada.Text_IO; use Ada.Text_IO; package body Types is function Get_List (L : List) return List is begin return L; end Get_List; procedure Print_List (L : List) is begin for Element of Get_List (L) loop Put_Line (Integer'Image (Element)); end loop; end Print_List; procedure Zero_List (L : in out List) is Result : Lists.List; begin for I of L loop Put_Line (Integer'Image (I)); end loop; Result.Append (0); L := Result; end Zero_List; end Types; -- main.adb with Types; use Types; procedure Main is L : Lists.List; begin L.Append (111); L.Append (1234); L.Append (-9999); Zero_List (L); Print_List (L); end Main; ----------------- -- Compilation -- ----------------- gnatmake -q -gnat12 -gnata main.adb --------------------- -- Expected output -- --------------------- 111 1234 -9999 0 Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-02 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch5.adb (Expand_Iterator_Loop): Reformatting. Wrap the original loop statements and the element renaming declaration with a block when the element type is controlled.