[Ada] Memory leak with Ada 2012 iterator loop

Arnaud Charlet charlet@adacore.com
Tue Feb 25 15:04:00 GMT 2014


This patch plugs several memory leaks involving Ada 2012 iterator loops by
properly managing the secondary stack at each iteration of the loop.

------------
-- Source --
------------

--  iterator_leak.adb

with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;
with Ada.Text_IO;    use Ada.Text_IO;

procedure Iterator_Leak is
   type Rec is record
      Comp : Integer := 0;
   end record;

   package Vecs is new Vectors (Element_Type => Rec, Index_Type => Positive);

   V1_Size : constant Integer := 1_000;
   V2_Size : constant Integer := 1_000;
   Total   : Integer := 1;
   V1      : Vecs.Vector;
   V2      : Vecs.Vector;

begin
   Vecs.Set_Length (V1, Count_Type (V1_Size));
   Vecs.Set_length (V2, Count_Type (V2_Size));

   for Elem1 of V1 loop
      for Elem2 of V2 loop
         if Elem1 = Elem2 then
            Total := Total + 1;
         end if;
      end loop;
   end loop;

   for Index1 in 1 .. V1_Size loop
      for Index2 in 1 .. V2_Size loop
         declare
            Elem1 : constant Rec := V1 (Index1);
            Elem2 : constant Rec := V2 (Index2);

         begin
            if Elem1 = Elem2 then
               Total := Total + 1;
            end if;
         end;
      end loop;
   end loop;

   for Cur1 in Vecs.Iterate (V1) loop
      for Cur2 in Vecs.Iterate (V2) loop
         if V1 (Cur1) = V2 (Cur2) then
            Total := Total + 1;
         end if;
      end loop;
   end loop;
end Iterator_Leak;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q iterator_leak.adb -largs -lgmem
$ ./iterator_leak
$ gnatmem iterator_leak > output.txt
$ grep "Total number" output.txt
   Total number of allocations        :   2
   Total number of deallocations      :   2

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-02-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.ads Update the usage of flag
	Uses_Sec_Stack. Uses_Sec_Stack now applies to E_Loop entities.
	* exp_ch5.adb (Expand_Iterator_Loop): The temporary for a cursor
	now starts with the letter 'C'. This makes reading expanded
	code easier.
	* exp_ch7.adb (Establish_Transient_Scope): Add local variable
	Iter_Loop. Signal that an Ada 2012 iterator loop requires
	secondary stack management when creating a transient scope for
	an element reference.
	* exp_util.adb (Process_Statements_For_Controlled_Objects):
	When wrapping the statements of a loop, pass the E_Loop entity
	to the wrapping machinery.
	(Wrap_Statements_In_Block): Add
	formal parameter Scop along with comment on usage. Add local
	variables Block_Id, Block_Nod and Iter_Loop. Mark the generated
	block as requiring secondary stack management when the block is
	created inside an Ada 2012 iterator loop. This ensures that any
	reference objects are reclaimed on each iteration of the loop.
	* sem_ch5.adb (Analyze_Loop_Statement): Mark the generated block
	tasked with the handling of container iterators as requiring
	secondary stack management. This ensures that iterators are
	reclaimed when the loop terminates or is exited in any fashion.
	* sem_util.adb (Add_Block_Identifier): New routine.
	(Find_Enclosing_Iterator_Loop): New routine.
	* sem_util.ads (Add_Block_Identifier): New routine.
	(Find_Enclosing_Iterator_Loop): New routine.

-------------- next part --------------
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb	(revision 208132)
+++ exp_ch5.adb	(revision 208133)
@@ -3264,7 +3264,7 @@
                Ent           : Entity_Id;
 
             begin
-               Cursor := Make_Temporary (Loc, 'I');
+               Cursor := Make_Temporary (Loc, 'C');
 
                --  For an container element iterator, the iterator type
                --  is obtained from the corresponding aspect, whose return
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 208132)
+++ exp_ch7.adb	(revision 208133)
@@ -3558,6 +3558,7 @@
 
    procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is
       Loc       : constant Source_Ptr := Sloc (N);
+      Iter_Loop : Entity_Id;
       Wrap_Node : Node_Id;
 
    begin
@@ -3571,8 +3572,8 @@
 
             return;
 
