Comments
Patch
===================================================================
@@ -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;
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.