@@ -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
@@ -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));
@@ -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 --
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 Tested on x86_64-pc-linux-gnu, committed on trunk 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.