s-taprop-irix.adb, [...] (Set_False, [...]): Add Abort_Defer/Undefer pairs to avoid the possibility of a task being aborted...

2006-02-17  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb, 
	s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb, 
	s-taprop-posix.adb, s-taprop-vxworks.adb, s-taprop-lynxos.adb, 
	s-taprop-tru64.adb (Set_False, Set_True, Suspend_Until_True): Add
	Abort_Defer/Undefer pairs to avoid the possibility of a task being
	aborted while owning a lock.

From-SVN: r111184

1 files changed, 30 insertions, 0 deletions

diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 7280f64..953e19e 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -56,10 +56,23 @@ with Interfaces.C.Strings;
 with System.Task_Info;
 --  used for Unspecified_Task_Info
 
+with System.Interrupt_Management;
+--  used for Initialize
+
+with System.Soft_Links;
+--  used for Abort_Defer/Undefer
+
+--  We use System.Soft_Links instead of System.Tasking.Initialization
+--  because the later is a higher level package that we shouldn't depend on.
+--  For example when using the restricted run time, it is replaced by
+--  System.Tasking.Restricted.Stages.
+
 with Unchecked_Deallocation;
 
 package body System.Task_Primitives.Operations is
 
+   package SSL renames System.Soft_Links;
+
    use System.Tasking.Debug;
    use System.Tasking;
    use Interfaces.C;
@@ -983,6 +996,7 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
       OS_Primitives.Initialize;
+      Interrupt_Management.Initialize;
 
       if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
 
@@ -1083,11 +1097,15 @@ package body System.Task_Primitives.Operations is
 
    procedure Set_False (S : in out Suspension_Object) is
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       S.State := False;
 
       LeaveCriticalSection (S.L'Access);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1097,6 +1115,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : BOOL;
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       --  If there is already a task waiting on this suspension object then
@@ -1115,6 +1135,8 @@ package body System.Task_Primitives.Operations is
       end if;
 
       LeaveCriticalSection (S.L'Access);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1125,6 +1147,8 @@ package body System.Task_Primitives.Operations is
       Result      : DWORD;
       Result_Bool : BOOL;
    begin
+      SSL.Abort_Defer.all;
+
       EnterCriticalSection (S.L'Access);
 
       if S.Waiting then
@@ -1134,6 +1158,8 @@ package body System.Task_Primitives.Operations is
 
          LeaveCriticalSection (S.L'Access);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1144,6 +1170,8 @@ package body System.Task_Primitives.Operations is
             S.State := False;
 
             LeaveCriticalSection (S.L'Access);
+
+            SSL.Abort_Undefer.all;
          else
             S.Waiting := True;
 
@@ -1154,6 +1182,8 @@ package body System.Task_Primitives.Operations is
 
             LeaveCriticalSection (S.L'Access);
 
+            SSL.Abort_Undefer.all;
+
             Result := WaitForSingleObject (S.CV, Wait_Infinite);
             pragma Assert (Result = 0);
          end if;