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.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e84937f6d840f6b17c998517291374f6a2a16679..7010256b1a942e248cfeaf9140bf6e711e2b327c 100644 (file)
--- 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 5db9659c1bdf2d18d8d689758dda0f2fc0e6967d..f6c243086b10cda3d18ac05d58166c09a5d9a736 100644 (file)
--- 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.