-         --  If we have encountered Standard there are no enclosing
-         --  transient scopes.
+         --  If we have encountered Standard there are no enclosing transient
+         --  scopes.
 
          elsif Scope_Stack.Table (S).Entity = Standard_Standard then
             exit;
@@ -3581,17 +3582,17 @@
 
       Wrap_Node := Find_Node_To_Be_Wrapped (N);
 
-      --  Case of no wrap node, false alert, no transient scope needed
+      --  The context does not contain a node that requires a transient scope,
+      --  nothing to do.
 
       if No (Wrap_Node) then
          null;
 
-      --  If the node to wrap is an iteration_scheme, the expression is
-      --  one of the bounds, and the expansion will make an explicit
-      --  declaration for it (see Analyze_Iteration_Scheme, sem_ch5.adb),
-      --  so do not apply any transformations here. Same for an Ada 2012
-      --  iterator specification, where a block is created for the expression
-      --  that build the container.
+      --  If the node to wrap is an iteration_scheme, the expression is one of
+      --  the bounds, and the expansion will make an explicit declaration for
+      --  it (see Analyze_Iteration_Scheme, sem_ch5.adb), so do not apply any
+      --  transformations here. Same for an Ada 2012 iterator specification,
+      --  where a block is created for the expression that build the container.
 
       elsif Nkind_In (Wrap_Node, N_Iteration_Scheme,
                                  N_Iterator_Specification)
@@ -3608,13 +3609,51 @@
       then
          null;
 
+      --  Create a block entity to act as a transient scope. Note that when the
+      --  node to be wrapped is an expression or a statement, a real physical
+      --  block is constructed (see routines Wrap_Transient_Expression and
+      --  Wrap_Transient_Statement) and inserted into the tree.
+
       else
          Push_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));
          Set_Scope_Is_Transient;
 
+         --  The transient scope must also take care of the secondary stack
+         --  management.
+
          if Sec_Stack then
             Set_Uses_Sec_Stack (Current_Scope);
             Check_Restriction (No_Secondary_Stack, N);
+
+            --  The expansion of iterator loops generates references to objects
+            --  in order to extract elements from a container:
+
+            --    Ref : Reference_Type_Ptr := Reference (Container, Cursor);
+            --    Obj : <object type> renames Ref.all.Element.all;
+
+            --  These references are controlled and returned on the secondary
+            --  stack. A new reference is created at each iteration of the loop
+            --  and as a result it must be finalized and the space occupied by
+            --  it on the secondary stack reclaimed at the end of the current
+            --  iteration.
+
+            --  When the context that requires a transient scope is a call to
+            --  routine Reference, the node to be wrapped is the source object:
+
+            --    for Obj of Container loop
+
+            --  Routine Wrap_Transient_Declaration however does not generate a
+            --  physical block as wrapping a declaration will kill it too ealy.
+            --  To handle this peculiar case, mark the related iterator loop as
+            --  requiring the secondary stack. This signals the finalization
+            --  machinery to manage the secondary stack (see routine
+            --  Process_Statements_For_Controlled_Objects).
+
+            Iter_Loop := Find_Enclosing_Iterator_Loop (Current_Scope);
+
+            if Present (Iter_Loop) then
+               Set_Uses_Sec_Stack (Iter_Loop);
+            end if;
          end if;
 
          Set_Etype (Current_Scope, Standard_Void_Type);
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb	(revision 208132)
+++ sem_ch5.adb	(revision 208133)
@@ -2767,20 +2767,46 @@
       --  Iteration over a container in Ada 2012 involves the creation of a
       --  controlled iterator object. Wrap the loop in a block to ensure the
       --  timely finalization of the iterator and release of container locks.
+      --  The same applies to the use of secondary stack when obtaining an
+      --  iterator.
 
       if Ada_Version >= Ada_2012
         and then Is_Container_Iterator (Iter)
         and then not Is_Wrapped_In_Block (N)
       then
-         Rewrite (N,
-           Make_Block_Statement (Loc,
-             Declarations               => New_List,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => New_List (Relocate_Node (N)))));
+         declare
+            Block_Nod : Node_Id;
+            Block_Id  : Entity_Id;
 
