[Ada] Missing finalization of controlled function result

[Arnaud Charlet <charlet at adacore dot com>]

This patch modifies the finalization machinery to detect a subprogram call
that returns a constrolled transient temporary in the context of a function
call that returns an unconstrained result as part of the initialization
expression of an object declaration.

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

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   Ctrl_Error : exception;

   type Ctrl is new Controlled with record
      Id   : Natural := 0;
      Data : Natural;
   end record;

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

   function Get_Id (Obj : Ctrl) return String;  --  raises Ctrl_Error
   function Make_Ctrl (Data : Natural) return Ctrl;
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
      Old_Id : constant Natural := Obj.Id;
      New_Id : constant Natural := Old_Id * 100;

   begin
      Put_Line ("  adj:" & Old_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);
      Obj.Id := 0;
   end Finalize;

   function Get_Id (Obj : Ctrl) return String is
   begin
      raise Ctrl_Error;
      return Obj.Id'Img;
   end Get_Id;

   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 (Data : Natural) return Ctrl is
      Obj : Ctrl;

   begin
      Obj.Data := Data;
      return Obj;
   end Make_Ctrl;
end Types;

--  trans_final.adb

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

procedure Trans_Final is
begin
   declare
      Id : constant String := Get_Id (Make_Ctrl (123));
   begin
      Put_Line ("ERROR: exception not raised");
   end;
exception
   when Ctrl_Error => Put_Line ("OK");
   when others     => Put_Line ("ERROR: unexpected exception");
end Trans_Final;

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

$ gnatmake -q trans_final.adb
$ ./trans_final
  ini: 1
  adj: 1 => 100
  fin: 1
  fin: 100
OK

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

2014-10-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Is_Subprogram_Call): Account for the case where an
	object declaration initialized by a function call that returns
	an unconstrained result may be rewritted as a renaming of the
	secondary stack result.

Attachment: difs
Description: Text document