diff options
| author | Steve Baird <baird@adacore.com> | 2020-08-08 15:04:21 -0700 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-21 03:22:50 -0400 |
| commit | 3d3378fbb2f0183d0b6bfc41187c941dc57f7dcc (patch) | |
| tree | 0960b998a0714563bfcef72680175fbe6d2826cb /gcc | |
| parent | cb7584a41d9f565a90fc24c418b2c7f0233ba31e (diff) | |
| download | gcc-3d3378fbb2f0183d0b6bfc41187c941dc57f7dcc.zip gcc-3d3378fbb2f0183d0b6bfc41187c941dc57f7dcc.tar.gz gcc-3d3378fbb2f0183d0b6bfc41187c941dc57f7dcc.tar.bz2 | |
[Ada] Implement missing function result finalization.
gcc/ada/
* exp_ch6.adb (Insert_Post_Call_Actions): When a function's
result type requires finalization and we decide to make copy of
a call to the function and subsequently refer only to the copy,
then don't forget to finalize the original function result
object.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 80 |
1 files changed, 73 insertions, 7 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index b04d1c0..d8f74ef 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8390,13 +8390,28 @@ package body Exp_Ch6 is -- the write back to be skipped completely. -- To deal with this, we replace the call by - + -- -- do -- Tnnn : constant function-result-type := function-call; -- Post_Call actions -- in -- Tnnn; -- end; + -- + -- However, that doesn't work if function-result-type requires + -- finalization (because function-call's result never gets + -- finalized). So in that case, we instead replace the call by + -- + -- do + -- type Ref is access all function-result-type; + -- Ptr : constant Ref := function-call'Reference; + -- Tnnn : constant function-result-type := Ptr.all; + -- Finalize (Ptr.all); + -- Post_Call actions + -- in + -- Tnnn; + -- end; + -- declare Loc : constant Source_Ptr := Sloc (N); @@ -8405,12 +8420,63 @@ package body Exp_Ch6 is Name : constant Node_Id := Relocate_Node (N); begin - Prepend_To (Post_Call, - Make_Object_Declaration (Loc, - Defining_Identifier => Tnnn, - Object_Definition => New_Occurrence_Of (FRTyp, Loc), - Constant_Present => True, - Expression => Name)); + if Needs_Finalization (FRTyp) then + declare + Ptr_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); + + Ptr_Typ_Decl : constant Node_Id := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ptr_Typ, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Subtype_Indication => + New_Occurrence_Of (FRTyp, Loc))); + + Ptr_Obj : constant Entity_Id := + Make_Temporary (Loc, 'P'); + + Ptr_Obj_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Ptr_Obj, + Object_Definition => + New_Occurrence_Of (Ptr_Typ, Loc), + Constant_Present => True, + Expression => + Make_Attribute_Reference (Loc, + Prefix => Name, + Attribute_Name => Name_Unrestricted_Access)); + + function Ptr_Dereference return Node_Id is + (Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Ptr_Obj, Loc))); + + Tnn_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Tnnn, + Object_Definition => New_Occurrence_Of (FRTyp, Loc), + Constant_Present => True, + Expression => Ptr_Dereference); + + Finalize_Call : constant Node_Id := + Make_Final_Call + (Obj_Ref => Ptr_Dereference, Typ => FRTyp); + begin + -- Prepend in reverse order + + Prepend_To (Post_Call, Finalize_Call); + Prepend_To (Post_Call, Tnn_Decl); + Prepend_To (Post_Call, Ptr_Obj_Decl); + Prepend_To (Post_Call, Ptr_Typ_Decl); + end; + else + Prepend_To (Post_Call, + Make_Object_Declaration (Loc, + Defining_Identifier => Tnnn, + Object_Definition => New_Occurrence_Of (FRTyp, Loc), + Constant_Present => True, + Expression => Name)); + end if; Rewrite (N, Make_Expression_With_Actions (Loc, |