[Ada] Missing finalization of temporary function results in case and if

[Arnaud Charlet <charlet at adacore dot com>]

This patch adds machinery to properly finalize temporary controlled function
results that appear in N_Expression_With_Actions nodes as well as case and if
expressions. In general, such temporaries must be finalized after the related
context is elaborated/evaluated.

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

--  types.ads

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

   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
   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
   procedure Ensure_Value (Val : Natural; Exp : Natural; Act : Natural) is
   begin
      if Val /= Exp then
         Put_Line ("ERROR: transient finalized too early");
         Put_Line ("  Expected:" & Exp'Img);
         Put_Line ("  Got     :" & Act'Img);
      end if;
   end Ensure_Value;

   function Factorial (Val : Natural) return Natural is
   begin
      if Val > 1 then
         return Factorial (Val - 1) * Val;
      else
         return 1;
      end if;
   end Factorial;

   Exp  : constant Natural := 9876;
   Junk : constant Natural := 5432;
   Flag : Boolean;
   Val  : Natural;

begin
   Put_Line ("Case expression");
   Val := (case Factorial (3) is
              when 6      => Make_Ctrl (Exp).Data,
              when others => Junk);
   Ensure_Value (Val, Exp, Junk);

   Put_Line ("If expression");
   Val := (if Factorial (3) = 6 then
              Make_Ctrl (Exp).Data
           else
              Junk);
   Ensure_Value (Val, Exp, Junk);

   Put_Line ("If statement");
   if Val = Exp
     and then Make_Ctrl (Exp).Data = Exp
   then
      Put_Line ("      then statements");
   end if;

   Put_Line ("Assignment");
   Flag := Val = Exp and then Make_Ctrl (Exp).Data = Exp;

   Put_Line ("End");
end Main;

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

$ gnatmake -q -gnat12 main.adb
$ ./main
Case expression
   fin
   fin
If expression
   fin
   fin
If statement
   fin
   fin
      then statements
Assignment
   fin
   fin
End

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

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

	* exp_ch4.adb (Expand_N_Expression_With_Actions): Rewritten. This
	routine should be able to properly detect controlled transient
	objects in its actions and generate the appropriate finalization
	actions.
	* exp_ch6.adb (Enclosing_Context): Removed.
	(Expand_Ctrl_Function_Call): Remove local subprogram and
	constant. Use routine Within_Case_Or_If_Expression to determine
	whether the lifetime of the function result must be extended to
	match that of the context.
	* exp_util.ads, exp_util.adb (Within_Case_Or_If_Expression): New
	routine.

Attachment: difs
Description: Text document