[Ada] Funalization of controlled function results in conditional expression

This patch adds logic to postpone the finalization of temporary controlled
function results in the context of conditional expressions because the results
are finalized too early.

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

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Ctrl is new Controlled with record
      Id : Natural;
   end record;

   procedure Adjust (Obj : in out Ctrl);
   procedure Finalize (Obj : in out Ctrl);
   procedure Initialize (Obj : in out Ctrl);

   type Root is tagged null record;
   type Ctrl_Rec is new Root with record
      Comp : Ctrl;
   end record;

   function Make_Ctrl_Rec (Flag : Boolean) return Ctrl_Rec;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   Id_Gen : Natural := 0;

   procedure Adjust (Obj : in out Ctrl) is
      New_Id : constant Natural := Obj.Id * 100;
   begin
      Put_Line ("  adj" & Obj.Id'Img & " ->" & New_Id'Img);
      Obj.Id := New_Id;
   end Adjust;

   procedure Finalize (Obj : in out Ctrl) is
   begin
      Put_Line ("  fin" & Obj.Id'Img);
   end Finalize;

   procedure Initialize (Obj : in out Ctrl) is
   begin
      Id_Gen := Id_Gen + 1;
      Obj.Id := Id_Gen;
      Put_Line ("  ini" & Obj.Id'Img);
   end Initialize;

   function Make_Ctrl_Rec (Flag : Boolean) return Ctrl_Rec is
      Result : Ctrl_Rec;
   begin
      return Result;
   end Make_Ctrl_Rec;
end Types;

--  main.adb

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

procedure Main is
   function Factorial (N : Natural) return Natural is
   begin
      if N = 0 then
         return 0;
      else
         return N * Factorial (N - 1);
      end if;
   end Factorial;

   Empty : Ctrl_Rec;

begin
   Put_Line ("Main");
   declare
      Obj : Root'Class := Empty;

   begin
      Put_Line ("Function");
      Obj := (if Factorial (3) > 2 then
                 Make_Ctrl_Rec (True)
              else
                 Make_Ctrl_Rec (False));
      Put_Line ("Function end");
   end;
   Put_Line ("Main end");
end Main;

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

$ gnatmake -q -gnat12 main.adb
$ ./main
$   ini 1
$ Main
$   adj 1 -> 100
$ Function
$   ini 2
$   adj 2 -> 200
$   fin 2
$   fin 100
$   adj 200 -> 20000
$   fin 200
$ Function end
$   fin 20000
$ Main end
$   fin 1

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

2012-06-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Update the usage of Node15.
	(Return_Flag_Or_Transient_Decl): Removed.
	(Set_Return_Flag_Or_Transient_Decl): Removed.
	(Set_Status_Flag_Or_Transient_Decl): New routine.
	(Status_Flag_Or_Transient_Decl): New routine.
	(Write_Field15_Name): Update the output for variables and constants.
	* einfo.ads: Remove attribute
	Return_Flag_Or_Transient_Decl along with occurrences in nodes.
	(Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
	(Set_Return_Flag_Or_Transient_Decl): Removed along with pragma Inline.
	(Set_Status_Flag_Or_Transient_Decl): New routine along with pragma
	Inline.
	(Status_Flag_Or_Transient_Decl): New routine along with pragma Inline.
	* exp_ch4.adb (Create_Alternative): New routine.
	(Expand_N_Conditional_Expression): Handle the case
	where at least one of the conditional expression
	alternatives prodices a controlled temporary by means of a function
	call.
	(Is_Controlled_Function_Call): New routine.
	(Process_Transient_Object): Update the call to
	Set_Return_Flag_Or_Transient_Decl.
	* exp_ch6.adb (Enclosing_Context): New routine.
	(Expand_N_Extended_Return_Statement): Update all calls to
	Set_Return_Flag_Or_Transient_Decl.
	(Expand_Ctrl_Function_Call): Prohibit the finalization of a controlled
	function result when the context is a conditional expression.
	* exp_ch7.adb (Process_Declarations): Update all calls to
	Return_Flag_Or_Transient_Decl. Add processing for intermediate
	results of conditional expressions where one of the alternatives
	uses a controlled function call.
	(Process_Object_Declaration): Update all calls to
	Return_Flag_Or_Transient_Decl and rearrange the logic to process
	"hook" objects first.
	(Process_Transient_Objects): Update the call to
	Set_Return_Flag_Or_Transient_Decl.
	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean,
	Boolean)): Update all calls to Return_Flag_Or_Transient_Decl. Add
	detection for intermediate results of conditional expressions
	where one of the alternatives uses a controlled function call.

[Ada] Funalization of controlled function results in conditional expression

Commit Message

Patch