-         Analyze (N);
-         return;
+         begin
+            Block_Nod :=
+              Make_Block_Statement (Loc,
+                Declarations               => New_List,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => New_List (Relocate_Node (N))));
+
+            Add_Block_Identifier (Block_Nod, Block_Id);
+
+            --  The expansion of iterator loops generates an iterator in order
+            --  to traverse the elements of a container:
+
+            --    Iter : <iterator type> := Iterate (Container)'reference;
+
+            --  The iterator is controlled and returned on the secondary stack.
+            --  The analysis of the call to Iterate establishes a transient
+            --  scope to deal with the secondary stack management, but never
+            --  really creates a physical block as this would kill the iterator
+            --  too early (see Wrap_Transient_Declaration). To address this
+            --  case, mark the generated block as needing secondary stack
+            --  management.
+
+            Set_Uses_Sec_Stack (Block_Id);
+
+            Rewrite (N, Block_Nod);
+            Analyze (N);
+            return;
+         end;
       end if;
 
       --  Kill current values on entry to loop, since statements in the body of
Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 208132)
+++ exp_util.adb	(revision 208133)
@@ -6383,9 +6383,12 @@
       function Are_Wrapped (L : List_Id) return Boolean;
       --  Determine whether list L contains only one statement which is a block
 
-      function Wrap_Statements_In_Block (L : List_Id) return Node_Id;
+      function Wrap_Statements_In_Block
+        (L    : List_Id;
+         Scop : Entity_Id := Current_Scope) return Node_Id;
       --  Given a list of statements L, wrap it in a block statement and return
-      --  the generated node.
+      --  the generated node. Scop is either the current scope or the scope of
+      --  the context (if applicable).
 
       -----------------
       -- Are_Wrapped --
@@ -6404,14 +6407,39 @@
       -- Wrap_Statements_In_Block --
       ------------------------------
 
-      function Wrap_Statements_In_Block (L : List_Id) return Node_Id is
+      function Wrap_Statements_In_Block
+        (L    : List_Id;
+         Scop : Entity_Id := Current_Scope) return Node_Id
+      is
+         Block_Id  : Entity_Id;
+         Block_Nod : Node_Id;
+         Iter_Loop : Entity_Id;
+
       begin
-         return
+         Block_Nod :=
            Make_Block_Statement (Loc,
-             Declarations => No_List,
+             Declarations               => No_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => L));
+
+         --  Create a label for the block in case the block needs to manage the
+         --  secondary stack. A label allows for flag Uses_Sec_Stack to be set.
+
+         Add_Block_Identifier (Block_Nod, Block_Id);
+
+         --  When wrapping the statements of an iterator loop, check whether
+         --  the loop requires secondary stack management and if so, propagate
+         --  the flag to the block. This way the secondary stack is marked and
+         --  released at each iteration of the loop.
+
+         Iter_Loop := Find_Enclosing_Iterator_Loop (Scop);
+
+         if Present (Iter_Loop) and then Uses_Sec_Stack (Iter_Loop) then
+            Set_Uses_Sec_Stack (Block_Id);
+         end if;
+
+         return Block_Nod;
       end Wrap_Statements_In_Block;
 
       --  Local variables
@@ -6475,9 +6503,18 @@
               and then not Are_Wrapped (Statements (N))
               and then Requires_Cleanup_Actions (Statements (N), False, False)
             then
-               Block := Wrap_Statements_In_Block (Statements (N));
+               if Nkind (N) = N_Loop_Statement
+                 and then Present (Identifier (N))
+               then
+                  Block :=
+                    Wrap_Statements_In_Block
+                      (L    => Statements (N),
+                       Scop => Entity (Identifier (N)));
+               else
+                  Block := Wrap_Statements_In_Block (Statements (N));
+               end if;
+
                Set_Statements (N, New_List (Block));
-
                Analyze (Block);
             end if;
 
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 208132)
+++ einfo.ads	(revision 208133)
@@ -4074,9 +4074,9 @@
 --       Protection object (see System.Tasking.Protected_Objects).
 
 --    Uses_Sec_Stack (Flag95)
