[Ada] Spurious dependency on secondary stack

This patch reimplements the handling of the secondary stack when the
iteration scheme of a loop statement requires this support.

Prior to this modification, an iterator loop over a container was
assumed to require unconditional secondary stack management. This is
however not always true because of user-defined iterator types, where
routines First and Next return an iterator that does require the
secondary stack.

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

--  gnat.adc

pragma Restrictions (No_Secondary_Stack);

--  test.ads

package Test is
   type Test_Type is private
   with
      Default_Initial_Condition,
      Iterable => (First       => First_Element,
                   Next        => Next_Element,
                   Has_Element => Has_Element,
                   Element     => Element);

   type Cursor_Type is private;

   function First_Element (T : Test_Type) return Cursor_Type;

   function Next_Element (T : Test_Type; C : Cursor_Type) return Cursor_Type;

   function Has_Element (T : Test_Type; C : Cursor_Type) return Boolean;

   function Element (T : Test_Type; C : Cursor_Type) return Natural;

private
   type Cursor_Type is new Natural;

   type Test_Type is record
      null;
   end record;

   function First_Element (T : Test_Type) return Cursor_Type
   is (0);

   function Next_Element (T : Test_Type; C : Cursor_Type) return Cursor_Type
   is (0);

   function Has_Element (T : Test_Type; C : Cursor_Type) return Boolean
   is (False);

   function Element (T : Test_Type; C : Cursor_Type) return Natural
   is (0);
end Test;

--  main.adb

with Test; use Test;

procedure Main is
   F : Boolean;
   M : Test_Type;

begin
   for Elem of M loop
      null;
   end loop;

   F := (for all C of M => C = 1);
   F := (for all C in M => True);
end Main;

-----------------
-- Compilation --
-----------------

$ gnatmake -q --RTS=zfp -nostdlib main.adb

2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Allocator): Ensure that the use of the
	secondary stack does not clash with restriction
	No_Secondary_Stack.
	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Ensure that
	the use of the secondary stack does not clash with restriction
	No_Secondary_Stack.
	* sem_ch5.adb (Analyze_Loop_Statement): Wrap the loop in a block
	prior to analysis in order to either provide a local scope for
	an iterator, or ensure that the secondary stack is properly
	managed.
	(Check_Call): Account for the case where the tree may be
	unanalyzed or contain prior errors.
	(Has_Call_Using_Secondary_Stack): Renamed to Has_Sec_Stack_Call.
	Update all uses of the subprogram.
	(Prepare_Loop_Statement): New routine.

From-SVN: r264625

4 files changed, 362 insertions, 195 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5996edc..d549a87 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Allocator): Ensure that the use of the
+	secondary stack does not clash with restriction
+	No_Secondary_Stack.
+	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Ensure that
+	the use of the secondary stack does not clash with restriction
+	No_Secondary_Stack.
+	* sem_ch5.adb (Analyze_Loop_Statement): Wrap the loop in a block
+	prior to analysis in order to either provide a local scope for
+	an iterator, or ensure that the secondary stack is properly
+	managed.
+	(Check_Call): Account for the case where the tree may be
+	unanalyzed or contain prior errors.
+	(Has_Call_Using_Secondary_Stack): Renamed to Has_Sec_Stack_Call.
+	Update all uses of the subprogram.
+	(Prepare_Loop_Statement): New routine.
+
 2018-09-26  Javier Miranda  <miranda@adacore.com>
 
 	* sem_res.adb (Resolve_Actuals): If the formal is a class-wide
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index b08cf37..09a6cd0 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4417,6 +4417,7 @@ package body Exp_Ch4 is
             Set_Storage_Pool (N, Pool);
 
             if Is_RTE (Pool, RE_SS_Pool) then
+               Check_Restriction (No_Secondary_Stack, N);
                Set_Procedure_To_Call (N, RTE (RE_SS_Allocate));
 
             --  In the case of an allocator for a simple storage pool, locate
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e08b748..96ee696 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5267,8 +5267,9 @@ package body Exp_Ch6 is
                         Set_Comes_From_Source (Pool_Allocator, True);
                      end if;
 
-                     --  The allocator is returned on the secondary stack.
+                     --  The allocator is returned on the secondary stack
 
