From: Eric Botcazou <ebotca...@adacore.com>
The resolution made some time ago had been that a dynamic allocation for
a limited type that needs finalization with a function call as expression
always needs to be done in the called function, even if the limited type
has a known size. But the fix implementing this resolution was dropped
inadvertently at some point.
The change also contains a small tweak for Expand_N_Object_Declaration
and a small related cleanup in the finalization machinery.
gcc/ada/
* exp_ch3.adb (Expand_N_Object_Declaration): In the case of a
return object of a BIP function that needs finalization, save
the assignment statement made to initialize it, if any.
* exp_ch6.ads (BIP_Formal_Kind): Adjust description.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Make a
couple of adjustments to the commentary.
(Needs_BIP_Alloc_Form): Also return true if the function needs
a BIP_Finalization_Master parameter.
* exp_ch7.adb (Build_BIP_Cleanup_Stmts): Remove now always true
test on Needs_BIP_Alloc_Form.
(Attach_Object_To_Master_Node): Remove duplication in comment.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 8 +++++
gcc/ada/exp_ch6.adb | 34 ++++++++++----------
gcc/ada/exp_ch6.ads | 22 +++++++------
gcc/ada/exp_ch7.adb | 75 ++++++++++++++++-----------------------------
4 files changed, 64 insertions(+), 75 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f934dbfddaa..4ebc7b977e9 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -8746,6 +8746,14 @@ package body Exp_Ch3 is
Initialize_Return_Object
(Tag_Assign, Adj_Call, Expr_Q, Init_Stmt, Init_After);
+ -- Save the assignment statement when returning a controlled
+ -- object. This reference is used later by the finalization
+ -- machinery to mark the object as successfully initialized.
+
+ if Present (Init_Stmt) and then Needs_Finalization (Typ) then
+ Set_Last_Aggregate_Assignment (Def_Id, Init_Stmt);
+ end if;
+
-- Replace the return object declaration with a renaming of a
-- dereference of the access value designating the return object.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a89c9af0bb2..9e1844aa08e 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -158,9 +158,9 @@ package body Exp_Ch6 is
Alloc_Form : BIP_Allocation_Form := Unspecified;
Alloc_Form_Exp : Node_Id := Empty;
Pool_Actual : Node_Id := Make_Null (No_Location));
- -- Ada 2005 (AI-318-02): Add the actuals needed for a build-in-place
- -- function call that returns a caller-unknown-size result (BIP_Alloc_Form
- -- and BIP_Storage_Pool). If Alloc_Form_Exp is present, then use it,
+ -- Ada 2005 (AI-318-02): If the result type of a build-in-place call needs
+ -- them, add the actuals parameters BIP_Alloc_Form and BIP_Storage_Pool.
+ -- If Alloc_Form_Exp is present, then pass it for the first parameter,
-- otherwise pass a literal corresponding to the Alloc_Form parameter
-- (which must not be Unspecified in that case). Pool_Actual is the
-- parameter to pass to BIP_Storage_Pool.
@@ -8328,9 +8328,11 @@ package body Exp_Ch6 is
Set_Can_Never_Be_Null (Acc_Type, False);
-- It gets initialized to null, so we can't have that
- -- When the result subtype is constrained, the return object is created
- -- on the caller side, and access to it is passed to the function. This
- -- optimization is disabled when the result subtype needs finalization
+ -- When the result subtype is returned on the secondary stack or is
+ -- tagged, the called function itself must perform the allocation of
+ -- the return object, so we pass parameters indicating that.
+
+ -- But that's also the case when the result subtype needs finalization
-- actions because the caller side allocation may result in undesirable
-- finalization. Consider the following example:
--
@@ -8351,11 +8353,6 @@ package body Exp_Ch6 is
-- will be finalized when access type Lim_Ctrl_Ptr goes out of scope
-- since it is already attached on the related finalization master.
- -- Here and in related routines, we must examine the full view of the
- -- type, because the view at the point of call may differ from the
- -- one in the function body, and the expansion mechanism depends on
- -- the characteristics of the full view.
-
if Needs_BIP_Alloc_Form (Function_Id) then
Temp_Init := Empty;
@@ -8386,6 +8383,10 @@ package body Exp_Ch6 is
Return_Obj_Actual := Empty;
+ -- When the result subtype neither is returned on the secondary stack
+ -- nor is tagged, the return object is created on the caller side, and
+ -- access to it is passed to the function.
+
else
-- Replace the initialized allocator of form "new T'(Func (...))"
-- with an uninitialized allocator of form "new T", where T is the
@@ -8428,11 +8429,6 @@ package body Exp_Ch6 is
(Result_Subt,
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Return_Obj_Access, Loc)));
-
- -- When the result subtype is unconstrained, the function itself must
- -- perform the allocation of the return object, so we pass parameters
- -- indicating that.
-
end if;
-- Declare the temp object
@@ -9636,6 +9632,12 @@ package body Exp_Ch6 is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
+ -- See Make_Build_In_Place_Call_In_Allocator for the rationale
+
+ if Needs_BIP_Finalization_Master (Func_Id) then
+ return True;
+ end if;
+
-- A formal giving the allocation method is needed for build-in-place
-- functions whose result type is returned on the secondary stack or
-- is a tagged type. Tagged primitive build-in-place functions need
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 12a9ce3f1b8..79e4120cef1 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -47,8 +47,8 @@ package Exp_Ch6 is
-- nodes (e.g. the filling of the corresponding Dispatch Table for
-- Primitive Operations)
- -- The following type defines the various forms of allocation used for the
- -- results of build-in-place function calls.
+ -- Ada 2005 (AI-318-02): The following type defines the various forms of
+ -- allocation used for the result of build-in-place function calls.
type BIP_Allocation_Form is
(Unspecified,
@@ -57,22 +57,24 @@ package Exp_Ch6 is
Global_Heap,
User_Storage_Pool);
- type BIP_Formal_Kind is
-- Ada 2005 (AI-318-02): This type defines the kinds of implicit extra
-- formals created for build-in-place functions. The order of these
-- enumeration literals matches the order in which the formals are
-- declared. See Sem_Ch6.Create_Extra_Formals.
+ type BIP_Formal_Kind is
(BIP_Alloc_Form,
- -- Present if result subtype is unconstrained or tagged. Indicates
- -- whether the return object is allocated by the caller or callee, and
- -- if the callee, whether to use the secondary stack or the heap. See
- -- Create_Extra_Formals.
+ -- Present if result subtype is returned on the secondary stack or is
+ -- tagged: in this case, this indicates whether the return object is
+ -- allocated by the caller or callee, and if the callee, whether to
+ -- use the secondary stack, the global heap or a storage pool. Also
+ -- present if result type needs finalization.
BIP_Storage_Pool,
- -- Present if result subtype is unconstrained or tagged. If
- -- BIP_Alloc_Form = User_Storage_Pool, this is a pointer to the pool
- -- (of type access to Root_Storage_Pool'Class). Otherwise null.
+ -- Present if result subtype is returned on the secondary stack or is
+ -- tagged: in this case, if BIP_Alloc_Form = User_Storage_Pool, this
+ -- is a pointer to the pool (of type Root_Storage_Pool_Ptr); otherwise
+ -- this is null. Also present if result type needs finalization.
BIP_Finalization_Master,
-- Present if result type needs finalization. Pointer to caller's
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index e8dfdb02496..693d9b1c5a7 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -595,8 +595,9 @@ package body Exp_Ch7 is
-- then
-- declare
-- type Ptr_Typ is access Fun_Typ;
- -- for Ptr_Typ'Storage_Pool
- -- use Base_Pool (BIPfinalizationmaster);
+ -- for Ptr_Typ'Storage_Pool use
+ -- Base_Pool (BIPfinalizationmaster.all).all;
+ --
-- begin
-- Free (Ptr_Typ (Obj_Addr));
-- end;
@@ -612,10 +613,11 @@ package body Exp_Ch7 is
(Func_Id : Entity_Id;
Obj_Addr : Node_Id) return Node_Id
is
+ Alloc_Id : constant Entity_Id :=
+ Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
Decls : constant List_Id := New_List;
Fin_Mas_Id : constant Entity_Id :=
- Build_In_Place_Formal
- (Func_Id, BIP_Finalization_Master);
+ Build_In_Place_Formal (Func_Id, BIP_Finalization_Master);
Func_Typ : constant Entity_Id := Etype (Func_Id);
Cond : Node_Id;
@@ -700,38 +702,22 @@ package body Exp_Ch7 is
Statements => New_List (Free_Stmt)));
-- Generate:
- -- if BIPfinalizationmaster /= null then
-
- Cond :=
- Make_Op_Ne (Loc,
- Left_Opnd => New_Occurrence_Of (Fin_Mas_Id, Loc),
- Right_Opnd => Make_Null (Loc));
-
- -- For unconstrained or tagged results, escalate the condition to
- -- include the allocation format. Generate:
-
-- if BIPallocform > Secondary_Stack'Pos
-- and then BIPfinalizationmaster /= null
-- then
- if Needs_BIP_Alloc_Form (Func_Id) then
- declare
- Alloc : constant Entity_Id :=
- Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
- begin
- Cond :=
- Make_And_Then (Loc,
- Left_Opnd =>
- Make_Op_Gt (Loc,
- Left_Opnd => New_Occurrence_Of (Alloc, Loc),
- Right_Opnd =>
- Make_Integer_Literal (Loc,
- UI_From_Int
- (BIP_Allocation_Form'Pos (Secondary_Stack)))),
-
- Right_Opnd => Cond);
- end;
- end if;
+ Cond :=
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_Op_Gt (Loc,
+ Left_Opnd => New_Occurrence_Of (Alloc_Id, Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ UI_From_Int (BIP_Allocation_Form'Pos (Secondary_Stack)))),
+ Right_Opnd =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => New_Occurrence_Of (Fin_Mas_Id, Loc),
+ Right_Opnd => Make_Null (Loc)));
-- Generate:
-- if <Cond> then
@@ -744,12 +730,16 @@ package body Exp_Ch7 is
Then_Statements => New_List (Free_Blk));
end Build_BIP_Cleanup_Stmts;
+ -- Local variables
+
Fin_Id : Entity_Id;
Master_Node_Attach : Node_Id;
Master_Node_Ins : Node_Id;
Obj_Ref : Node_Id;
Obj_Typ : Entity_Id;
+ -- Start of processing for Attach_Object_To_Master_Node
+
begin
-- Finalize_Address is not generated in CodePeer mode because the
-- body contains address arithmetic. So we don't want to generate
@@ -790,23 +780,10 @@ package body Exp_Ch7 is
Obj_Typ := Available_View (Designated_Type (Obj_Typ));
end if;
- -- If we are dealing with a return object of a build-in-place
- -- function, generate the following cleanup statements:
-
- -- if BIPallocform > Secondary_Stack'Pos
- -- and then BIPfinalizationmaster /= null
- -- then
- -- declare
- -- type Ptr_Typ is access Obj_Typ;
- -- for Ptr_Typ'Storage_Pool use
- -- Base_Pool (BIPfinalizationmaster.all).all;
- -- begin
- -- Free (Ptr_Typ (Obj'Address));
- -- end;
- -- end if;
-
- -- The generated code effectively detaches the temporary from the
- -- caller finalization master and deallocates the object.
+ -- If we are dealing with a return object of a build-in-place function
+ -- and its allocation has been done in the function, we additionally
+ -- need to detach it from the caller's finalization master in order to
+ -- prevent double finalization.
if Present (Func_Id)
and then Is_Build_In_Place_Function (Func_Id)
--
2.43.2
