From bb4a081156175cf7ac7a818c6a669d3f63ea0ad8 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 28 Oct 2024 08:33:49 +0100 Subject: ada: Fix premature finalization of anonymous access result from library function In GNAT's implementation, the finalization of controlled objects created through anonymous access types occurs when the enclosing library unit goes out of scope if this is safe, and never occurs otherwise. The case of a function that is a library unit with an anonymous access result type falls in the second category for the anonymous access result type itself and, therefore, finalization cannot take place for it. gcc/ada/ChangeLog: PR ada/55725 * exp_ch6.adb (Add_Collection_Actual_To_Build_In_Place_Call): Be prepared for no collection if the access type is anonymous. * exp_ch7.adb (Build_Anonymous_Collection): Return early for the anonymous access result type of a library function. --- gcc/ada/exp_ch6.adb | 19 ++++++++++++------- gcc/ada/exp_ch7.adb | 13 +++++++++++++ 2 files changed, 25 insertions(+), 7 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e84937f..7010256 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -539,15 +539,20 @@ package body Exp_Ch6 is Build_Anonymous_Collection (Ptr_Typ); end if; - -- Access-to-controlled types should always have a collection + -- Named access-to-controlled types must have a collection, but + -- anonymous access-to-controlled types need not. - pragma Assert (Present (Finalization_Collection (Ptr_Typ))); + if Present (Finalization_Collection (Ptr_Typ)) then + Actual := + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of + (Finalization_Collection (Ptr_Typ), Loc), + Attribute_Name => Name_Unrestricted_Access); - Actual := - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Finalization_Collection (Ptr_Typ), Loc), - Attribute_Name => Name_Unrestricted_Access); + else pragma Assert (Ekind (Ptr_Typ) = E_Anonymous_Access_Type); + Actual := Make_Null (Loc); + end if; -- Tagged types diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 5db9659..f6c2430 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1304,6 +1304,19 @@ package body Exp_Ch7 is return; end if; + -- For the access result type of a function that is a library unit, + -- we cannot create a finalization collection attached to the unit as + -- this would cause premature finalization of objects created through + -- the access result type, which may be returned from the function. + + if Is_Local_Anonymous_Access (Ptr_Typ) + and then Ekind (Unit_Id) = E_Function + and then Parent (Ptr_Typ) = + Result_Definition (Subprogram_Specification (Unit_Id)) + then + return; + end if; + -- Determine whether the current semantic unit already has an anonymous -- collection which services the designated type. -- cgit v1.1