[Ada] Missing finalization of class-wide object

[Arnaud Charlet <charlet at adacore dot com>]

This patch allows the finalization machinery to recognize a case where a source
object initialized by a controlled function call has been transformed into a
class-wide renaming of routine Ada.Tags.Displace. This case arises when the
return type of the function and the result requires dispatch table pointer
manipulation.

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

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Iface is interface;
   function Get (Name : String) return Iface'Class;

   type Ctrl_Typ is new Controlled and Iface with record
      Data : Integer;
   end record;
   procedure Finalize (Obj : in out Ctrl_Typ);
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   function Get (Name : String) return Iface'Class is
      Obj : Ctrl_Typ;
   begin
      Obj.Data := Name'Length;
      return Obj;
   end Get;

   procedure Finalize (Obj : in out Ctrl_Typ) is
   begin
      Put_Line ("  Finalize");
   end Finalize;
end Types;

--  main.adb

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

procedure Main is
begin
   Put_Line ("Main");
   declare
      Obj : Iface'Class := Get ("Hello");
      --  Finalize temp in Get
      --  Finalize temp result of Get
   begin
      Put_Line ("Hello");
      --  Finalize Obj
   end;
   Put_Line ("End");
end Main;

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

$ gnatmake -q -gnat05 main.adb
$ ./main
$ Main
$   Finalize
$   Finalize
$ Hello
$   Finalize
$ End

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

2012-02-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Process_Declarations): Minor reformatting. Simplify the
	entry point for renamings. Detect a case where a source object has
	been transformed into a class-wide renaming of a call to
	Ada.Tags.Displace.
	* exp_util.adb (Is_Displacement_Of_Ctrl_Function_Result): New routine.
	(Is_Finalizable_Transient): Minor reformatting.
	(Is_Tag_To_Class_Wide_Conversion): Minor reformatting.
	(Requires_Cleanup_Actions): Minor reformatting. Simplify the
	entry point for renamings. Detect a case where a source object
	has been transformed into a class-wide renaming of a call to
	Ada.Tags.Displace.
	* exp_util.ads (Is_Displacement_Of_Ctrl_Function_Result): New routine.
	(Is_Tag_To_Class_Wide_Conversion): Minor reformatting.

Attachment: difs
Description: Text document