This patch adds code to recognize a scenario where an object is initialized by
a sequence of nested function calls where one of them returns a controlled
result. This in turn triggers the mechanism which exports such transient
objects to the enclosing finalizer on the assumption that one of the calls may
raise an exception.
------------
-- Source --
------------
-- types.ads
with Ada.Finalization; use Ada.Finalization;
package Types is
type Ctrl is new Controlled with null record;
procedure Finalize (Obj : in out Ctrl);
end Types;
-- types.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Types is
procedure Finalize (Obj : in out Ctrl) is
begin
Put_Line ("Finalize");
end Finalize;
end Types;
-- main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
procedure Main is
function Return_Self (Obj : Ctrl) return Ctrl is
begin
return Obj;
end Return_Self;
function Blow_Up (Obj : Ctrl) return Boolean is
begin
raise Constraint_Error;
return True;
end Blow_Up;
Obj : Ctrl;
begin
Put_Line ("Main");
declare
Flag : constant Boolean := Blow_Up (Return_Self (Obj));
begin
null;
end;
Put_Line ("End");
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q -gnat05 main.adb
$ ./main
$ Main
$ Finalize
$ Finalize
$
$ raised CONSTRAINT_ERROR : main.adb:12 explicit raise
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-06-12 Hristian Kirtchev <kirtc...@adacore.com>
* exp_ch7.adb (Process_Transient_Objects): Renamed constant
Requires_Hooking to Must_Hook and replace all occurrences of the name.
(Requires_Hooking): New routine. Detect all contexts that require
transient variable export to the outer finalizer due to a potential
exception.
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 188438)
+++ exp_ch7.adb (working copy)
@@ -4327,10 +4327,47 @@
Last_Object : Node_Id;
Related_Node : Node_Id)
is
- Requires_Hooking : constant Boolean :=
- Nkind_In (N, N_Function_Call,
- N_Procedure_Call_Statement);
+ function Requires_Hooking return Boolean;
+ -- Determine whether the context requires transient variable export
+ -- to the outer finalizer. This scenario arises when the context may
+ -- raise an exception.
+ ----------------------
+ -- Requires_Hooking --
+ ----------------------
+
+ function Requires_Hooking return Boolean is
+ function Is_Subprogram_Call (Nod : Node_Id) return Boolean;
+ -- Determine whether a particular node is a procedure of function
+ -- call.
+
+ ------------------------
+ -- Is_Subprogram_Call --
+ ------------------------
+
+ function Is_Subprogram_Call (Nod : Node_Id) return Boolean is
+ begin
+ return
+ Nkind_In (Nod, N_Function_Call, N_Procedure_Call_Statement);
+ end Is_Subprogram_Call;
+
+ -- Start of processing for Requires_Hooking
+
+ begin
+ -- The context is either a procedure or function call or an object
+ -- declaration initialized by such a call. In all these cases, the
+ -- calls are assumed to raise an exception.
+
+ return
+ Is_Subprogram_Call (N)
+ or else
+ (Nkind (N) = N_Object_Declaration
+ and then Is_Subprogram_Call (Expression (N)));
+ end Requires_Hooking;
+
+ -- Local variables
+
+ Must_Hook : constant Boolean := Requires_Hooking;
Built : Boolean := False;
Desig_Typ : Entity_Id;
Fin_Block : Node_Id;
@@ -4395,7 +4432,7 @@
-- enclosing sequence of statements where their corresponding
-- "hooks" are picked up by the finalization machinery.
- if Requires_Hooking then
+ if Must_Hook then
declare
Expr : Node_Id;
Ptr_Id : Entity_Id;
@@ -4470,7 +4507,7 @@
-- Generate:
-- Temp := null;
- if Requires_Hooking then
+ if Must_Hook then
Append_To (Stmts,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