+                     Check_Restriction (No_Secondary_Stack, N);
                      Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool));
                      Set_Procedure_To_Call
                        (SS_Allocator, RTE (RE_SS_Allocate));
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 95b5660..8c1f949 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -83,7 +83,7 @@ package body Sem_Ch5 is
    --  messages. This variable is recursively saved on entry to processing the
    --  construct, and restored on exit.
 
-   function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean;
+   function Has_Sec_Stack_Call (N : Node_Id) return Boolean;
    --  N is the node for an arbitrary construct. This function searches the
    --  construct N to see if any expressions within it contain function
    --  calls that use the secondary stack, returning True if any such call
@@ -2850,7 +2850,7 @@ package body Sem_Ch5 is
             --  proper trace of the value, useful in optimizations that get rid
             --  of junk range checks.
 
-            if not Has_Call_Using_Secondary_Stack (Analyzed_Bound) then
+            if not Has_Sec_Stack_Call (Analyzed_Bound) then
                Analyze_And_Resolve (Original_Bound, Typ);
 
                --  Ensure that the bound is valid. This check should not be
@@ -3360,18 +3360,23 @@ package body Sem_Ch5 is
 
    procedure Analyze_Loop_Statement (N : Node_Id) is
 
+      --  The following exception is raised by routine Prepare_Loop_Statement
+      --  to avoid further analysis of a transformed loop.
+
+      Skip_Analysis : exception;
+
       function Disable_Constant (N : Node_Id) return Traverse_Result;
       --  If N represents an E_Variable entity, set Is_True_Constant To False
 
-      function Is_Container_Iterator (Iter : Node_Id) return Boolean;
-      --  Given a loop iteration scheme, determine whether it is an Ada 2012
-      --  container iteration.
+      procedure Disable_Constants is new Traverse_Proc (Disable_Constant);
+      --  Helper for Analyze_Loop_Statement, to unset Is_True_Constant on
+      --  variables referenced within an OpenACC construct.
 
-      function Is_Wrapped_In_Block (N : Node_Id) return Boolean;
-      --  Determine whether loop statement N has been wrapped in a block to
-      --  capture finalization actions that may be generated for container
-      --  iterators. Prevents infinite recursion when block is analyzed.
-      --  Routine is a noop if loop is single statement within source block.
+      procedure Prepare_Loop_Statement (Iter : Node_Id);
+      --  Determine whether loop statement N with iteration scheme Iter must be
+      --  transformed prior to analysis, and if so, perform it. The routine
+      --  raises Skip_Analysis to prevent further analysis of the transformed
+      --  loop.
 
       ----------------------
       -- Disable_Constant --
@@ -3385,104 +3390,328 @@ package body Sem_Ch5 is
          then
             Set_Is_True_Constant (Entity (N), False);
          end if;
+
          return OK;
       end Disable_Constant;
 
-      procedure Disable_Constants is new Traverse_Proc (Disable_Constant);
-      --  Helper for Analyze_Loop_Statement, to unset Is_True_Constant on
-      --  variables referenced within an OpenACC environment.
+      ----------------------------
+      -- Prepare_Loop_Statement --
+      ----------------------------
+
+      procedure Prepare_Loop_Statement (Iter : Node_Id) is
+         function Has_Sec_Stack_Default_Iterator
+           (Cont_Typ : Entity_Id) return Boolean;
+         pragma Inline (Has_Sec_Stack_Default_Iterator);
+         --  Determine whether container type Cont_Typ has a default iterator
+         --  that requires secondary stack management.
+
+         function Is_Sec_Stack_Iteration_Primitive
+           (Cont_Typ      : Entity_Id;
+            Iter_Prim_Nam : Name_Id) return Boolean;
+         pragma Inline (Is_Sec_Stack_Iteration_Primitive);
+         --  Determine whether container type Cont_Typ has an iteration routine
+         --  described by its name Iter_Prim_Nam that requires secondary stack
+         --  management.
+
+         function Is_Wrapped_In_Block (Stmt : Node_Id) return Boolean;
+         pragma Inline (Is_Wrapped_In_Block);
+         --  Determine whether arbitrary statement Stmt is the sole statement
+         --  wrapped within some block, excluding pragmas.
+
+         procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id);
+         pragma Inline (Prepare_Iterator_Loop);
+         --  Prepare an iterator loop with iteration specification Iter_Spec
+         --  for transformation if needed.
+
+         procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id);
+         pragma Inline (Prepare_Param_Spec_Loop);
+         --  Prepare a discrete loop with parameter specification Param_Spec
+         --  for transformation if needed.
+
+         procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean);
+         pragma Inline (Wrap_Loop_Statement);
+         --  Wrap loop statement N within a block. Flag Manage_Sec_Stack must
+         --  be set when the block must mark and release the secondary stack.
+
+         ------------------------------------
+         -- Has_Sec_Stack_Default_Iterator --
+         ------------------------------------
+
+         function Has_Sec_Stack_Default_Iterator
+           (Cont_Typ : Entity_Id) return Boolean
+         is
+            Def_Iter : constant Node_Id :=
+                         Find_Value_Of_Aspect
+                           (Cont_Typ, Aspect_Default_Iterator);
+         begin
+            return
+              Present (Def_Iter)
+                and then Requires_Transient_Scope (Etype (Def_Iter));
+         end Has_Sec_Stack_Default_Iterator;
+
+         --------------------------------------
+         -- Is_Sec_Stack_Iteration_Primitive --
+         --------------------------------------
+
+         function Is_Sec_Stack_Iteration_Primitive
+           (Cont_Typ      : Entity_Id;
+            Iter_Prim_Nam : Name_Id) return Boolean
+         is
+            Iter_Prim : constant Entity_Id :=
+                          Get_Iterable_Type_Primitive
+                            (Cont_Typ, Iter_Prim_Nam);
+         begin
+            return
+              Present (Iter_Prim)
+                and then Requires_Transient_Scope (Etype (Iter_Prim));
+         end Is_Sec_Stack_Iteration_Primitive;
 
