Patchwork [Ada] Redundant finalization of controlled function result

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 6, 2012, 7:59 a.m.
Message ID <20120806075906.GA4344@adacore.com>
Download mbox | patch
Permalink /patch/175288/
State New
Headers show

Comments

Arnaud Charlet - Aug. 6, 2012, 7:59 a.m.
This patch removes obsolete code related to array initialization. When an array
is initialized by an aggregate, the compiler may generate a loop to initialize
all elements. If the aggregate contains controlled function calls, the loop
statements are wrapped in a block for finalization purposes. The block already
handles proper finalization of transient objects so it no longer needs the
specialized processing performed in Process_Transient_Objects.

------------
-- 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);
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;
end Types;

--  main.adb

with Types; use Types;

procedure Main is
   function Create return Ctrl is
   begin
      return Obj : Ctrl;
   end Create;

   Container : array (1 .. 2) of Ctrl := (others => Create);
begin
   null;
end Main;

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

$ gnatmake -q -gnat05 main.adb
$ ./main
   ini 1
   adj 1 -> 100
   fin 1
   adj 100 -> 10000
   fin 100
   ini 2
   adj 2 -> 200
   fin 2
   adj 200 -> 20000
   fin 200
   fin 20000
   fin 10000

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

2012-08-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop
	processing related to array initialization. The expansion of
	loops already contains a mechanism to detect controlled objects
	generated by expansion and introduce a block around the loop
	statements for finalization purposes.

Patch

Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 190155)
+++ exp_ch7.adb	(working copy)
@@ -4585,48 +4585,12 @@ 
                end if;
 
                Prev_Fin := Fin_Block;
+            end if;
 
-            --  When the associated node is an array object, the expander may
-            --  sometimes generate a loop and create transient objects inside
-            --  the loop.
+            --  Terminate the scan after the last object has been processed to
+            --  avoid touching unrelated code.
 
-            elsif Nkind (Related_Node) = N_Object_Declaration
-              and then Is_Array_Type
-                         (Base_Type
-                           (Etype (Defining_Identifier (Related_Node))))
-              and then Nkind (Stmt) = N_Loop_Statement
-            then
-               declare
-                  Block_HSS : Node_Id := First (Statements (Stmt));
-
-               begin
-                  --  The loop statements may have been wrapped in a block by
-                  --  Process_Statements_For_Controlled_Objects, inspect the
-                  --  handled sequence of statements.
-
-                  if Nkind (Block_HSS) = N_Block_Statement
-                    and then No (Next (Block_HSS))
-                  then
-                     Block_HSS := Handled_Statement_Sequence (Block_HSS);
-
-                     Process_Transient_Objects
-                       (First_Object => First (Statements (Block_HSS)),
-                        Last_Object  => Last (Statements (Block_HSS)),
-                        Related_Node => Related_Node);
-
-                  --  Inspect the statements of the loop
-
-                  else
-                     Process_Transient_Objects
-                       (First_Object => First (Statements (Stmt)),
-                        Last_Object  => Last (Statements (Stmt)),
-                        Related_Node => Related_Node);
-                  end if;
-               end;
-
-            --  Terminate the scan after the last object has been processed
-
-            elsif Stmt = Last_Object then
+            if Stmt = Last_Object then
                exit;
             end if;