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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111184 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 27 insertions, 3 deletions

diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index d7e602a9e54..120657fc47e 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -61,10 +61,20 @@ with Interfaces.C;
 --  used for int
 --           size_t
 
+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;
@@ -1026,6 +1036,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_False (S : in out Suspension_Object) is
       Result  : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1033,6 +1045,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_False;
 
    --------------
@@ -1042,6 +1056,8 @@ package body System.Task_Primitives.Operations is
    procedure Set_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1062,6 +1078,8 @@ package body System.Task_Primitives.Operations is
 
       Result := pthread_mutex_unlock (S.L'Access);
       pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
    end Set_True;
 
    ------------------------
@@ -1071,6 +1089,8 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result : Interfaces.C.int;
    begin
+      SSL.Abort_Defer.all;
+
       Result := pthread_mutex_lock (S.L'Access);
       pragma Assert (Result = 0);
 
@@ -1082,6 +1102,8 @@ package body System.Task_Primitives.Operations is
          Result := pthread_mutex_unlock (S.L'Access);
          pragma Assert (Result = 0);
 
+         SSL.Abort_Undefer.all;
+
          raise Program_Error;
       else
          --  Suspend the task if the state is False. Otherwise, the task
@@ -1094,10 +1116,12 @@ package body System.Task_Primitives.Operations is
             S.Waiting := True;
             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
          end if;
-      end if;
 
-      Result := pthread_mutex_unlock (S.L'Access);
-      pragma Assert (Result = 0);
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
    end Suspend_Until_True;
 
    ----------------