-      ---------------------------
-      -- Is_Container_Iterator --
-      ---------------------------
+         -------------------------
+         -- Is_Wrapped_In_Block --
+         -------------------------
 
-      function Is_Container_Iterator (Iter : Node_Id) return Boolean is
-      begin
-         --  Infinite loop
+         function Is_Wrapped_In_Block (Stmt : Node_Id) return Boolean is
+            Blk_HSS  : Node_Id;
+            Blk_Id   : Entity_Id;
+            Blk_Stmt : Node_Id;
 
-         if No (Iter) then
-            return False;
+         begin
+            Blk_Id := Current_Scope;
 
-         --  While loop
+            --  The current context is a block. Inspect the statements of the
+            --  block to determine whether it wraps Stmt.
+
+            if Ekind (Blk_Id) = E_Block
+              and then Present (Block_Node (Blk_Id))
+            then
+               Blk_HSS :=
+                 Handled_Statement_Sequence (Parent (Block_Node (Blk_Id)));
+
+               --  Skip leading pragmas introduced for invariant and predicate
+               --  checks.
+
+               Blk_Stmt := First (Statements (Blk_HSS));
+               while Present (Blk_Stmt)
+                 and then Nkind (Blk_Stmt) = N_Pragma
+               loop
+                  Next (Blk_Stmt);
+               end loop;
+
+               return Blk_Stmt = Stmt and then No (Next (Blk_Stmt));
+            end if;
 
-         elsif Present (Condition (Iter)) then
             return False;
+         end Is_Wrapped_In_Block;
 
-         --  for Def_Id in [reverse] Name loop
-         --  for Def_Id [: Subtype_Indication] of [reverse] Name loop
+         ---------------------------
+         -- Prepare_Iterator_Loop --
+         ---------------------------
 
-         elsif Present (Iterator_Specification (Iter)) then
-            declare
-               Nam : constant Node_Id := Name (Iterator_Specification (Iter));
-               Nam_Copy : Node_Id;
+         procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id) is
+            Cont_Typ : Entity_Id;
+            Nam      : Node_Id;
+            Nam_Copy : Node_Id;
 
-            begin
+         begin
+            --  The iterator specification has syntactic errors. Transform the
+            --  loop into an infinite loop in order to safely perform at least
+            --  some minor analysis. This check must come first.
+
+            if Error_Posted (Iter_Spec) then
+               Set_Iteration_Scheme (N, Empty);
+               Analyze (N);
+
+               raise Skip_Analysis;
+
+            --  Nothing to do when the loop is already wrapped in a block
+
+            elsif Is_Wrapped_In_Block (N) then
+               null;
+
+            --  Otherwise the iterator loop traverses an array or a container
+            --  and appears in the form
+            --
+            --    for Def_Id in [reverse] Iterator_Name loop
+            --    for Def_Id [: Subtyp_Indic] of [reverse] Iterable_Name loop
+
+            else
+               --  Prepare a copy of the iterated name for preanalysis. The
+               --  copy is semi inserted into the tree by setting its Parent
+               --  pointer.
+
+               Nam      := Name (Iter_Spec);
                Nam_Copy := New_Copy_Tree (Nam);
                Set_Parent (Nam_Copy, Parent (Nam));
