Commit 8934a584 by Arnaud Charlet

Code clean up.

From-SVN: r178206
parent ca5af305
......@@ -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);
......
......@@ -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;
......
......@@ -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);
......
......@@ -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
......
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