Patchwork [Ada] Object declarations and finalization of transient variables

login
register
mail settings
Submitter Arnaud Charlet
Date June 12, 2012, 11:04 a.m.
Message ID <20120612110411.GA27450@adacore.com>
Download mbox | patch
Permalink /patch/164389/
State New
Headers show

Comments

Arnaud Charlet - June 12, 2012, 11:04 a.m.
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  <kirtchev@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.

Patch

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