@@ -749,6 +749,7 @@ package body Exp_Ch7 is
Desig_Typ : Entity_Id;
FM_Id : Entity_Id;
Priv_View : Entity_Id;
+ Scop : Entity_Id;
Unit_Decl : Node_Id;
Unit_Id : Entity_Id;
@@ -787,6 +788,18 @@ package body Exp_Ch7 is
Desig_Typ := Priv_View;
end if;
+ -- For a designated type not declared at library level, we cannot create
+ -- a finalization collection attached to an outer unit since this would
+ -- generate dangling references to the dynamic scope through access-to-
+ -- procedure values designating the local Finalize_Address primitive.
+
+ Scop := Enclosing_Dynamic_Scope (Desig_Typ);
+ if Scop /= Standard_Standard
+ and then Scope_Depth (Scop) > Scope_Depth (Unit_Id)
+ then
+ return;
+ end if;
+
-- Determine whether the current semantic unit already has an anonymous
-- master which services the designated type.
@@ -936,6 +936,16 @@ package body Exp_Util is
Needs_Finalization (Desig_Typ)
and then not No_Heap_Finalization (Ptr_Typ);
+ -- The allocation/deallocation of a controlled object must be associated
+ -- with an attachment to/detachment from a finalization master, but the
+ -- implementation cannot guarantee this property for every anonymous
+ -- access tyoe, see Build_Anonymous_Collection.
+
+ if Needs_Fin and then No (Finalization_Master (Ptr_Typ)) then
+ pragma Assert (Ekind (Ptr_Typ) = E_Anonymous_Access_Type);
+ Needs_Fin := False;
+ end if;
+
if Needs_Fin then
-- Do nothing if the access type may never allocate / deallocate
@@ -945,11 +955,6 @@ package body Exp_Util is
return;
end if;
- -- The allocation / deallocation of a controlled object must be
- -- chained on / detached from a finalization master.
-
- pragma Assert (Present (Finalization_Master (Ptr_Typ)));
-
-- The only other kind of allocation / deallocation supported by this
-- routine is on / from a subpool.
@@ -5679,19 +5679,19 @@ package body Sem_Res is
Set_Is_Dynamic_Coextension (N, False);
Set_Is_Static_Coextension (N, False);
- -- Anonymous access-to-controlled objects are not finalized on
- -- time because this involves run-time ownership and currently
- -- this property is not available. In rare cases the object may
- -- not be finalized at all. Warn on potential issues involving
- -- anonymous access-to-controlled objects.
+ -- Objects allocated through anonymous access types are not
+ -- finalized on time because this involves run-time ownership
+ -- and currently this property is not available. In rare cases
+ -- the object might not be finalized at all. Warn on potential
+ -- issues involving anonymous access-to-controlled types.
if Ekind (Typ) = E_Anonymous_Access_Type
and then Is_Controlled_Active (Desig_T)
then
Error_Msg_N
- ("??object designated by anonymous access object might "
+ ("??object designated by anonymous access value might "
& "not be finalized until its enclosing library unit "
- & "goes out of scope", N);
+ & "goes out of scope, or not be finalized at all", N);
Error_Msg_N ("\use named access type instead", N);
end if;
end if;