procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Fix logic in Allocate_Any_Controlled

Browse source 
gcc/ada/

	* libgnat/s-stposu.adb (Allocate_Any_Controlled): Fix logic in
	lock/unlock.
This commit is contained in:
Arnaud Charlet 2020-06-04 14:18:18 -04:00 • committed by Pierre-Marie de Rodat
parent b2410a1f02
commit 1c5f82019a
1 changed files with 9 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/ada/libgnat/s-stposu.adb
View file

@ -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;