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
