From 1c5f82019ab50806ff1a23e5be8db864e8da131a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Jun 2020 14:18:18 -0400 Subject: [PATCH] [Ada] Fix logic in Allocate_Any_Controlled gcc/ada/ * libgnat/s-stposu.adb (Allocate_Any_Controlled): Fix logic in lock/unlock. --- gcc/ada/libgnat/s-stposu.adb | 15 +++++++++------ 1 file 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; -- 2.7.4