s-tposen.adb (Service_Entry): The object must be always unlocked at the end of…

s-tposen.adb (Service_Entry): The object must be always unlocked at the end of this procedure now that the...

2004-10-04  Jose Ruiz  <ruiz@act-europe.fr>

	* s-tposen.adb (Service_Entry): The object must be always unlocked at
	the end of this procedure now that the unlock operation was inserted
	by the expander.

From-SVN: r88489

gcc/ada/ChangeLog

 2004-10-04  Jose Ruiz  <ruiz@act-europe.fr>
 
+	* s-tposen.adb (Service_Entry): The object must be always unlocked at
+	the end of this procedure now that the unlock operation was inserted
+	by the expander.
+
+2004-10-04  Jose Ruiz  <ruiz@act-europe.fr>
+
 	* targparm.ads, targparm.adb (Targparm_Tags): Add PAS value
 	corresponding to the Preallocated_Stacks flags in System.
 	(Get_Target_Parameters): Including the processing for

gcc/ada/s-tposen.adb

@@ -574,43 +574,48 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    -------------------
 
    procedure Service_Entry (Object : Protection_Entry_Access) is
-      Self_Id       : constant Task_Id := STPO.Self;
-      Entry_Call    : constant Entry_Call_Link := Object.Entry_Queue;
-      Caller        : Task_Id;
+      Self_Id    : constant Task_Id := STPO.Self;
+      Entry_Call : constant Entry_Call_Link := Object.Entry_Queue;
+      Caller     : Task_Id;
 
    begin
-      if Entry_Call /= null then
-         if Object.Entry_Body.Barrier (Object.Compiler_Info, 1) then
-            Object.Entry_Queue := null;
+      if Entry_Call /= null
+        and then Object.Entry_Body.Barrier (Object.Compiler_Info, 1)
+      then
+         Object.Entry_Queue := null;
 
-            if Object.Call_In_Progress /= null then
-               --  This violates the No_Entry_Queue restriction, send
-               --  Program_Error to the caller.
+         if Object.Call_In_Progress /= null then
 
-               Send_Program_Error (Self_Id, Entry_Call);
-               Unlock_Entry (Object);
-               return;
-            end if;
+            --  Violation of No_Entry_Queue restriction, raise exception
 
-            Object.Call_In_Progress := Entry_Call;
-            Object.Entry_Body.Action
-              (Object.Compiler_Info, Entry_Call.Uninterpreted_Data, 1);
-            Object.Call_In_Progress := null;
-            Caller := Entry_Call.Self;
+            Send_Program_Error (Self_Id, Entry_Call);
             Unlock_Entry (Object);
+            return;
+         end if;
 
-            if Single_Lock then
-               STPO.Lock_RTS;
-            end if;
+         Object.Call_In_Progress := Entry_Call;
+         Object.Entry_Body.Action
+           (Object.Compiler_Info, Entry_Call.Uninterpreted_Data, 1);
+         Object.Call_In_Progress := null;
+         Caller := Entry_Call.Self;
+         Unlock_Entry (Object);
 
-            STPO.Write_Lock (Caller);
-            Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
-            STPO.Unlock (Caller);
+         if Single_Lock then
+            STPO.Lock_RTS;
+         end if;
 
-            if Single_Lock then
-               STPO.Unlock_RTS;
-            end if;
+         STPO.Write_Lock (Caller);
+         Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+         STPO.Unlock (Caller);
+
+         if Single_Lock then
+            STPO.Unlock_RTS;
          end if;
+
+      else
+         --  Just unlock the entry
+
+         Unlock_Entry (Object);
       end if;
 
    exception