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),