===================================================================
@@ -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
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 <kirtchev@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.