diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-29 13:12:58 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-29 13:12:58 +0200 |
commit | 8934a5840e5f5f51309a9a6bf5113278274fdb4e (patch) | |
tree | a09f36a00b03affdcdc0059ef6b0c845b9eee7c8 | |
parent | ca5af305a13a6f886dc6b6e0a07863c7eeefdbee (diff) | |
download | gcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.zip gcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.tar.gz gcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.tar.bz2 |
Code clean up.
From-SVN: r178206
-rw-r--r-- | gcc/ada/a-except-2005.adb | 73 | ||||
-rw-r--r-- | gcc/ada/a-except.adb | 60 | ||||
-rw-r--r-- | gcc/ada/a-except.ads | 7 | ||||
-rw-r--r-- | gcc/ada/bindgen.adb | 7 |
4 files changed, 62 insertions, 85 deletions
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 0ff0b5b..5990e22 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -855,9 +855,11 @@ package body Ada.Exceptions is -- Go ahead and raise appropriate exception Exception_Data.Set_Exception_Msg (EF, Message); + if not ZCX_By_Default then Abort_Defer.all; end if; + Raise_Current_Excep (EF); end Raise_Exception; @@ -882,57 +884,41 @@ package body Ada.Exceptions is ------------------------------------- procedure Raise_From_Controlled_Operation - (X : Ada.Exceptions.Exception_Occurrence; - From_Abort : Boolean) + (X : Ada.Exceptions.Exception_Occurrence) is + Prefix : constant String := "adjust/finalize raised "; + Orig_Msg : constant String := Exception_Message (X); + Orig_Prefix_Length : constant Natural := + Integer'Min (Prefix'Length, Orig_Msg'Length); + Orig_Prefix : String renames Orig_Msg + (Orig_Msg'First .. + Orig_Msg'First + Orig_Prefix_Length - 1); begin - -- When finalization was triggered by an abort, keep propagating the - -- abort signal rather than raising Program_Error. - - if From_Abort then - raise Standard'Abort_Signal; + -- Message already has the proper prefix, just re-raise - -- Otherwise, raise Program_Error + if Orig_Prefix = Prefix then + Raise_Exception_No_Defer + (E => Program_Error'Identity, + Message => Orig_Msg); else declare - Prefix : constant String := "adjust/finalize raised "; - Orig_Msg : constant String := Exception_Message (X); - Orig_Prefix_Length : constant Natural := - Integer'Min - (Prefix'Length, Orig_Msg'Length); - Orig_Prefix : String renames Orig_Msg - (Orig_Msg'First .. - Orig_Msg'First + Orig_Prefix_Length - 1); + New_Msg : constant String := Prefix & Exception_Name (X); begin - -- Message already has the proper prefix, just re-raise + -- No message present, just provide our own - if Orig_Prefix = Prefix then + if Orig_Msg = "" then Raise_Exception_No_Defer (E => Program_Error'Identity, - Message => Orig_Msg); - - else - declare - New_Msg : constant String := Prefix & Exception_Name (X); + Message => New_Msg); - begin - -- No message present, just provide our own + -- Message present, add informational prefix - if Orig_Msg = "" then - Raise_Exception_No_Defer - (E => Program_Error'Identity, - Message => New_Msg); - - -- Message present, add informational prefix - - else - Raise_Exception_No_Defer - (E => Program_Error'Identity, - Message => New_Msg & ": " & Orig_Msg); - end if; - end; + else + Raise_Exception_No_Defer + (E => Program_Error'Identity, + Message => New_Msg & ": " & Orig_Msg); end if; end; end if; @@ -948,9 +934,11 @@ package body Ada.Exceptions is is begin Exception_Data.Set_Exception_C_Msg (E, M); + if not ZCX_By_Default then Abort_Defer.all; end if; + Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E)); Exception_Propagation.Propagate_Exception (E => E, From_Signal_Handler => True); @@ -1021,9 +1009,11 @@ package body Ada.Exceptions is is begin Exception_Data.Set_Exception_C_Msg (E, F, L, C, M); + if not ZCX_By_Default then Abort_Defer.all; end if; + Raise_Current_Excep (E); end Raise_With_Location_And_Msg; @@ -1042,9 +1032,14 @@ package body Ada.Exceptions is Excep.Num_Tracebacks := 0; Excep.Cleanup_Flag := False; Excep.Pid := Local_Partition_ID; + + -- The following is a common pattern, should be abstracted + -- into a procedure call ??? + if not ZCX_By_Default then Abort_Defer.all; end if; + Raise_Current_Excep (E); end Raise_With_Msg; @@ -1303,6 +1298,7 @@ package body Ada.Exceptions is if not ZCX_By_Default then Abort_Defer.all; end if; + Exception_Propagation.Setup_Exception (X'Unrestricted_Access, Get_Current_Excep.all, Reraised => True); Save_Occurrence_No_Private (Get_Current_Excep.all.all, X); @@ -1319,6 +1315,7 @@ package body Ada.Exceptions is if not ZCX_By_Default then Abort_Defer.all; end if; + Exception_Propagation.Setup_Exception (X'Unrestricted_Access, Get_Current_Excep.all, Reraised => True); Save_Occurrence_No_Private (Get_Current_Excep.all.all, X); diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 2633cf4..fe1ca52 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -850,57 +850,41 @@ package body Ada.Exceptions is ------------------------------------- procedure Raise_From_Controlled_Operation - (X : Ada.Exceptions.Exception_Occurrence; - From_Abort : Boolean) + (X : Ada.Exceptions.Exception_Occurrence) is + Prefix : constant String := "adjust/finalize raised "; + Orig_Msg : constant String := Exception_Message (X); + Orig_Prefix_Length : constant Natural := + Integer'Min (Prefix'Length, Orig_Msg'Length); + Orig_Prefix : String renames Orig_Msg + (Orig_Msg'First .. + Orig_Msg'First + Orig_Prefix_Length - 1); begin - -- When finalization was triggered by an abort, keep propagating the - -- abort signal rather than raising Program_Error. + -- Message already has proper prefix, just re-reraise - if From_Abort then - raise Standard'Abort_Signal; - - -- Otherwise, raise Program_Error + if Orig_Prefix = Prefix then + Raise_Exception_No_Defer + (E => Program_Error'Identity, + Message => Orig_Msg); else declare - Prefix : constant String := "adjust/finalize raised "; - Orig_Msg : constant String := Exception_Message (X); - Orig_Prefix_Length : constant Natural := - Integer'Min - (Prefix'Length, Orig_Msg'Length); - Orig_Prefix : String renames Orig_Msg - (Orig_Msg'First .. - Orig_Msg'First + Orig_Prefix_Length - 1); + New_Msg : constant String := Prefix & Exception_Name (X); begin - -- Message already has proper prefix, just re-reraise + -- No message present, just provide our own - if Orig_Prefix = Prefix then + if Orig_Msg = "" then Raise_Exception_No_Defer (E => Program_Error'Identity, - Message => Orig_Msg); - - else - declare - New_Msg : constant String := Prefix & Exception_Name (X); - - begin - -- No message present, just provide our own + Message => New_Msg); - if Orig_Msg = "" then - Raise_Exception_No_Defer - (E => Program_Error'Identity, - Message => New_Msg); + -- Message present, add informational prefix - -- Message present, add informational prefix - - else - Raise_Exception_No_Defer - (E => Program_Error'Identity, - Message => New_Msg & ": " & Orig_Msg); - end if; - end; + else + Raise_Exception_No_Defer + (E => Program_Error'Identity, + Message => New_Msg & ": " & Orig_Msg); end if; end; end if; diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads index a6f5713..0ff3ee6 100644 --- a/gcc/ada/a-except.ads +++ b/gcc/ada/a-except.ads @@ -199,16 +199,13 @@ private -- system to return here rather than to the original location. procedure Raise_From_Controlled_Operation - (X : Ada.Exceptions.Exception_Occurrence; - From_Abort : Boolean); + (X : Ada.Exceptions.Exception_Occurrence); pragma No_Return (Raise_From_Controlled_Operation); pragma Export (Ada, Raise_From_Controlled_Operation, "__gnat_raise_from_controlled_operation"); -- Raise Program_Error, providing information about X (an exception raised - -- during a controlled operation) in the exception message. However, if the - -- finalization was triggered by abort, keep aborting instead of raising - -- Program_Error. + -- during a controlled operation) in the exception message. procedure Reraise_Occurrence_Always (X : Exception_Occurrence); pragma No_Return (Reraise_Occurrence_Always); diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 8d40273..2a161fa 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -1455,9 +1455,8 @@ package body Bindgen is Write_Statement_Buffer; Set_String (" procedure Raise_From_Controlled_"); - Set_String ("Operation "); - Set_String ("(X : Ada.Exceptions.Exception_Occurrence; "); - Set_String (" From_Abort : Boolean);"); + Set_String ("Operation (X : Ada.Exceptions.Exception_"); + Set_String ("Occurrence);"); Write_Statement_Buffer; Set_String (" pragma Import (Ada, Raise_From_"); @@ -1466,7 +1465,7 @@ package body Bindgen is Write_Statement_Buffer; WBI (" begin"); - WBI (" Raise_From_Controlled_Operation (LE, False);"); + WBI (" Raise_From_Controlled_Operation (LE);"); WBI (" end;"); -- VM-specific code, use regular Ada to produce the desired behavior |