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 <kirtc...@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.
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;