---       Defined in scope entities (blocks,functions, procedures, tasks,
---       entries). Set to True when secondary stack is used in this scope and
---       must be released on exit unless Sec_Stack_Needed_For_Return is set.
+--       Defined in scope entities (block, entry, function, loop, procedure,
+--       task). Set to True when secondary stack is used in this scope and must
+--       be released on exit unless Sec_Stack_Needed_For_Return is set.
 
 --    Warnings_Off (Flag96)
 --       Defined in all entities. Set if a pragma Warnings (Off, entity-name)
@@ -5633,6 +5633,7 @@
    --    Has_Loop_Entry_Attributes           (Flag260)
    --    Has_Master_Entity                   (Flag21)
    --    Has_Nested_Block_With_Handler       (Flag101)
+   --    Uses_Sec_Stack                      (Flag95)
 
    --  E_Modular_Integer_Type
    --  E_Modular_Integer_Subtype
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 208132)
+++ sem_util.adb	(revision 208133)
@@ -217,6 +217,33 @@
       Append_Elmt (A, L);
    end Add_Access_Type_To_Process;
 
+   --------------------------
+   -- Add_Block_Identifier --
+   --------------------------
+
+   procedure Add_Block_Identifier (N : Node_Id; Id : out Entity_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+   begin
+      pragma Assert (Nkind (N) = N_Block_Statement);
+
+      --  The block already has a label, return its entity
+
+      if Present (Identifier (N)) then
+         Id := Entity (Identifier (N));
+
+      --  Create a new block label and set its attributes
+
+      else
+         Id := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
+         Set_Etype  (Id, Standard_Void_Type);
+         Set_Parent (Id, N);
+
+         Set_Identifier (N, New_Occurrence_Of (Id, Loc));
+         Set_Block_Node (Id, Identifier (N));
+      end if;
+   end Add_Block_Identifier;
+
    -----------------------
    -- Add_Contract_Item --
    -----------------------
@@ -5592,6 +5619,40 @@
       raise Program_Error;
    end Find_Corresponding_Discriminant;
 
+   ----------------------------------
+   -- Find_Enclosing_Iterator_Loop --
+   ----------------------------------
+
+   function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id is
+      Constr : Node_Id;
+      S      : Entity_Id;
+
+   begin
+      --  Traverse the scope chain looking for an iterator loop. Such loops are
+      --  usually transformed into blocks, hence the use of Original_Node.
+
+      S := Id;
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind (S) = E_Loop
+           and then Nkind (Parent (S)) = N_Implicit_Label_Declaration
+         then
+            Constr := Original_Node (Label_Construct (Parent (S)));
+
+            if Nkind (Constr) = N_Loop_Statement
+              and then Present (Iteration_Scheme (Constr))
+              and then Nkind (Iterator_Specification (Iteration_Scheme
+                         (Constr))) = N_Iterator_Specification
+            then
+               return S;
+            end if;
+         end if;
+
+         S := Scope (S);
+      end loop;
+
+      return Empty;
+   end Find_Enclosing_Iterator_Loop;
+
    ------------------------------------
    -- Find_Loop_In_Conditional_Block --
    ------------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 208132)
+++ sem_util.ads	(revision 208133)
@@ -43,6 +43,12 @@
    --  Add A to the list of access types to process when expanding the
    --  freeze node of E.
 
+   procedure Add_Block_Identifier (N : Node_Id; Id : out Entity_Id);
+   --  Given a block statement N, generate an internal E_Block label and make
+   --  it the identifier of the block. Id denotes the generated entity. If the
+   --  block already has an identifier, Id denotes the entity of the existing
+   --  label.
+
    procedure Add_Contract_Item (Prag : Node_Id; Id : Entity_Id);
    --  Add pragma Prag to the contract of an entry, a package [body], a
    --  subprogram [body] or variable denoted by Id. The following are valid
@@ -569,6 +575,11 @@
    --  analyzed. Subsequent uses of this id on a different type denotes the
    --  discriminant at the same position in this new type.
 
+   function Find_Enclosing_Iterator_Loop (Id : Entity_Id) return Entity_Id;
+   --  Given an arbitrary entity, try to find the nearest enclosing iterator
+   --  loop. If such a loop is found, return the entity of its identifier (the
+   --  E_Loop scope), otherwise return Empty.
+
    function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id;
    --  Find the nested loop statement in a conditional block. Loops subject to
    --  attribute 'Loop_Entry are transformed into blocks. Parts of the original


More information about the Gcc-patches mailing list