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.

From-SVN: r208133

gcc/ada/ChangeLog

+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.
+
 2014-02-25  Robert Dewar  <dewar@adacore.com>
 
 	* sinfo.ads: Minor reformatting.

gcc/ada/einfo.ads

@@ -4074,9 +4074,9 @@ package Einfo is
 --       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 @@ package Einfo is
    --    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

gcc/ada/exp_ch5.adb

@@ -3264,7 +3264,7 @@ package body Exp_Ch5 is
                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

gcc/ada/exp_ch7.adb

@@ -3558,6 +3558,7 @@ package body Exp_Ch7 is
 
    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 @@ package body Exp_Ch7 is
 
             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 @@ package body Exp_Ch7 is
 
       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 @@ package body Exp_Ch7 is
       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);

gcc/ada/exp_util.adb

@@ -6383,9 +6383,12 @@ package body Exp_Util is
       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 @@ package body Exp_Util is
       -- 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 @@ package body Exp_Util is
               and then not Are_Wrapped (Statements (N))
               and then Requires_Cleanup_Actions (Statements (N), False, False)
             then
-               Block := Wrap_Statements_In_Block (Statements (N));
-               Set_Statements (N, New_List (Block));
+               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;
 

gcc/ada/sem_ch5.adb

@@ -2767,20 +2767,46 @@ package body Sem_Ch5 is
       --  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)))));
-
-         Analyze (N);
-         return;
+         declare
+            Block_Nod : Node_Id;
+            Block_Id  : Entity_Id;
+
+         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

gcc/ada/sem_util.adb

@@ -217,6 +217,33 @@ package body Sem_Util is
       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 @@ package body Sem_Util is
       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 --
    ------------------------------------

gcc/ada/sem_util.ads

@@ -43,6 +43,12 @@ package Sem_Util is
    --  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 @@ package Sem_Util is
    --  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