This patch modifies the finalization machinery to detect a subprogram call
that returns a constrolled transient temporary in the context of a function
call that returns an unconstrained result as part of the initialization
expression of an object declaration.
------------
-- Source --
------------
-- types.ads
with Ada.Finalization; use Ada.Finalization;
package Types is
Ctrl_Error : exception;
type Ctrl is new Controlled with record
Id : Natural := 0;
Data : Natural;
end record;
procedure Adjust (Obj : in out Ctrl);
procedure Finalize (Obj : in out Ctrl);
procedure Initialize (Obj : in out Ctrl);
function Get_Id (Obj : Ctrl) return String; -- raises Ctrl_Error
function Make_Ctrl (Data : Natural) return 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 * 100;
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);
Obj.Id := 0;
end Finalize;
function Get_Id (Obj : Ctrl) return String is
begin
raise Ctrl_Error;
return Obj.Id'Img;
end Get_Id;
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_Ctrl (Data : Natural) return Ctrl is
Obj : Ctrl;
begin
Obj.Data := Data;
return Obj;
end Make_Ctrl;
end Types;
-- trans_final.adb
with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
procedure Trans_Final is
begin
declare
Id : constant String := Get_Id (Make_Ctrl (123));
begin
Put_Line ("ERROR: exception not raised");
end;
exception
when Ctrl_Error => Put_Line ("OK");
when others => Put_Line ("ERROR: unexpected exception");
end Trans_Final;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q trans_final.adb
$ ./trans_final
ini: 1
adj: 1 => 100
fin: 1
fin: 100
OK
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-30 Hristian Kirtchev <kirtc...@adacore.com>
* exp_ch7.adb (Is_Subprogram_Call): Account for the case where an
object declaration initialized by a function call that returns
an unconstrained result may be rewritted as a renaming of the
secondary stack result.
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 216770)
+++ exp_ch7.adb (working copy)
@@ -4532,11 +4532,14 @@
function Is_Subprogram_Call (N : Node_Id) return Traverse_Result is
begin
-- Complex constructs are factored out by the expander and their
- -- occurrences are replaced with references to temporaries. Due to
- -- this expansion activity, inspect the original tree to detect
- -- subprogram calls.
+ -- occurrences are replaced with references to temporaries or
+ -- object renamings. Due to this expansion activity, inspect the
+ -- original tree to detect subprogram calls.
- if Nkind (N) = N_Identifier and then Original_Node (N) /= N then
+ if Nkind_In (N, N_Identifier,
+ N_Object_Renaming_Declaration)
+ and then Original_Node (N) /= N
+ then
Detect_Subprogram_Call (Original_Node (N));
-- The original construct contains a subprogram call, there is
