diff options
| -rw-r--r-- | gcc/ada/libgnat/s-finpri.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-stposu.adb | 9 |
2 files changed, 16 insertions, 13 deletions
diff --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb index 2abc9f4..731c913 100644 --- a/gcc/ada/libgnat/s-finpri.adb +++ b/gcc/ada/libgnat/s-finpri.adb @@ -174,18 +174,16 @@ package body System.Finalization_Primitives is if Collection.Finalization_Started then Unlock_Task.all; - -- Double finalization may occur during the handling of stand alone - -- libraries or the finalization of a pool with subpools. Due to the - -- potential aliasing of masters in these two cases, do not process - -- the same master twice. + -- Double finalization may occur during the handling of stand-alone + -- libraries or the finalization of a pool with subpools. return; end if; - -- Lock the master to prevent any allocations while the objects are - -- being finalized. The master remains locked because either the master - -- is explicitly deallocated or the associated access type is about to - -- go out of scope. + -- Lock the collection to prevent any allocation while the objects are + -- being finalized. The collection remains locked because either it is + -- explicitly deallocated or the associated access type is about to go + -- out of scope. -- Synchronization: -- Read - allocation, finalization @@ -193,6 +191,12 @@ package body System.Finalization_Primitives is Collection.Finalization_Started := True; + -- Note that we cannot walk the list while finalizing its elements + -- because the finalization of one may call Unchecked_Deallocation + -- on another and, therefore, detach it from anywhere on the list. + -- Instead, we empty the list by repeatedly finalizing the first + -- element (after the dummy head) and detaching it from the list. + while not Is_Empty_List (Collection.Head'Unchecked_Access) loop Curr_Ptr := Collection.Head.Next; diff --git a/gcc/ada/libgnat/s-stposu.adb b/gcc/ada/libgnat/s-stposu.adb index ebbd3e4..8d232fa 100644 --- a/gcc/ada/libgnat/s-stposu.adb +++ b/gcc/ada/libgnat/s-stposu.adb @@ -196,17 +196,16 @@ package body System.Storage_Pools.Subpools is -- object or a record with controlled components. if Is_Controlled then - - -- Synchronization: - -- Read - allocation, finalization - -- Write - finalization - Lock_Taken := True; Lock_Task.all; -- Do not allow the allocation of controlled objects while the -- associated collection is being finalized. + -- Synchronization: + -- Read - allocation, finalization + -- Write - finalization + if Finalization_Started (Collection.all) then raise Program_Error with "allocation after finalization started"; end if; |