From: Robert Dewar Date: Wed, 26 Mar 2008 07:42:03 +0000 (+0100) Subject: sem_ch11.adb: Fix No_Exception_Restriction violation for SJLJ X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d9f86c0c6cab087228394773d7b528c63e0a9969;p=gcc.git sem_ch11.adb: Fix No_Exception_Restriction violation for SJLJ 2008-03-26 Robert Dewar * sem_ch11.adb: Fix No_Exception_Restriction violation for SJLJ * sinfo.ads, sinfo.adb (From_At_End): New flag From-SVN: r133576 --- diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 66cfc88a993..2be74709f09 100644 --- a/gcc/ada/sem_ch11.adb +++ b/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 diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 2baa94b7d3a..528d7f43a40 100644 --- a/gcc/ada/sinfo.adb +++ b/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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index d1f20176768..5c131465a92 100644 --- a/gcc/ada/sinfo.ads +++ b/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);