aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-29 13:12:58 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-29 13:12:58 +0200
commit8934a5840e5f5f51309a9a6bf5113278274fdb4e (patch)
treea09f36a00b03affdcdc0059ef6b0c845b9eee7c8
parentca5af305a13a6f886dc6b6e0a07863c7eeefdbee (diff)
downloadgcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.zip
gcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.tar.gz
gcc-8934a5840e5f5f51309a9a6bf5113278274fdb4e.tar.bz2
Code clean up.
From-SVN: r178206
-rw-r--r--gcc/ada/a-except-2005.adb73
-rw-r--r--gcc/ada/a-except.adb60
-rw-r--r--gcc/ada/a-except.ads7
-rw-r--r--gcc/ada/bindgen.adb7
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