Skip to content

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

sem_ch11.adb: Fix No_Exception_Restriction violation for SJLJ 

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

	* sem_ch11.adb: Fix No_Exception_Restriction violation for SJLJ
	* sinfo.ads, sinfo.adb (From_At_End): New flag

From-SVN: r133576
parent 9b91e150
Showing with 71 additions and 25 deletions
gcc/ada/sem_ch11.adb
......@@ -437,7 +437,6 @@ package body Sem_Ch11 is
Exception_Id : constant Node_Id := Name (N);
Exception_Name : Entity_Id := Empty;
P : Node_Id;
Nkind_P : Node_Kind;
begin
Check_Unreachable_Code (N);
......@@ -484,16 +483,13 @@ package body Sem_Ch11 is
if No (Exception_Id) then
P := Parent (N);
Nkind_P := Nkind (P);
while Nkind_P /= N_Exception_Handler
and then Nkind_P /= N_Subprogram_Body
and then Nkind_P /= N_Package_Body
and then Nkind_P /= N_Task_Body
and then Nkind_P /= N_Entry_Body
while not Nkind_In (P, N_Exception_Handler,
N_Subprogram_Body,
N_Package_Body,
N_Task_Body,
N_Entry_Body)
loop
P := Parent (P);
Nkind_P := Nkind (P);
end loop;
if Nkind (P) /= N_Exception_Handler then
......@@ -506,7 +502,15 @@ package body Sem_Ch11 is
else
Set_Local_Raise_Not_OK (P);
Check_Restriction (No_Exception_Propagation, N);
-- Do not check the restriction if the reraise statement is part
-- of the code generated for an AT-END handler. That's because
-- if the restriction is actually active, we never generate this
-- raise anyway, so the apparent violation is bogus.
if not From_At_End (N) then
Check_Restriction (No_Exception_Propagation, N);
end if;
end if;
-- Normal case with exception id present
......
gcc/ada/sinfo.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1264,6 +1264,14 @@ package body Sinfo is
return Flag5 (N);
end Forwards_OK;
function From_At_End
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Raise_Statement);
return Flag4 (N);
end From_At_End;
function From_At_Mod
(N : Node_Id) return Boolean is
begin
......@@ -3995,6 +4003,14 @@ package body Sinfo is
Set_Flag5 (N, Val);
end Set_Forwards_OK;
procedure Set_From_At_End
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Raise_Statement);
Set_Flag4 (N, Val);
end Set_From_At_End;
procedure Set_From_At_Mod
(N : Node_Id; Val : Boolean := True) is
begin
......@@ -5574,9 +5590,9 @@ package body Sinfo is
UI_From_Int (Int (S) - Int (Sloc (N))));
end Set_End_Location;
--------------------------------
-- Node_Kind Membership Tests --
--------------------------------
--------------
-- Nkind_In --
--------------
function Nkind_In
(T : Node_Kind;
......@@ -5690,4 +5706,13 @@ package body Sinfo is
T = V8;
end Nkind_In;
-----------------
-- Pragma_Name --
-----------------
function Pragma_Name (N : Node_Id) return Name_Id is
begin
return Chars (Pragma_Identifier (N));
end Pragma_Name;
end Sinfo;
gcc/ada/sinfo.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1032,6 +1032,13 @@ package Sinfo is
-- could not determine that either direction is definitely safe, and a
-- runtime check is required.
-- From_At_End (Flag4-Sem)
-- This flag is set on an N_Raise_Statement node if it corresponds to
-- the reraise statement generated as the last statement of an AT END
-- handler when SJLJ exception handling is active. It is used to stop
-- a bogus violation of restriction (No_Exception_Propagation), bogus
-- because if the restriction is set, the reraise is not generated.
-- From_At_Mod (Flag4-Sem)
-- This flag is set on the attribute definition clause node that is
-- generated by a transformation of an at mod phrase in a record
......@@ -1876,7 +1883,6 @@ package Sinfo is
-- N_Pragma
-- Sloc points to pragma identifier
-- Chars (Name1) identifier name from pragma identifier
-- Pragma_Argument_Associations (List2) (set to No_List if none)
-- Debug_Statement (Node3) (set to Empty if not Debug, Assert)
-- Pragma_Identifier (Node4)
......@@ -1887,12 +1893,8 @@ package Sinfo is
-- Psect_Object is always converted to Common_Object, but there are
-- undoubtedly many other similar notes required ???
-- Note: we don't really need the Chars field, since it can trivially
-- be obtained as Chars (Pragma_Identifier (Node)). However, it is
-- convenient to have this directly available, and historically the
-- Chars field has been around for ever, whereas the Pragma_Identifier
-- field was added much later (when we found the need to be able to get
-- the Sloc of the pragma identifier).
-- Note: a utility function Pragma_Name may be applied to pragma nodes
-- to conveniently obtain the Chars field of the Pragma_Identifier.
--------------------------------------
-- 2.8 Pragma Argument Association --
......@@ -5660,6 +5662,7 @@ package Sinfo is
-- Sloc points to RAISE
-- Name (Node2) (set to Empty if no exception name present)
-- Expression (Node3) (set to Empty if no expression present)
-- From_At_End (Flag4-Sem)
-------------------------------
-- 12.1 Generic Declaration --
......@@ -6886,7 +6889,6 @@ package Sinfo is
-- N_Has_Chars
N_Empty,
N_Pragma,
N_Pragma_Argument_Association,
-- N_Has_Etype
......@@ -6983,10 +6985,8 @@ package Sinfo is
N_Conditional_Expression,
N_Explicit_Dereference,
N_Function_Call,
N_Indexed_Component,
N_Integer_Literal,
N_Null,
N_Or_Else,
N_Procedure_Call_Statement,
......@@ -7215,6 +7215,7 @@ package Sinfo is
N_Package_Specification,
N_Parameter_Association,
N_Parameter_Specification,
N_Pragma,
N_Protected_Definition,
N_Range_Constraint,
N_Real_Range_Specification,
......@@ -7796,6 +7797,9 @@ package Sinfo is
function Forwards_OK
(N : Node_Id) return Boolean; -- Flag5
function From_At_End
(N : Node_Id) return Boolean; -- Flag4
function From_At_Mod
(N : Node_Id) return Boolean; -- Flag4
......@@ -8666,6 +8670,9 @@ package Sinfo is
procedure Set_From_At_Mod
(N : Node_Id; Val : Boolean := True); -- Flag4
procedure Set_From_At_End
(N : Node_Id; Val : Boolean := True); -- Flag4
procedure Set_From_Default
(N : Node_Id; Val : Boolean := True); -- Flag6
......@@ -9238,6 +9245,14 @@ package Sinfo is
pragma Inline (Nkind_In);
-- Inline all above functions
-----------------------
-- Utility Functions --
-----------------------
function Pragma_Name (N : Node_Id) return Name_Id;
pragma Inline (Pragma_Name);
-- Convenient function to obtain Chars field of Pragma_Identifier
-----------------------------
-- Syntactic Parent Tables --
-----------------------------
......@@ -10908,6 +10923,7 @@ package Sinfo is
pragma Inline (Float_Truncate);
pragma Inline (Formal_Type_Definition);
pragma Inline (Forwards_OK);
pragma Inline (From_At_End);
pragma Inline (From_At_Mod);
pragma Inline (From_Default);
pragma Inline (Generic_Associations);
......@@ -11194,6 +11210,7 @@ package Sinfo is
pragma Inline (Set_Float_Truncate);
pragma Inline (Set_Formal_Type_Definition);
pragma Inline (Set_Forwards_OK);
pragma Inline (Set_From_At_End);
pragma Inline (Set_From_At_Mod);
pragma Inline (Set_From_Default);
pragma Inline (Set_Generic_Associations);
......
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