+
+               --  Determine what the loop is iterating on
+
                Preanalyze_Range (Nam_Copy);
+               Cont_Typ := Etype (Nam_Copy);
 
-               --  The only two options here are iteration over a container or
-               --  an array.
+               --  The iterator loop is traversing an array. This case does not
+               --  require any transformation.
 
-               return not Is_Array_Type (Etype (Nam_Copy));
-            end;
+               if Is_Array_Type (Cont_Typ) then
+                  null;
 
-         --  for Def_Id in [reverse] Discrete_Subtype_Definition loop
+               --  Otherwise unconditionally wrap the loop statement within
+               --  a block. The expansion of iterator loops may relocate the
+               --  iterator outside the loop, thus "leaking" its entity into
+               --  the enclosing scope. Wrapping the loop statement allows
+               --  for multiple iterator loops using the same iterator name
+               --  to coexist within the same scope.
+               --
+               --  The block must manage the secondary stack when the iterator
+               --  loop is traversing a container using either
+               --
+               --    * A default iterator obtained on the secondary stack
+               --
+               --    * Call to Iterate where the iterator is returned on the
+               --      secondary stack.
+               --
+               --    * Combination of First, Next, and Has_Element where the
+               --      first two return a cursor on the secondary stack.
 
-         else
-            declare
-               LP : constant Node_Id := Loop_Parameter_Specification (Iter);
-               DS : constant Node_Id := Discrete_Subtype_Definition (LP);
-               DS_Copy : Node_Id;
+               else
+                  Wrap_Loop_Statement
+                    (Manage_Sec_Stack =>
+                       Has_Sec_Stack_Default_Iterator (Cont_Typ)
+                         or else Has_Sec_Stack_Call (Nam_Copy)
+                         or else Is_Sec_Stack_Iteration_Primitive
+                                   (Cont_Typ, Name_First)
+                         or else Is_Sec_Stack_Iteration_Primitive
+                                   (Cont_Typ, Name_Next));
+               end if;
+            end if;
+         end Prepare_Iterator_Loop;
 
-            begin
-               DS_Copy := New_Copy_Tree (DS);
-               Set_Parent (DS_Copy, Parent (DS));
-               Preanalyze_Range (DS_Copy);
+         -----------------------------
+         -- Prepare_Param_Spec_Loop --
+         -----------------------------
 
-               --  Check for a call to Iterate () or an expression with
-               --  an iterator type.
+         procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id) is
+            High     : Node_Id;
+            Low      : Node_Id;
+            Rng      : Node_Id;
+            Rng_Copy : Node_Id;
+            Rng_Typ  : Entity_Id;
 
-               return
-                 (Nkind (DS_Copy) = N_Function_Call
-                   and then Needs_Finalization (Etype (DS_Copy)))
-                 or else Is_Iterator (Etype (DS_Copy));
-            end;
-         end if;
-      end Is_Container_Iterator;
+         begin
+            Rng := Discrete_Subtype_Definition (Param_Spec);
 
-      -------------------------
-      -- Is_Wrapped_In_Block --
-      -------------------------
+            --  Nothing to do when the loop is already wrapped in a block
 
-      function Is_Wrapped_In_Block (N : Node_Id) return Boolean is
-         HSS  : Node_Id;
-         Stat : Node_Id;
+            if Is_Wrapped_In_Block (N) then
+               null;
 
-      begin
+            --  The parameter specification appears in the form
+            --
+            --    for Def_Id in Subtype_Mark Constraint loop
 
-         --  Check if current scope is a block that is not a transient block.
+            elsif Nkind (Rng) = N_Subtype_Indication
+              and then Nkind (Range_Expression (Constraint (Rng))) = N_Range
+            then
+               Rng := Range_Expression (Constraint (Rng));
 
-         if Ekind (Current_Scope) /= E_Block
-           or else No (Block_Node (Current_Scope))
-         then
-            return False;
+               --  Preanalyze the bounds of the range constraint
 
