s-taprob.adb (Unlock): Change the ceiling priority of the underlying lock, if needed.

2007-04-20  Jose Ruiz  <ruiz@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* s-taprob.adb (Unlock): Change the ceiling priority of the underlying
	lock, if needed.

	* s-taprop.ads (Set_Ceiling): Add this procedure to change the ceiling
	priority associated to a lock.

	* s-tpoben.adb ([Vulnerable_]Complete_Task, Lock_Entries): Relax
	assertion to take into account case of no abort restriction.
	(Initialize_Protection_Entries): Add initialization for the field
	New_Ceiling associated to the protected object.
	(Unlock_Entries): Change the ceiling priority of the underlying lock, if
	needed.

	* s-solita.adb (Get_Current_Excep): Moved back to s-tasini/s-tarest,
	since this function needs to be set consistently with Update_Exception.

	* s-tarest.adb (Get_Current_Excep): Moved back to s-tasini/s-tarest,
	since this function needs to be set consistently with Update_Exception.

	* s-taskin.ads: Update comments on
	Interrupt_Server_Blocked_On_Event_Flag.
	(Unbind_Handler): Fix handling of server_task wakeup
	(Server_Task): Set self's state so that Unbind_Handler can take
	appropriate actions.
	(Common_ATCB): Now use a constant from System.Parameters to determine
	the max size of the Task_Image field.

	* s-tassta.adb (Task_Wrapper): Now pass the overflow guard to the
	Initialize_Analyzer function.
	([Vulnerable_]Complete_Task, Lock_Entries): Relax assertion to
	take into account case of no abort restriction.
	([Vulnerable_]Complete_Master): Modify assertion.

	* s-tataat.adb (Finalize): Use the nestable versions of
	Defer/Undefer_Abort.

	* s-tpobop.adb (Protected_Entry_Call): Relax assertion.

	* s-tpobop.ads: Update comments.

	* s-tposen.adb (Protected_Single_Entry_Call): Call Lock_Entry instead
	of locking the object manually, to avoid inconsistencies between
	Lock/Unlock_Entry assertions.

	* s-interr.ads, s-interr.adb (Server_Task): Fix race condition when
	terminating
	application and System.Parameters.No_Abort is True.
	Update comments on Interrupt_Server_Blocked_On_Event_Flag.
	(Unbind_Handler): Fix handling of server_task wakeup
	(Server_Task): Set self's state so that Unbind_Handler can take
	appropriate actions.

From-SVN: r125458

1 files changed, 31 insertions, 9 deletions

diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb
index f15afc0..b3efad5 100644
--- a/gcc/ada/s-tpoben.adb
+++ b/gcc/ada/s-tpoben.adb
@@ -7,7 +7,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1998-2006, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -54,6 +54,7 @@ with System.Task_Primitives.Operations;
 --           Unlock
 --           Get_Priority
 --           Wakeup
+--           Set_Ceiling
 
 with System.Tasking.Initialization;
 --  Used for Defer_Abort,
@@ -64,6 +65,9 @@ pragma Elaborate_All (System.Tasking.Initialization);
 --  This insures that tasking is initialized if any protected objects are
 --  created.
 
+with System.Restrictions;
+--  Used for Abort_Allowed
+
 with System.Parameters;
 --  Used for Single_Lock
 
@@ -216,13 +220,15 @@ package body System.Tasking.Protected_Objects.Entries is
       Initialization.Defer_Abort (Self_ID);
       Initialize_Lock (Init_Priority, Object.L'Access);
       Initialization.Undefer_Abort (Self_ID);
-      Object.Ceiling := System.Any_Priority (Init_Priority);
-      Object.Owner := Null_Task;
-      Object.Compiler_Info := Compiler_Info;
-      Object.Pending_Action := False;
+
+      Object.Ceiling          := System.Any_Priority (Init_Priority);
+      Object.New_Ceiling      := System.Any_Priority (Init_Priority);
+      Object.Owner            := Null_Task;
+      Object.Compiler_Info    := Compiler_Info;
+      Object.Pending_Action   := False;
       Object.Call_In_Progress := null;
-      Object.Entry_Bodies := Entry_Bodies;
-      Object.Find_Body_Index :=  Find_Body_Index;
+      Object.Entry_Bodies     := Entry_Bodies;
+      Object.Find_Body_Index  := Find_Body_Index;
 
       for E in Object.Entry_Queues'Range loop
          Object.Entry_Queues (E).Head := null;
@@ -235,7 +241,8 @@ package body System.Tasking.Protected_Objects.Entries is
    ------------------
 
    procedure Lock_Entries
-     (Object : Protection_Entries_Access; Ceiling_Violation : out Boolean)
+     (Object            : Protection_Entries_Access;
+      Ceiling_Violation : out Boolean)
    is
    begin
       if Object.Finalized then
@@ -264,7 +271,10 @@ package body System.Tasking.Protected_Objects.Entries is
       --  generated calls must be protected with cleanup handlers to ensure
       --  that abort is undeferred in all cases.
 
-      pragma Assert (STPO.Self.Deferral_Level > 0);
+      pragma Assert
+        (STPO.Self.Deferral_Level > 0
+          or else not Restrictions.Abort_Allowed);
+
       Write_Lock (Object.L'Access, Ceiling_Violation);
 
       --  We are entering in a protected action, so that we increase the
@@ -401,6 +411,18 @@ package body System.Tasking.Protected_Objects.Entries is
          end;
       end if;
 
+      --  Before releasing the mutex we must actually update its ceiling
+      --  priority if it has been changed.
+
+      if Object.New_Ceiling /= Object.Ceiling then
+         if Locking_Policy = 'C' then
+            System.Task_Primitives.Operations.Set_Ceiling
+              (Object.L'Access, Object.New_Ceiling);
+         end if;
+
+         Object.Ceiling := Object.New_Ceiling;
+      end if;
+
       Unlock (Object.L'Access);
    end Unlock_Entries;