[Ada] Wrong Finalize_Address leads to Segmentation_Fault

This patch reimplements a key aspect of heap-allocated controlled objects.
Primitive Finalize_Address is now associated with the finalization master of
an access-to-controlled type when the designated type is frozen and not at the
point of object allocation.

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

--  types.ads

with Ada.Finalization; use Ada.Finalization;

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

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

   type Root is abstract tagged limited null record;
   type Any_Root_Ptr is access all Root'Class;

   function Make_Any_Root_Ptr (Is_Child_1 : Boolean) return Any_Root_Ptr;

   type Child_1 is new Root with record
      Comp_1 : Ctrl;
      Comp_2 : Ctrl;
   end record;
   type Any_Child_1_Ptr is access all Child_1'Class;
   type     Child_1_Ptr is access all Child_1;

   function Make_Child_1     return Child_1;
   function Make_Child_1_Ptr return Child_1_Ptr;

   type Child_2 is new Root with record
      Comp_1 : Ctrl;
   end record;
   type Any_Child_2_Ptr is access all Child_2'Class;
   type     Child_2_Ptr is access all Child_2;

   function Make_Child_2     return Child_2;
   function Make_Child_2_Ptr return Child_2_Ptr;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   Id_Gen : Natural := 0;

   procedure Finalize (Obj : in out Ctrl) is
   begin
      Put_Line ("  fin:" & Obj.Id'Img);
      Obj.Id := 0;
   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_Child_1 return Child_1 is
   begin
      return Obj : Child_1;
   end Make_Child_1;

   function Make_Child_1_Ptr return Child_1_Ptr is
      Result : constant Any_Child_1_Ptr := new Child_1'(Make_Child_1);
   begin
      return Child_1_Ptr (Result);
   end Make_Child_1_Ptr;

   function Make_Child_2 return Child_2 is
   begin
      return Obj : Child_2;
   end Make_Child_2;

   function Make_Child_2_Ptr return Child_2_Ptr is
      Result : constant Any_Child_2_Ptr := new Child_2'(Make_Child_2);
   begin
      return Child_2_Ptr (Result);
   end Make_Child_2_Ptr;

   function Make_Any_Root_Ptr (Is_Child_1 : Boolean) return Any_Root_Ptr is
   begin
      if Is_Child_1 then
         return Any_Root_Ptr (Make_Child_1_Ptr);
      else
         return Any_Root_Ptr (Make_Child_2_Ptr);
      end if;
   end Make_Any_Root_Ptr;
end Types;

--  main.adb

with Types; use Types;

procedure Main is
   Obj : Any_Root_Ptr;

begin
   Obj := Make_Any_Root_Ptr (True);
   Obj := Make_Any_Root_Ptr (False);
end Main;

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

$ gnatmake -q main.adb
$ ./main
  ini: 1
  ini: 2
  ini: 3
  fin: 3
  fin: 2
  fin: 1

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

2015-01-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Update the usage of attributes Entry_Bodies_Array,
	Lit_Indexes, Scale_Value, Storage_Size_Variable,
	String_Literal_Low_Bound along associated routines and
	Write_FieldX_Name.
	(Pending_Access_Types): New routine.
	(Set_Pending_Access_Types): New routine.
	(Write_Field15_Name): Add an entry for Pending_Access_Types.
	* einfo.ads Add new attribute Pending_Access_Types along
	with usage in nodes.  Update the usage of attributes
	Entry_Bodies_Array, Lit_Indexes, Scale_Value,
	Storage_Size_Variable, String_Literal_Low_Bound.
	(Pending_Access_Types): New routine along with pragma Inline.
	(Set_Pending_Access_Types): New routine along with pragma Inline.
	* exp_ch3.adb (Expand_Freeze_Array_Type): Add new local variable
	Ins_Node. Determine the insertion node for anonynous access type
	that acts as a component type of an array. Update the call to
	Build_Finalization_Master.
	(Expand_Freeze_Record_Type): Update
	the calls to Build_Finalization_Master.
	(Freeze_Type): Remove
	local variable RACW_Seen. Factor out the code that deals with
	remote access-to-class-wide types. Create a finalization master
	when the designated type contains a private component. Fully
	initialize all pending access types.
	(Process_RACW_Types): New routine.
	(Process_Pending_Access_Types): New routine.
	* exp_ch4.adb (Expand_Allocator_Expression): Allocation no longer
	needs to set primitive Finalize_Address.
	(Expand_N_Allocator): Allocation no longer sets primitive
	Finalize_Address.
	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
	Update the call to Build_Finalization_Master.
	(Make_Build_In_Place_Call_In_Allocator): Allocation no longer
	needs to set primitive Finalize_Address.
	* exp_ch7.adb (Add_Pending_Access_Type): New routine.
	(Build_Finalization_Master): New parameter profile. Associate
	primitive Finalize_Address with the finalization master if the
	designated type has been frozen, otherwise treat the access
	type as pending. Simplify the insertion of the master and
	related initialization code.
	(Make_Finalize_Address_Body): Allow Finalize_Address for class-wide
	abstract types.
	(Make_Set_Finalize_Address_Call): Remove forlam parameter Typ.
	Simplify the implementation.
	* exp_ch7.ads (Build_Finalization_Master): New parameter profile
	along with comment on usage.
	(Make_Set_Finalize_Address_Call): Remove formal parameter Typ. Update
	the comment on usage.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Use routine
	Finalize_Address to retrieve the primitive.
	(Finalize_Address): New routine.
	(Find_Finalize_Address): Removed.
	* exp_util.ads (Finalize_Address): New routine.
	* freeze.adb (Freeze_All): Remove the generation of finalization
	masters.
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Propagate any
	pending access types from the partial to the full view.

[Ada] Wrong Finalize_Address leads to Segmentation_Fault

Commit Message

Patch