Skip to content

R
riscv-gcc-1
Commit 06eab6a7 by Robert Dewar Committed by Arnaud Charlet
Options

exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise stmt. 

2008-03-26  Robert Dewar  <dewar@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise
	stmt.
	(No_Exception_Propagation_Active): New function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

	* restrict.ads, restrict.adb (No_Exception_Propagation_Active): New
	function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

From-SVN: r133560
parent e10dab7f
Showing with 55 additions and 25 deletions
gcc/ada/exp_ch11.adb
......@@ -143,12 +143,21 @@ package body Exp_Ch11 is
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Clean, Loc)));
-- Avoid generation of raise stmt if compiling with no exceptions
-- propagation
-- Generate reraise statement as last statement of AT-END handler,
-- unless we are under control of No_Exception_Propagation, in which
-- case no exception propagation is possible anyway, so we do not need
-- a reraise (the AT END handler in this case is only for normal exits
-- not for exceptional exits). Also, we flag the Reraise statement as
-- being part of an AT END handler to prevent signalling this reraise
-- as a violation of the restriction when it is not set.
if not Restriction_Active (No_Exception_Propagation) then
Append_To (Stmnts,
Make_Raise_Statement (Loc));
declare
Rstm : constant Node_Id := Make_Raise_Statement (Loc);
begin
Set_From_At_End (Rstm);
Append_To (Stmnts, Rstm);
end;
end if;
Set_Exception_Handlers (HSS, New_List (
......@@ -963,7 +972,7 @@ package body Exp_Ch11 is
Handler_Loop : while Present (Handler) loop
Next_Handler := Next_Non_Pragma (Handler);
-- Remove source handler if gnat debug flag N is set
-- Remove source handler if gnat debug flag .x is set
if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then
Remove (Handler);
......@@ -971,8 +980,9 @@ package body Exp_Ch11 is
-- Remove handler if no exception propagation, generating a warning
-- if a source generated handler was not the target of a local raise.
elsif Restriction_Active (No_Exception_Propagation) then
if not Has_Local_Raise (Handler)
else
if Restriction_Active (No_Exception_Propagation)
and then not Has_Local_Raise (Handler)
and then Comes_From_Source (Handler)
and then Warn_On_Non_Local_Exception
then
......@@ -982,13 +992,14 @@ package body Exp_Ch11 is
Handler);
end if;
if No_Exception_Propagation_Active then
Remove (Handler);
-- Exception handler is active and retained and must be processed
else
-- If an exception occurrence is present, then we must declare it
-- and initialize it from the value stored in the TSD
-- If an exception occurrence is present, then we must declare
-- it and initialize it from the value stored in the TSD
-- declare
-- name : Exception_Occurrence;
......@@ -1039,16 +1050,17 @@ package body Exp_Ch11 is
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements (Handler))))));
Analyze_List (Statements (Handler), Suppress => All_Checks);
Analyze_List
(Statements (Handler), Suppress => All_Checks);
end;
end if;
-- The processing at this point is rather different for the JVM
-- case, so we completely separate the processing.
-- For the JVM case, we unconditionally call Update_Exception,
-- passing a call to the intrinsic Current_Target_Exception (see
-- JVM version of Ada.Exceptions in 4jexcept.adb for details).
-- For the VM case, we unconditionally call Update_Exception,
-- passing a call to the intrinsic Current_Target_Exception
-- (see JVM/.NET versions of Ada.Exceptions for details).
if VM_Target /= No_VM then
declare
......@@ -1065,9 +1077,9 @@ package body Exp_Ch11 is
-- For the normal case, we have to worry about the state of
-- abort deferral. Generally, we defer abort during runtime
-- handling of exceptions. When control is passed to the
-- handler, then in the normal case we undefer aborts. In any
-- case this entire handling is relevant only if aborts are
-- allowed!
-- handler, then in the normal case we undefer aborts. In
-- any case this entire handling is relevant only if aborts
-- are allowed!
elsif Abort_Allowed then
......@@ -1076,27 +1088,31 @@ package body Exp_Ch11 is
-- wants to operate with aborts still deferred.
-- We also suppress the call if this is the special handler
-- for Abort_Signal, since if we are aborting, we want to keep
-- aborts deferred (one abort is enough).
-- for Abort_Signal, since if we are aborting, we want to
-- keep aborts deferred (one abort is enough).
-- If abort really needs to be deferred the expander must add
-- this call explicitly, see Expand_N_Asynchronous_Select.
-- If abort really needs to be deferred the expander must
-- add this call explicitly, see
-- Expand_N_Asynchronous_Select.
Others_Choice :=
Nkind (First (Exception_Choices (Handler))) = N_Others_Choice;
Nkind (First (Exception_Choices (Handler))) =
N_Others_Choice;
if (Others_Choice
or else Entity (First (Exception_Choices (Handler))) /=
Stand.Abort_Signal)
and then not
(Others_Choice
and then All_Others (First (Exception_Choices (Handler))))
and then
All_Others (First (Exception_Choices (Handler))))
and then Abort_Allowed
then
Prepend_Call_To_Handler (RE_Abort_Undefer);
end if;
end if;
end if;
end if;
Handler := Next_Handler;
end loop Handler_Loop;
......@@ -1248,7 +1264,6 @@ package body Exp_Ch11 is
Insert_List_After_And_Analyze (N, L);
end if;
end if;
end Expand_N_Exception_Declaration;
---------------------------------------------
......@@ -1334,8 +1349,6 @@ package body Exp_Ch11 is
H : Node_Id;
begin
-- Debug_Flag_Dot_G := True;
-- Processing for locally handled exception (exclude reraise case)
if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
......
gcc/ada/restrict.adb
......@@ -26,6 +26,7 @@
with Atree; use Atree;
with Casing; use Casing;
with Errout; use Errout;
with Debug; use Debug;
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Lib; use Lib;
......@@ -430,6 +431,18 @@ package body Restrict is
Restrictions.Set (No_Exception_Propagation));
end No_Exception_Handlers_Set;
-------------------------------------
-- No_Exception_Propagation_Active --
-------------------------------------
function No_Exception_Propagation_Active return Boolean is
begin
return (No_Run_Time_Mode
or else Configurable_Run_Time_Mode
or else Debug_Flag_Dot_G)
and then Restriction_Active (No_Exception_Propagation);
end No_Exception_Propagation_Active;
----------------------------------
-- Process_Restriction_Synonyms --
----------------------------------
......
gcc/ada/restrict.ads
......@@ -249,6 +249,10 @@ package Restrict is
-- set. In the latter case, the source may contain handlers but they either
-- get converted using the local goto transformation or deleted.
function No_Exception_Propagation_Active return Boolean;
-- Test to see if current restrictions settings specify that no
-- exception propagation is activated.
function Process_Restriction_Synonyms (N : Node_Id) return Name_Id;
-- Id is a node whose Chars field contains the name of a restriction.
-- If it is one of synonyms that we allow for historical purposes (for
......
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