From c28f48ff9e4db198989b9e0c9b0f82c1da47a93b Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 6 Apr 2007 09:27:53 +0000 Subject: * s-tpobop.adb (Exceptional_Complete_Entry_Body): Undefer abortion before propagating exception. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123601 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/s-tpobop.adb | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'gcc/ada/s-tpobop.adb') diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index b8bfc9a3ef9..95d54af7552 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -272,6 +272,8 @@ package body System.Tasking.Protected_Objects.Operations is pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence"); Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress; + Self_Id : Task_Id; + begin pragma Debug (Debug.Trace (STPO.Self, "Exceptional_Complete_Entry_Body", 'P')); @@ -285,9 +287,15 @@ package body System.Tasking.Protected_Objects.Operations is Entry_Call.Exception_To_Raise := Ex; if Ex /= Ada.Exceptions.Null_Id then + -- An exception was raised and abort was deferred, so adjust + -- before propagating, otherwise the task will stay with deferral + -- enabled for its remaining life. + + Self_Id := STPO.Self; + Initialization.Undefer_Abort_Nestable (Self_Id); Transfer_Occurrence (Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access, - STPO.Self.Common.Compiler_Data.Current_Excep); + Self_Id.Common.Compiler_Data.Current_Excep); end if; -- Wakeup_Entry_Caller will be called from PO_Do_Or_Queue or -- cgit v1.2.1