[Ada] Missing finalization of defaulted aggregate in extended return

This patch introduces several significant changes in the area of transient
object processing and finalization.

1) The patch introduces a new mechanism for handling of transient objects in
the context of aggregate initialization. An array element or record component
initialized by a controlled function call is now treated as a special context.
The circuitry associated with the transient function result is now produced in
place, during aggregate expansion, as opposed to a post pass as part of
transient scope processing. This ensures that the transient function result is
finalized immediately after the related element or component is initialized,
tag adjusted, and deep_adjusted.

Prior to this change, the transient function result was finalized too early,
leading to a malformed element or component.

2) All three transient object finalization mechanisms (transient scopes, if
expressions, case expressions, expression_with_actions, transient aggregate
components) now share the same code generation circuitry.

3) Any trainsient object processed by one of the three mechanisms is ignored
by the general finalization mechanism to prevent double finalization.

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

--  types.ads

with Ada.Finalization;      use Ada.Finalization;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

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

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

   function Make_Ctrl return Ctrl;

   type Parent is tagged record
      Comp_1 : Integer := 1;
   end record;

   type Child is new Parent with record
      Comp_2 : Ctrl := Make_Ctrl;
      Comp_3 : Unbounded_String := To_Unbounded_String ("Comp_3");
   end record;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Types is
   Id_Gen : Natural := 100;

   procedure Adjust (Obj : in out Ctrl) is
      Old_Id : constant Natural := Obj.Id;
      New_Id : constant Natural := Old_Id + 1;

   begin
      if Old_Id = 0 then
         Put_Line ("ERROR: adjusting finalized object");
      end if;

      Put_Line ("  adj:" & Old_Id'Img & " ->" & New_Id'Img);
      Obj.Id := New_Id;
   end Adjust;

   procedure Finalize (Obj : in out Ctrl) is
      Obj_Id : constant Natural := Obj.Id;

   begin
      if Obj_Id = 0 then
         Put_Line ("ERROR: finalizing finalized object");
      end if;

      Put_Line ("  fin:" & Obj_Id'Img);
      Obj.Id := 0;
   end Finalize;

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

   function Make_Ctrl return Ctrl is
      Result : Ctrl;
   begin
      return Result;
   end Make_Ctrl;
end Types;

--  aggregates.ads

with Types; use Types;

package Aggregates is
   function Box_Aggregate return Child;
   function Box_Aggregate_In_ER return Child;

   function Normal_Aggregate return Child;
   function Normal_Aggregate_In_ER return Child;
end Aggregates;

--  aggregates.adb

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO;           use Ada.Text_IO;

package body Aggregates is
   function Box_Aggregate return Child is
      Result : constant Child := (Parent with others => <>);
   begin
      return Result;
   end Box_Aggregate;

   function Box_Aggregate_In_ER return Child is
   begin
      return Result : Child := (Parent with others => <>)
      do null; end return;
   end Box_Aggregate_In_ER;

   function Normal_Aggregate return Child is
      Result : constant Child :=
                 (Parent with Comp_2 => Make_Ctrl,
                              Comp_3 => To_Unbounded_String ("Comp_3"));
   begin
      return Result;
   end Normal_Aggregate;

   function Normal_Aggregate_In_ER return Child is
   begin
      return Result : Child :=
                        (Parent with Comp_2 => Make_Ctrl,
                                     Comp_3 => To_Unbounded_String ("Comp_3"))
      do null; end return;
   end Normal_Aggregate_In_ER;
end Aggregates;

--  leaks.adb

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

procedure Leaks is
begin
   Put_Line ("Box aggregate");
   declare
      Aggr_1 : constant Child := Box_Aggregate;
   begin null; end;

   Put_Line ("Box aggregate in extended return");
   declare
      Aggr_2 : constant Child := Box_Aggregate_In_ER;
   begin null; end;

   Put_Line ("Notmal aggregate");
   declare
      Aggr_3 : constant Child := Normal_Aggregate;
   begin null; end;

   Put_Line ("Notmal aggregate in extended return");
   declare
      Aggr_4 : constant Child := Normal_Aggregate;
   begin null; end;
end Leaks;

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

$ gnatmake -q leaks.adb -largs -lgmem
$ ./leaks
$ gnatmem ./leaks > leaks.txt
$ grep "Number of non freed allocations" leaks.txt
Box aggregate
  ini: 100
  adj: 100 -> 101
  fin: 100
  adj: 101 -> 102
  fin: 101
  adj: 102 -> 103
  fin: 102
  adj: 103 -> 104
  fin: 103
  fin: 104
Box aggregate in extended return
  ini: 200
  adj: 200 -> 201
  fin: 200
  adj: 201 -> 202
  fin: 201
  adj: 202 -> 203
  fin: 202
  adj: 203 -> 204
  fin: 203
  fin: 204
Notmal aggregate
  ini: 300
  adj: 300 -> 301
  fin: 300
  adj: 301 -> 302
  fin: 301
  adj: 302 -> 303
  fin: 302
  adj: 303 -> 304
  fin: 303
  fin: 304
Notmal aggregate in extended return
  ini: 400
  adj: 400 -> 401
  fin: 400
  adj: 401 -> 402
  fin: 401
  adj: 402 -> 403
  fin: 402
  adj: 403 -> 404
  fin: 403
  fin: 404
   Total number of allocations        :   4
   Total number of deallocations      :   4

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

2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
	is now used as Is_Ignored_Transient.
	(Is_Finalized_Transient): New routine.
	(Is_Ignored_Transient): New routine.
	(Is_Processed_Transient): Removed.
	(Set_Is_Finalized_Transient): New routine.
	(Set_Is_Ignored_Transient): New routine.
	(Set_Is_Processed_Transient): Removed.
	(Write_Entity_Flags): Output Flag252 and Flag295.
	* einfo.ads: New attributes Is_Finalized_Transient
	and Is_Ignored_Transient along with occurrences in
	entities. Remove attribute Is_Processed_Transient.
	(Is_Finalized_Transient): New routine along with pragma Inline.
	(Is_Ignored_Transient): New routine along with pragma Inline.
	(Is_Processed_Transient): Removed along with pragma Inline.
	(Set_Is_Finalized_Transient): New routine along with pragma Inline.
	(Set_Is_Ignored_Transient): New routine along with pragma Inline.
	(Set_Is_Processed_Transient): Removed along with pragma Inline.
	* exp_aggr.adb Add with and use clauses for Exp_Ch11 and Inline.
	(Build_Record_Aggr_Code): Change the handling
	of controlled record components.
	(Ctrl_Init_Expression): Removed.
	(Gen_Assign): Add new formal parameter In_Loop
	along with comment on usage.  Remove local variables Stmt and
	Stmt_Expr. Change the handling of controlled array components.
	(Gen_Loop): Update the call to Gen_Assign.
	(Gen_While): Update the call to Gen_Assign.
	(Initialize_Array_Component): New routine.
	(Initialize_Ctrl_Array_Component): New routine.
	(Initialize_Ctrl_Record_Component): New routine.
	(Initialize_Record_Component): New routine.
	(Process_Transient_Component): New routine.
	(Process_Transient_Component_Completion): New routine.
	* exp_ch4.adb (Process_Transient_In_Expression): New routine.
	(Process_Transient_Object): Removed. Replace all existing calls
	to this routine with calls to Process_Transient_In_Expression.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Remove local constant
	Is_Elem_Ref. Update the comment on ignoring transients.
	* exp_ch7.adb (Process_Declarations): Do not process ignored
	or finalized transient objects.
	(Process_Transient_In_Scope): New routine.
	(Process_Transients_In_Scope): New routine.
	(Process_Transient_Objects): Removed. Replace all existing calls
	to this routine with calls to Process_Transients_In_Scope.
	* exp_util.adb (Build_Transient_Object_Statements): New routine.
	(Is_Finalizable_Transient): Do not consider a transient object
	which has been finalized.
	(Requires_Cleanup_Actions): Do not consider ignored or finalized
	transient objects.
	* exp_util.ads (Build_Transient_Object_Statements): New routine.
	* sem_aggr.adb: Major code clean up.
	* sem_res.adb: Update documentation.

[Ada] Missing finalization of defaulted aggregate in extended return

Commit Message

Patch