Patchwork [Ada] Finalization of temporary controlled function results

login
register
mail settings
Submitter Arnaud Charlet
Date Feb. 6, 2013, 10:15 a.m.
Message ID <20130206101537.GA5784@adacore.com>
Download mbox | patch
Permalink /patch/218529/
State New
Headers show

Comments

Arnaud Charlet - Feb. 6, 2013, 10:15 a.m.
Finalization of temporary controlled function results in expression with
actions nodes in the context of return statements:

This patch adds logic to recognize a simple return statement as one of the
cases that require special processing with respect to temporary controlled
function results that appear in expression_with_actions nodes.

------------
-- Source --
------------

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Ctrl is new Controlled with record
      Data : Natural := 1234;
   end record;

   function Equal_To_1 (Obj : Ctrl) return Boolean;
   procedure Finalize (Obj : in out Ctrl);
   function Make_Ctrl (Val : Natural) return Ctrl;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   function Equal_To_1 (Obj : Ctrl) return Boolean is
   begin
      return Obj.Data = 1;
   end Equal_To_1;

   procedure Finalize (Obj : in out Ctrl) is
   begin
      Obj.Data := 0;
      Put_Line ("   fin");
   end Finalize;

   function Make_Ctrl (Val : Natural) return Ctrl is
   begin
      return (Controlled with Val);
   end Make_Ctrl;
end Types;

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Types;       use Types;

procedure Main is
   function Must_Be_True return Boolean is
      function Factorial (Val : Natural) return Natural is
      begin
         if Val > 1 then
            return Val * Factorial (Val - 1);
         else
            return 1;
         end if;
      end Factorial;
   begin
      return
        Factorial (3) = 6
          and then Equal_To_1 (Make_Ctrl (1));
   end Must_Be_True;
begin
   if not Must_Be_True then
      Put_Line ("ERROR: temporary function result finalized too early");
   end if;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q main.adb
$ ./main
   fin
   fin

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Find_Enclosing_Context): Recognize
	a simple return statement as one of the cases that require special
	processing with respect to temporary controlled function results.
	(Process_Transient_Object): Do attempt to finalize a temporary
	controlled function result when the associated context is
	a simple return statement.  Instead, leave this task to the
	general finalization mechanism.

Patch

Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 195790)
+++ exp_ch4.adb	(working copy)
@@ -5038,7 +5038,7 @@ 
             --  Start of processing for Find_Enclosing_Context
 
             begin
-               --  The expression_with_action is in a case or if expression and
+               --  The expression_with_actions is in a case/if expression and
                --  the lifetime of any temporary controlled object is therefore
                --  extended. Find a suitable insertion node by locating the top
                --  most case or if expressions.
@@ -5088,12 +5088,12 @@ 
 
                   return Par;
 
-               --  Shor circuit operators in complex expressions are converted
+               --  Short circuit operators in complex expressions are converted
                --  into expression_with_actions.
 
                else
                   --  Take care of the case where the expression_with_actions
-                  --  is burried deep inside an if statement. The temporary
+                  --  is buried deep inside an IF statement. The temporary
                   --  function result must be finalized before the then, elsif
                   --  or else statements are evaluated.
 
@@ -5123,7 +5123,7 @@ 
 
                   Top := Par;
 
-                  --  The expression_with_action might be located in a pragm
+                  --  The expression_with_actions might be located in a pragma
                   --  in which case locate the pragma itself:
 
                   --    pragma Precondition (... and then Ctrl_Func_Call ...);
@@ -5133,10 +5133,16 @@ 
 
                   --    Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
 
+                  --  Another case to consider is an expression_with_actions as
+                  --  part of a return statement:
+
+                  --    return ... and then Ctrl_Func_Call ...;
+
                   while Present (Par) loop
                      if Nkind_In (Par, N_Assignment_Statement,
                                        N_Object_Declaration,
-                                       N_Pragma)
+                                       N_Pragma,
+                                       N_Simple_Return_Statement)
                      then
                         return Par;
 
@@ -5238,23 +5244,32 @@ 
             --       Temp := null;
             --    end if;
 
-            Insert_Action_After (Context,
-              Make_If_Statement (Loc,
-                Condition =>
-                  Make_Op_Ne (Loc,
-                    Left_Opnd  => New_Reference_To (Temp_Id, Loc),
-                    Right_Opnd => Make_Null (Loc)),
+            --  When the expression_with_actions is part of a return statement,
+            --  there is no need to insert a finalization call, as the general
+            --  finalization mechanism (see Build_Finalizer) would take care of
+            --  the temporary function result on subprogram exit. Note that it
+            --  would also be impossible to insert the finalization code after
+            --  the return statement as this would make it unreachable.
 
-                Then_Statements => New_List (
-                  Make_Final_Call
-                    (Obj_Ref =>
-                       Make_Explicit_Dereference (Loc,
-                         Prefix => New_Reference_To (Temp_Id, Loc)),
-                     Typ     => Desig_Typ),
+            if Nkind (Context) /= N_Simple_Return_Statement then
+               Insert_Action_After (Context,
+                 Make_If_Statement (Loc,
+                   Condition =>
+                     Make_Op_Ne (Loc,
+                       Left_Opnd  => New_Reference_To (Temp_Id, Loc),
+                       Right_Opnd => Make_Null (Loc)),
 
-                  Make_Assignment_Statement (Loc,
-                    Name       => New_Reference_To (Temp_Id, Loc),
-                    Expression => Make_Null (Loc)))));
+                   Then_Statements => New_List (
+                     Make_Final_Call
+                       (Obj_Ref =>
+                          Make_Explicit_Dereference (Loc,
+                            Prefix => New_Reference_To (Temp_Id, Loc)),
+                        Typ     => Desig_Typ),
+
+                     Make_Assignment_Statement (Loc,
+                       Name       => New_Reference_To (Temp_Id, Loc),
+                       Expression => Make_Null (Loc)))));
+            end if;
          end Process_Transient_Object;
 
       --  Start of processing for Process_Action