* [Ada] Fix logic in Allocate_Any_Controlled
@ 2020-07-15 13:45 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-07-15 13:45 UTC (permalink / raw)
To: gcc-patches; +Cc: Arnaud Charlet
[-- Attachment #1: Type: text/plain, Size: 270 bytes --]
If an exception is raised early in Allocate_Any_Controlled, no lock is
taken yet and Unlock is called on a lock which isn't taken.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* libgnat/s-stposu.adb (Allocate_Any_Controlled): Fix logic in
lock/unlock.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1632 bytes --]
diff --git a/gcc/ada/libgnat/s-stposu.adb b/gcc/ada/libgnat/s-stposu.adb
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-07-15 13:45 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-15 13:45 [Ada] Fix logic in Allocate_Any_Controlled Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).