diff options
| -rw-r--r-- | gcc/ada/libgnat/s-stposu.adb | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/gcc/ada/libgnat/s-stposu.adb b/gcc/ada/libgnat/s-stposu.adb index b643d3f..ff61cfb 100644 --- a/gcc/ada/libgnat/s-stposu.adb +++ b/gcc/ada/libgnat/s-stposu.adb @@ -117,11 +117,12 @@ package body System.Storage_Pools.Subpools is Is_Subpool_Allocation : constant Boolean := Pool in Root_Storage_Pool_With_Subpools'Class; - Master : Finalization_Master_Ptr := null; - N_Addr : Address; - N_Ptr : FM_Node_Ptr; - N_Size : Storage_Count; - Subpool : Subpool_Handle := null; + Master : Finalization_Master_Ptr := null; + N_Addr : Address; + N_Ptr : FM_Node_Ptr; + N_Size : Storage_Count; + Subpool : Subpool_Handle := null; + Lock_Taken : Boolean := False; Header_And_Padding : Storage_Offset; -- This offset includes the size of a FM_Node plus any additional @@ -205,6 +206,7 @@ package body System.Storage_Pools.Subpools is -- Read - allocation, finalization -- Write - finalization + Lock_Taken := True; Lock_Task.all; -- Do not allow the allocation of controlled objects while the @@ -322,6 +324,7 @@ package body System.Storage_Pools.Subpools is end if; Unlock_Task.all; + Lock_Taken := False; -- Non-controlled allocation @@ -335,7 +338,7 @@ package body System.Storage_Pools.Subpools is -- Unlock the task in case the allocation step failed and reraise the -- exception. - if Is_Controlled then + if Lock_Taken then Unlock_Task.all; end if; |