This patch updates the finalization machinery to recognize a case where the result of a class-wide interface function call with multiple actual parameters that appears in Object.Operation format requires finalization actions.
------------ -- Source -- ------------ -- types.ads with Ada.Finalization; use Ada.Finalization; package Types is type Iface is interface; type Constructor is tagged null record; function Make_Any_Iface (C : in out Constructor; Val : Natural) return Iface'Class; type Ctrl is new Controlled and Iface 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); 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 Old_Id : constant Natural := Obj.Id; New_Id : constant Natural := Old_Id * 10; begin Put_Line (" adj" & Old_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; function Make_Any_Iface (C : in out Constructor; Val : Natural) return Iface'Class is Result : Ctrl; begin return Result; end Make_Any_Iface; end Types; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with Types; use Types; procedure Main is begin Put_Line ("Main start"); declare C : Constructor; Obj : Iface'Class := C.Make_Any_Iface (1); begin null; end; Put_Line ("Main end"); end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q main.adb $ ./main Main start ini 1 adj 1 => 10 fin 1 adj 10 => 100 fin 10 fin 100 Main end Tested on x86_64-pc-linux-gnu, committed on trunk 2014-07-17 Hristian Kirtchev <kirtc...@adacore.com> * exp_util.adb (Is_Controlled_Function_Call): Recognize a controlled function call with multiple actual parameters that appears in Object.Operation form.
Index: exp_util.adb =================================================================== --- exp_util.adb (revision 212655) +++ exp_util.adb (working copy) @@ -4214,7 +4214,8 @@ (Obj_Id : Entity_Id) return Boolean is function Is_Controlled_Function_Call (N : Node_Id) return Boolean; - -- Determine if particular node denotes a controlled function call + -- Determine if particular node denotes a controlled function call. The + -- call may have been heavily expanded. function Is_Displace_Call (N : Node_Id) return Boolean; -- Determine whether a particular node is a call to Ada.Tags.Displace. @@ -4233,12 +4234,22 @@ begin if Nkind (Expr) = N_Function_Call then Expr := Name (Expr); - end if; - -- The function call may appear in object.operation format + -- When a function call appears in Object.Operation format, the + -- original representation has two possible forms depending on the + -- availability of actual parameters: + -- + -- Obj.Func_Call -- N_Selected_Component + -- Obj.Func_Call (Param) -- N_Indexed_Component - if Nkind (Expr) = N_Selected_Component then - Expr := Selector_Name (Expr); + else + if Nkind (Expr) = N_Indexed_Component then + Expr := Prefix (Expr); + end if; + + if Nkind (Expr) = N_Selected_Component then + Expr := Selector_Name (Expr); + end if; end if; return