This patch updates the mechanism which detects build-in-place function calls returning controlled results on the secondary stack.
------------ -- Source -- ------------ -- types.ads with Ada.Finalization; use Ada.Finalization; package Types is type Ctrl_Comp is new Limited_Controlled with null record; procedure Finalize (Obj : in out Ctrl_Comp); type Root is tagged limited null record; type Root_Ptr is access all Root'Class; function Create (Ctrl : Boolean) return Root'Class; type Empty_Child is new Root with null record; type Ctrl_Child is new Root with record Comp : Ctrl_Comp; end record; end Types; -- types.adb with Ada.Text_IO; use Ada.Text_IO; package body Types is function Create (Ctrl : Boolean) return Root'Class is begin if Ctrl then return Result : Ctrl_Child; else return Result : Empty_Child; end if; end Create; procedure Finalize (Obj : in out Ctrl_Comp) is begin Put_Line (" Finalize"); end Finalize; end Types; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with Types; use Types; procedure Main is pragma Suppress (Accessibility_Check); begin Put_Line ("Empty child"); declare Obj : Root_Ptr := new Root'Class'(Create (False)); begin Put_Line ("Empty child allocated"); end; Put_Line ("Ctrl child"); declare Obj : Root_Ptr := new Root'Class'(Create (True)); begin Put_Line ("Ctrl child allocated"); end; Put_Line ("End"); end Main; ------------------------------------- -- Compilation and expected output -- ------------------------------------- $ gnatmake -q -gnat05 main.adb $ ./main Empty child Empty child allocated Ctrl child Ctrl child allocated End Finalize Tested on x86_64-pc-linux-gnu, committed on trunk 2012-03-30 Hristian Kirtchev <kirtc...@adacore.com> * exp_util.adb (Is_Secondary_Stack_BIP_Func_Call): Handle a case where a build-in-place call appears as Prefix'Reference'Reference.
Index: exp_util.adb =================================================================== --- exp_util.adb (revision 186001) +++ exp_util.adb (working copy) @@ -4889,11 +4889,13 @@ Call : Node_Id := Expr; begin - -- Build-in-place calls usually appear in 'reference format + -- Build-in-place calls usually appear in 'reference format. Note that + -- the accessibility check machinery may add an extra 'reference due to + -- side effect removal. - if Nkind (Call) = N_Reference then + while Nkind (Call) = N_Reference loop Call := Prefix (Call); - end if; + end loop; if Nkind_In (Call, N_Qualified_Expression, N_Unchecked_Type_Conversion)