-         else
-            HSS  :=
-              Handled_Statement_Sequence (Parent (Block_Node (Current_Scope)));
+               Low  := New_Copy_Tree (Low_Bound  (Rng));
+               High := New_Copy_Tree (High_Bound (Rng));
 
-            --  Skip leading pragmas that may be introduced for invariant and
-            --  predicate checks.
+               Preanalyze (Low);
+               Preanalyze (High);
 
-            Stat := First (Statements (HSS));
-            while Present (Stat) and then Nkind (Stat) = N_Pragma loop
-               Stat := Next (Stat);
-            end loop;
+               --  The bounds contain at least one function call that returns
+               --  on the secondary stack. Note that the loop must be wrapped
+               --  only when such a call exists.
+
+               if Has_Sec_Stack_Call (Low)
+                    or else
+                  Has_Sec_Stack_Call (High)
+               then
+                  Wrap_Loop_Statement (Manage_Sec_Stack => True);
+               end if;
+
+            --  Otherwise the parameter specification appears in the form
+            --
+            --    for Def_Id in Range loop
+
+            else
+               --  Prepare a copy of the discrete range for preanalysis. The
+               --  copy is semi inserted into the tree by setting its Parent
+               --  pointer.
+
+               Rng_Copy := New_Copy_Tree (Rng);
+               Set_Parent (Rng_Copy, Parent (Rng));
+
+               --  Determine what the loop is iterating on
+
+               Preanalyze_Range (Rng_Copy);
+               Rng_Typ := Etype (Rng_Copy);
+
+               --  Wrap the loop statement within a block in order to manage
+               --  the secondary stack when the discrete range is
+               --
+               --    * Either a Forward_Iterator or a Reverse_Iterator
+               --
+               --    * Function call whose return type requires finalization
+               --      actions.
+
+               --  ??? it is unclear why using Has_Sec_Stack_Call directly on
+               --  the discrete range causes the freeze node of an itype to be
+               --  in the wrong scope in complex assertion expressions.
+
+               if Is_Iterator (Rng_Typ)
+                 or else (Nkind (Rng_Copy) = N_Function_Call
+                           and then Needs_Finalization (Rng_Typ))
+               then
+                  Wrap_Loop_Statement (Manage_Sec_Stack => True);
+               end if;
+            end if;
+         end Prepare_Param_Spec_Loop;
+
+         -------------------------
+         -- Wrap_Loop_Statement --
+         -------------------------
 
-            return Stat = N and then No (Next (Stat));
+         procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean) is
+            Loc : constant Source_Ptr := Sloc (N);
+
+            Blk    : Node_Id;
+            Blk_Id : Entity_Id;
+
+         begin
+            Blk :=
+              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 (Blk, Blk_Id);
+            Set_Uses_Sec_Stack (Blk_Id, Manage_Sec_Stack);
+
+            Rewrite (N, Blk);
+            Analyze (N);
+
+            raise Skip_Analysis;
+         end Wrap_Loop_Statement;
+
+         --  Local variables
+
+         Iter_Spec  : constant Node_Id := Iterator_Specification (Iter);
+         Param_Spec : constant Node_Id := Loop_Parameter_Specification (Iter);
+
+      --  Start of processing for Prepare_Loop_Statement
+
+      begin
+         if Present (Iter_Spec) then
+            Prepare_Iterator_Loop (Iter_Spec);
+
+         elsif Present (Param_Spec) then
+            Prepare_Param_Spec_Loop (Param_Spec);
          end if;
-      end Is_Wrapped_In_Block;
+      end Prepare_Loop_Statement;
 
       --  Local declarations
 
@@ -3561,114 +3790,25 @@ package body Sem_Ch5 is
          Set_Has_Created_Identifier (N);
       end if;
 
