===================================================================
@@ -717,63 +717,95 @@
Actuals : List_Id;
Proc_To_Call : Entity_Id;
Except : Node_Id;
+ Stmts : List_Id;
begin
- pragma Assert (Present (Data.E_Id));
pragma Assert (Present (Data.Raised_Id));
- -- Generate:
+ if Exception_Extra_Info
+ or else (For_Library and then not Restricted_Profile)
+ then
+ if Exception_Extra_Info then
+ -- Generate:
- -- Get_Current_Excep.all
+ -- Get_Current_Excep.all
- Except :=
- Make_Function_Call (Data.Loc,
- Name =>
- Make_Explicit_Dereference (Data.Loc,
- Prefix =>
- New_Reference_To (RTE (RE_Get_Current_Excep), Data.Loc)));
+ Except :=
+ Make_Function_Call (Data.Loc,
+ Name =>
+ Make_Explicit_Dereference (Data.Loc,
+ Prefix =>
+ New_Reference_To (RTE (RE_Get_Current_Excep),
+ Data.Loc)));
+ else
+ -- Generate:
- if For_Library and not Restricted_Profile then
- Proc_To_Call := RTE (RE_Save_Library_Occurrence);
- Actuals := New_List (Except);
+ -- null
+
+ Except := Make_Null (Data.Loc);
+ end if;
+
+ if For_Library and then not Restricted_Profile then
+ Proc_To_Call := RTE (RE_Save_Library_Occurrence);
+ Actuals := New_List (Except);
+ else
+ Proc_To_Call := RTE (RE_Save_Occurrence);
+
+ -- The dereference occurs only when Exception_Extra_Info is true,
+ -- and therefore Except is not null.
+
+ Actuals := New_List (
+ New_Reference_To (Data.E_Id, Data.Loc),
+ Make_Explicit_Dereference (Data.Loc, Except));
+ end if;
+
+ -- Generate:
+
+ -- when others =>
+ -- if not Raised_Id then
+ -- Raised_Id := True;
+
+ -- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
+ -- or
+ -- Save_Library_Occurrence (Get_Current_Excep.all);
+ -- end if;
+
+ Stmts :=
+ New_List (
+ Make_If_Statement (Data.Loc,
+ Condition =>
+ Make_Op_Not (Data.Loc,
+ Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
+
+ Then_Statements => New_List (
+ Make_Assignment_Statement (Data.Loc,
+ Name => New_Reference_To (Data.Raised_Id, Data.Loc),
+ Expression => New_Reference_To (Standard_True, Data.Loc)),
+
+ Make_Procedure_Call_Statement (Data.Loc,
+ Name =>
+ New_Reference_To (Proc_To_Call, Data.Loc),
+ Parameter_Associations => Actuals))));
+
else
- Proc_To_Call := RTE (RE_Save_Occurrence);
- Actuals :=
- New_List
- (New_Reference_To (Data.E_Id, Data.Loc),
- Make_Explicit_Dereference (Data.Loc, Except));
+ -- Generate:
+
+ -- Raised_Id := True;
+
+ Stmts := New_List (
+ Make_Assignment_Statement (Data.Loc,
+ Name => New_Reference_To (Data.Raised_Id, Data.Loc),
+ Expression => New_Reference_To (Standard_True, Data.Loc)));
end if;
-- Generate:
-- when others =>
- -- if not Raised_Id then
- -- Raised_Id := True;
- -- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
- -- or
- -- Save_Library_Occurrence (Get_Current_Excep.all);
- -- end if;
-
return
Make_Exception_Handler (Data.Loc,
- Exception_Choices =>
- New_List (Make_Others_Choice (Data.Loc)),
- Statements => New_List (
- Make_If_Statement (Data.Loc,
- Condition =>
- Make_Op_Not (Data.Loc,
- Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
-
- Then_Statements => New_List (
- Make_Assignment_Statement (Data.Loc,
- Name => New_Reference_To (Data.Raised_Id, Data.Loc),
- Expression => New_Reference_To (Standard_True, Data.Loc)),
-
- Make_Procedure_Call_Statement (Data.Loc,
- Name =>
- New_Reference_To (Proc_To_Call, Data.Loc),
- Parameter_Associations => Actuals)))));
+ Exception_Choices => New_List (Make_Others_Choice (Data.Loc)),
+ Statements => Stmts);
end Build_Exception_Handler;
-------------------------------
@@ -2998,8 +3030,6 @@
return;
end if;
- Data.Abort_Id := Make_Temporary (Loc, 'A');
- Data.E_Id := Make_Temporary (Loc, 'E');
Data.Raised_Id := Make_Temporary (Loc, 'R');
-- In certain scenarios, finalization can be triggered by an abort. If
@@ -3019,35 +3049,44 @@
and then VM_Target = No_VM
and then not For_Package
then
+ Data.Abort_Id := Make_Temporary (Loc, 'A');
+
A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc);
- -- No abort, .NET/JVM or library-level finalizers
+ -- Generate:
+ -- Abort_Id : constant Boolean := <A_Expr>;
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Data.Abort_Id,
+ Constant_Present => True,
+ Object_Definition => New_Reference_To (Standard_Boolean, Loc),
+ Expression => A_Expr));
+
else
- A_Expr := New_Reference_To (Standard_False, Loc);
+ -- No abort, .NET/JVM or library-level finalizers
+
+ Data.Abort_Id := Empty;
end if;
- -- Generate:
- -- Abort_Id : constant Boolean := <A_Expr>;
+ if Exception_Extra_Info then
+ Data.E_Id := Make_Temporary (Loc, 'E');
- Append_To (Decls,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Data.Abort_Id,
- Constant_Present => True,
- Object_Definition => New_Reference_To (Standard_Boolean, Loc),
- Expression => A_Expr));
+ -- Generate:
+ -- E_Id : Exception_Occurrence;
- -- Generate:
- -- E_Id : Exception_Occurrence;
+ E_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Data.E_Id,
+ Object_Definition =>
+ New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
+ Set_No_Initialization (E_Decl);
- E_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Data.E_Id,
- Object_Definition =>
- New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
- Set_No_Initialization (E_Decl);
+ Append_To (Decls, E_Decl);
- Append_To (Decls, E_Decl);
+ else
+ Data.E_Id := Empty;
+ end if;
-- Generate:
-- Raised_Id : Boolean := False;
@@ -3067,12 +3106,15 @@
(Data : Finalization_Exception_Data) return Node_Id
is
Stmt : Node_Id;
+ Expr : Node_Id;
begin
-- Standard run-time and .NET/JVM targets use the specialized routine
-- Raise_From_Controlled_Operation.
- if RTE_Available (RE_Raise_From_Controlled_Operation) then
+ if Exception_Extra_Info
+ and then RTE_Available (RE_Raise_From_Controlled_Operation)
+ then
Stmt :=
Make_Procedure_Call_Statement (Data.Loc,
Name =>
@@ -3092,6 +3134,21 @@
end if;
-- Generate:
+ -- Raised_Id and then not Abort_Id
+ -- <or>
+ -- Raised_Id
+
+ Expr := New_Reference_To (Data.Raised_Id, Data.Loc);
+
+ if Present (Data.Abort_Id) then
+ Expr := Make_And_Then (Data.Loc,
+ Left_Opnd => Expr,
+ Right_Opnd =>
+ Make_Op_Not (Data.Loc,
+ Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc)));
+ end if;
+
+ -- Generate:
-- if Raised_Id and then not Abort_Id then
-- Raise_From_Controlled_Operation (E_Id);
-- <or>
@@ -3100,13 +3157,7 @@
return
Make_If_Statement (Data.Loc,
- Condition =>
- Make_And_Then (Data.Loc,
- Left_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc),
- Right_Opnd =>
- Make_Op_Not (Data.Loc,
- Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc))),
-
+ Condition => Expr,
Then_Statements => New_List (Stmt));
end Build_Raise_Statement;
===================================================================
@@ -224,10 +224,13 @@
-----------------------------
procedure Save_Library_Occurrence (E : EOA) is
+ use Ada.Exceptions;
begin
if not Library_Exception_Set then
Library_Exception_Set := True;
- Ada.Exceptions.Save_Occurrence (Library_Exception, E.all);
+ if E /= null then
+ Ada.Exceptions.Save_Occurrence (Library_Exception, E.all);
+ end if;
end if;
end Save_Library_Occurrence;
===================================================================
@@ -1296,7 +1296,13 @@
begin
if Library_Exception_Set then
LE := Library_Exception;
- Raise_From_Controlled_Operation (LE);
+ if LE.Id = Null_Id then
+ Raise_Exception_No_Defer
+ (E => Program_Error'Identity,
+ Message => "finalize/adjust raised exception");
+ else
+ Raise_From_Controlled_Operation (LE);
+ end if;
end if;
end Reraise_Library_Exception_If_Any;