[Ada] Funalization of controlled function results in conditional expression

[Arnaud Charlet <charlet at adacore dot com>]

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.

Attachment: difs
Description: Text document