-      --  If the iterator specification has a syntactic error, transform
-      --  construct into an infinite loop to prevent a crash and perform
-      --  some analysis.
-
-      if Present (Iter)
-        and then Present (Iterator_Specification (Iter))
-        and then Error_Posted (Iterator_Specification (Iter))
-      then
-         Set_Iteration_Scheme (N, Empty);
-         Analyze (N);
-         return;
-      end if;
-
-      --  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
-         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;
-
-      --  Wrap the loop in a block when the evaluation of the loop iterator
-      --  relies on the secondary stack. Required to ensure releasing the
-      --  secondary stack as soon as the loop completes.
-
-      if Present (Iter)
-        and then Present (Loop_Parameter_Specification (Iter))
-        and then not Is_Wrapped_In_Block (N)
-      then
-         declare
-            LPS : constant Node_Id := Loop_Parameter_Specification (Iter);
-            DSD : constant Node_Id :=
-                    Original_Node (Discrete_Subtype_Definition (LPS));
-
-            Block_Id  : Entity_Id;
-            Block_Nod : Node_Id;
-            HB        : Node_Id;
-            LB        : Node_Id;
+      --  Determine whether the loop statement must be transformed prior to
+      --  analysis, and if so, perform it. This early modification is needed
+      --  when:
+      --
+      --    * The loop has an erroneous iteration scheme. In this case the
+      --      loop is converted into an infinite loop in order to perform
+      --      minor analysis.
+      --
+      --    * The loop is an Ada 2012 iterator loop. In this case the loop is
+      --      wrapped within a block to provide a local scope for the iterator.
+      --      If the iterator specification requires the secondary stack in any
+      --      way, the block is marked in order to manage it.
+      --
+      --    * The loop is using a parameter specification where the discrete
+      --      range requires the secondary stack. In this case the loop is
+      --      wrapped within a block in order to manage the secondary stack.
 
-         begin
-            if Nkind (DSD) = N_Subtype_Indication
-              and then Nkind (Range_Expression (Constraint (DSD))) = N_Range
-            then
-               LB :=
-                 New_Copy_Tree
-                   (Low_Bound (Range_Expression (Constraint (DSD))));
-               HB :=
-                 New_Copy_Tree
-                   (High_Bound (Range_Expression (Constraint (DSD))));
-
-               Preanalyze (LB);
-               Preanalyze (HB);
-
-               if Has_Call_Using_Secondary_Stack (LB)
-                 or else Has_Call_Using_Secondary_Stack (HB)
-               then
-                  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);
-                  Set_Uses_Sec_Stack (Block_Id);
-                  Rewrite (N, Block_Nod);
-                  Analyze (N);
-                  return;
-               end if;
-            end if;
-         end;
+      if Present (Iter) then
+         Prepare_Loop_Statement (Iter);
       end if;
 
       --  Kill current values on entry to loop, since statements in the body of
@@ -3842,6 +3982,10 @@ package body Sem_Ch5 is
       if Is_OpenAcc_Environment (Stmt) then
          Disable_Constants (Stmt);
       end if;
+
+   exception
+      when Skip_Analysis =>
+         null;
    end Analyze_Loop_Statement;
 
    ----------------------------
@@ -4108,11 +4252,11 @@ package body Sem_Ch5 is
       end if;
    end Check_Unreachable_Code;
 
-   ------------------------------------
-   -- Has_Call_Using_Secondary_Stack --
-   ------------------------------------
+   ------------------------
+   -- Has_Sec_Stack_Call --
+   ------------------------
 
-   function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean is
+   function Has_Sec_Stack_Call (N : Node_Id) return Boolean is
       function Check_Call (N : Node_Id) return Traverse_Result;
       --  Check if N is a function call which uses the secondary stack
 
@@ -4144,13 +4288,16 @@ package body Sem_Ch5 is
             end loop;
 
             Subp := Entity (Nam);
-            Typ  := Etype (Subp);
 
-            if Requires_Transient_Scope (Typ) then
-               return Abandon;
+            if Present (Subp) then
+               Typ := Etype (Subp);
 
-            elsif Sec_Stack_Needed_For_Return (Subp) then
-               return Abandon;
+               if Requires_Transient_Scope (Typ) then
+                  return Abandon;
+
+               elsif Sec_Stack_Needed_For_Return (Subp) then
+                  return Abandon;
+               end if;
             end if;
          end if;
 
@@ -4161,11 +4308,11 @@ package body Sem_Ch5 is
 
       function Check_Calls is new Traverse_Func (Check_Call);
 
-   --  Start of processing for Has_Call_Using_Secondary_Stack
+   --  Start of processing for Has_Sec_Stack_Call
 
    begin
       return Check_Calls (N) = Abandon;
-   end Has_Call_Using_Secondary_Stack;
+   end Has_Sec_Stack_Call;
 
    ----------------------
    -- Preanalyze_Range --