Commit ace11c95 by Arnaud Charlet Committed by Arnaud Charlet

re PR ada/80590 (non-bootstrap build failure of Ada runtime)

PR ada/80590

	* sem_ch5.adb (Analyze_Loop_Statement): Avoid exception propagation
	during normal processing.

From-SVN: r272417
parent 0c65926f
2019-06-18 Arnaud Charlet <charlet@adacore.com>
PR ada/80590
* sem_ch5.adb (Analyze_Loop_Statement): Avoid exception propagation
during normal processing.
2019-06-17 Arnaud Charlet <charlet@adacore.com> 2019-06-17 Arnaud Charlet <charlet@adacore.com>
PR ada/80590 PR ada/80590
......
...@@ -3359,8 +3359,6 @@ package body Sem_Ch5 is ...@@ -3359,8 +3359,6 @@ package body Sem_Ch5 is
-- The following exception is raised by routine Prepare_Loop_Statement -- The following exception is raised by routine Prepare_Loop_Statement
-- to avoid further analysis of a transformed loop. -- to avoid further analysis of a transformed loop.
Skip_Analysis : exception;
function Disable_Constant (N : Node_Id) return Traverse_Result; function Disable_Constant (N : Node_Id) return Traverse_Result;
-- If N represents an E_Variable entity, set Is_True_Constant To False -- If N represents an E_Variable entity, set Is_True_Constant To False
...@@ -3368,11 +3366,12 @@ package body Sem_Ch5 is ...@@ -3368,11 +3366,12 @@ package body Sem_Ch5 is
-- Helper for Analyze_Loop_Statement, to unset Is_True_Constant on -- Helper for Analyze_Loop_Statement, to unset Is_True_Constant on
-- variables referenced within an OpenACC construct. -- variables referenced within an OpenACC construct.
procedure Prepare_Loop_Statement (Iter : Node_Id); procedure Prepare_Loop_Statement
(Iter : Node_Id;
Stop_Processing : out Boolean);
-- Determine whether loop statement N with iteration scheme Iter must be -- Determine whether loop statement N with iteration scheme Iter must be
-- transformed prior to analysis, and if so, perform it. The routine -- transformed prior to analysis, and if so, perform it.
-- raises Skip_Analysis to prevent further analysis of the transformed -- If Stop_Processing is set to True, should stop further processing.
-- loop.
---------------------- ----------------------
-- Disable_Constant -- -- Disable_Constant --
...@@ -3394,7 +3393,10 @@ package body Sem_Ch5 is ...@@ -3394,7 +3393,10 @@ package body Sem_Ch5 is
-- Prepare_Loop_Statement -- -- Prepare_Loop_Statement --
---------------------------- ----------------------------
procedure Prepare_Loop_Statement (Iter : Node_Id) is procedure Prepare_Loop_Statement
(Iter : Node_Id;
Stop_Processing : out Boolean)
is
function Has_Sec_Stack_Default_Iterator function Has_Sec_Stack_Default_Iterator
(Cont_Typ : Entity_Id) return Boolean; (Cont_Typ : Entity_Id) return Boolean;
pragma Inline (Has_Sec_Stack_Default_Iterator); pragma Inline (Has_Sec_Stack_Default_Iterator);
...@@ -3414,21 +3416,27 @@ package body Sem_Ch5 is ...@@ -3414,21 +3416,27 @@ package body Sem_Ch5 is
-- Determine whether arbitrary statement Stmt is the sole statement -- Determine whether arbitrary statement Stmt is the sole statement
-- wrapped within some block, excluding pragmas. -- wrapped within some block, excluding pragmas.
procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id); procedure Prepare_Iterator_Loop
(Iter_Spec : Node_Id;
Stop_Processing : out Boolean);
pragma Inline (Prepare_Iterator_Loop); pragma Inline (Prepare_Iterator_Loop);
-- Prepare an iterator loop with iteration specification Iter_Spec -- Prepare an iterator loop with iteration specification Iter_Spec
-- for transformation if needed. -- for transformation if needed.
-- If Stop_Processing is set to True, should stop further processing.
procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id); procedure Prepare_Param_Spec_Loop
(Param_Spec : Node_Id;
Stop_Processing : out Boolean);
pragma Inline (Prepare_Param_Spec_Loop); pragma Inline (Prepare_Param_Spec_Loop);
-- Prepare a discrete loop with parameter specification Param_Spec -- Prepare a discrete loop with parameter specification Param_Spec
-- for transformation if needed. -- for transformation if needed.
-- If Stop_Processing is set to True, should stop further processing.
procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean); procedure Wrap_Loop_Statement (Manage_Sec_Stack : Boolean);
pragma Inline (Wrap_Loop_Statement); pragma Inline (Wrap_Loop_Statement);
pragma No_Return (Wrap_Loop_Statement);
-- Wrap loop statement N within a block. Flag Manage_Sec_Stack must -- Wrap loop statement N within a block. Flag Manage_Sec_Stack must
-- be set when the block must mark and release the secondary stack. -- be set when the block must mark and release the secondary stack.
-- Should stop further processing after calling this procedure.
------------------------------------ ------------------------------------
-- Has_Sec_Stack_Default_Iterator -- -- Has_Sec_Stack_Default_Iterator --
...@@ -3504,12 +3512,17 @@ package body Sem_Ch5 is ...@@ -3504,12 +3512,17 @@ package body Sem_Ch5 is
-- Prepare_Iterator_Loop -- -- Prepare_Iterator_Loop --
--------------------------- ---------------------------
procedure Prepare_Iterator_Loop (Iter_Spec : Node_Id) is procedure Prepare_Iterator_Loop
(Iter_Spec : Node_Id;
Stop_Processing : out Boolean)
is
Cont_Typ : Entity_Id; Cont_Typ : Entity_Id;
Nam : Node_Id; Nam : Node_Id;
Nam_Copy : Node_Id; Nam_Copy : Node_Id;
begin begin
Stop_Processing := False;
-- The iterator specification has syntactic errors. Transform the -- The iterator specification has syntactic errors. Transform the
-- loop into an infinite loop in order to safely perform at least -- loop into an infinite loop in order to safely perform at least
-- some minor analysis. This check must come first. -- some minor analysis. This check must come first.
...@@ -3517,8 +3530,7 @@ package body Sem_Ch5 is ...@@ -3517,8 +3530,7 @@ package body Sem_Ch5 is
if Error_Posted (Iter_Spec) then if Error_Posted (Iter_Spec) then
Set_Iteration_Scheme (N, Empty); Set_Iteration_Scheme (N, Empty);
Analyze (N); Analyze (N);
Stop_Processing := True;
raise Skip_Analysis;
-- Nothing to do when the loop is already wrapped in a block -- Nothing to do when the loop is already wrapped in a block
...@@ -3578,6 +3590,7 @@ package body Sem_Ch5 is ...@@ -3578,6 +3590,7 @@ package body Sem_Ch5 is
(Cont_Typ, Name_First) (Cont_Typ, Name_First)
or else Is_Sec_Stack_Iteration_Primitive or else Is_Sec_Stack_Iteration_Primitive
(Cont_Typ, Name_Next)); (Cont_Typ, Name_Next));
Stop_Processing := True;
end if; end if;
end if; end if;
end Prepare_Iterator_Loop; end Prepare_Iterator_Loop;
...@@ -3586,7 +3599,10 @@ package body Sem_Ch5 is ...@@ -3586,7 +3599,10 @@ package body Sem_Ch5 is
-- Prepare_Param_Spec_Loop -- -- Prepare_Param_Spec_Loop --
----------------------------- -----------------------------
procedure Prepare_Param_Spec_Loop (Param_Spec : Node_Id) is procedure Prepare_Param_Spec_Loop
(Param_Spec : Node_Id;
Stop_Processing : out Boolean)
is
High : Node_Id; High : Node_Id;
Low : Node_Id; Low : Node_Id;
Rng : Node_Id; Rng : Node_Id;
...@@ -3594,6 +3610,7 @@ package body Sem_Ch5 is ...@@ -3594,6 +3610,7 @@ package body Sem_Ch5 is
Rng_Typ : Entity_Id; Rng_Typ : Entity_Id;
begin begin
Stop_Processing := False;
Rng := Discrete_Subtype_Definition (Param_Spec); Rng := Discrete_Subtype_Definition (Param_Spec);
-- Nothing to do when the loop is already wrapped in a block -- Nothing to do when the loop is already wrapped in a block
...@@ -3622,11 +3639,10 @@ package body Sem_Ch5 is ...@@ -3622,11 +3639,10 @@ package body Sem_Ch5 is
-- on the secondary stack. Note that the loop must be wrapped -- on the secondary stack. Note that the loop must be wrapped
-- only when such a call exists. -- only when such a call exists.
if Has_Sec_Stack_Call (Low) if Has_Sec_Stack_Call (Low) or else Has_Sec_Stack_Call (High)
or else
Has_Sec_Stack_Call (High)
then then
Wrap_Loop_Statement (Manage_Sec_Stack => True); Wrap_Loop_Statement (Manage_Sec_Stack => True);
Stop_Processing := True;
end if; end if;
-- Otherwise the parameter specification appears in the form -- Otherwise the parameter specification appears in the form
...@@ -3663,6 +3679,7 @@ package body Sem_Ch5 is ...@@ -3663,6 +3679,7 @@ package body Sem_Ch5 is
and then Needs_Finalization (Rng_Typ)) and then Needs_Finalization (Rng_Typ))
then then
Wrap_Loop_Statement (Manage_Sec_Stack => True); Wrap_Loop_Statement (Manage_Sec_Stack => True);
Stop_Processing := True;
end if; end if;
end if; end if;
end Prepare_Param_Spec_Loop; end Prepare_Param_Spec_Loop;
...@@ -3690,8 +3707,6 @@ package body Sem_Ch5 is ...@@ -3690,8 +3707,6 @@ package body Sem_Ch5 is
Rewrite (N, Blk); Rewrite (N, Blk);
Analyze (N); Analyze (N);
raise Skip_Analysis;
end Wrap_Loop_Statement; end Wrap_Loop_Statement;
-- Local variables -- Local variables
...@@ -3702,11 +3717,13 @@ package body Sem_Ch5 is ...@@ -3702,11 +3717,13 @@ package body Sem_Ch5 is
-- Start of processing for Prepare_Loop_Statement -- Start of processing for Prepare_Loop_Statement
begin begin
Stop_Processing := False;
if Present (Iter_Spec) then if Present (Iter_Spec) then
Prepare_Iterator_Loop (Iter_Spec); Prepare_Iterator_Loop (Iter_Spec, Stop_Processing);
elsif Present (Param_Spec) then elsif Present (Param_Spec) then
Prepare_Param_Spec_Loop (Param_Spec); Prepare_Param_Spec_Loop (Param_Spec, Stop_Processing);
end if; end if;
end Prepare_Loop_Statement; end Prepare_Loop_Statement;
...@@ -3805,7 +3822,15 @@ package body Sem_Ch5 is ...@@ -3805,7 +3822,15 @@ package body Sem_Ch5 is
-- wrapped within a block in order to manage the secondary stack. -- wrapped within a block in order to manage the secondary stack.
if Present (Iter) then if Present (Iter) then
Prepare_Loop_Statement (Iter); declare
Stop_Processing : Boolean;
begin
Prepare_Loop_Statement (Iter, Stop_Processing);
if Stop_Processing then
return;
end if;
end;
end if; end if;
-- Kill current values on entry to loop, since statements in the body of -- Kill current values on entry to loop, since statements in the body of
...@@ -3979,10 +4004,6 @@ package body Sem_Ch5 is ...@@ -3979,10 +4004,6 @@ package body Sem_Ch5 is
if Is_OpenAcc_Environment (Stmt) then if Is_OpenAcc_Environment (Stmt) then
Disable_Constants (Stmt); Disable_Constants (Stmt);
end if; end if;
exception
when Skip_Analysis =>
null;
end Analyze_Loop_Statement; end Analyze_Loop_Statement;
---------------------------- ----------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment