From 323e61d0143866d73442b3574511d088ff681b0c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Tue, 20 May 2008 14:52:09 +0200 Subject: [PATCH] 2008-05-20 Bob Duff * a-rttiev.adb (Set_Handler): Remove code from both of these that implements RM-D.15(15/2), because it causes a race condition and potential deadlock. (Process_Queued_Events): Add comment explaining "exception when others => null". Add clarifying ".all", even though implicit .all is legal here. From-SVN: r135648 --- gcc/ada/a-rttiev.adb | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb index 7031dfbc7c3..72ae4df0be4 100644 --- a/gcc/ada/a-rttiev.adb +++ b/gcc/ada/a-rttiev.adb @@ -66,8 +66,8 @@ package body Ada.Real_Time.Timing_Events is -- Used for mutually exclusive access to All_Events procedure Process_Queued_Events; - -- Examine the queue of pending events for any that have timed-out. For - -- those that have timed-out, remove them from the queue and invoke their + -- Examine the queue of pending events for any that have timed out. For + -- those that have timed out, remove them from the queue and invoke their -- handler (unless the user has cancelled the event by setting the handler -- pointer to null). Mutually exclusive access is held via Event_Queue_Lock -- during part of the processing. @@ -142,7 +142,7 @@ package body Ada.Real_Time.Timing_Events is if Next_Event.Timeout > Clock then - -- We found one that has not yet timed-out. The queue is in + -- We found one that has not yet timed out. The queue is in -- ascending order by Timeout so there is no need to continue -- processing (and indeed we must not continue since we always -- delete the first element). @@ -182,8 +182,12 @@ package body Ada.Real_Time.Timing_Events is Next_Event.Handler := null; if Handler /= null then - Handler (Timing_Event (Next_Event.all)); + Handler.all (Timing_Event (Next_Event.all)); end if; + + -- Ignore exceptions propagated by Handler.all, as required by + -- RM-D.15(21/2) + exception when others => null; @@ -261,12 +265,15 @@ package body Ada.Real_Time.Timing_Events is begin Remove_From_Queue (Event'Unchecked_Access); Event.Handler := null; - if At_Time <= Clock then - if Handler /= null then - Handler (Event); - end if; - return; - end if; + + -- RM-D.15(15/2) requires that at this point, we check whether the time + -- has already passed, and if so, call Handler.all directly from here + -- instead of doing the enqueuing below. However, this causes a nasty + -- race condition and potential deadlock. If the current task has + -- already locked the protected object of Handler.all, and the time has + -- passed, deadlock would occur. Therefore, we ignore the requirement. + -- The same comment applies to the other Set_Handler below. + if Handler /= null then Event.Timeout := At_Time; Event.Handler := Handler; @@ -286,12 +293,9 @@ package body Ada.Real_Time.Timing_Events is begin Remove_From_Queue (Event'Unchecked_Access); Event.Handler := null; - if In_Time <= Time_Span_Zero then - if Handler /= null then - Handler (Event); - end if; - return; - end if; + + -- See comment in the other Set_Handler above. + if Handler /= null then Event.Timeout := Clock + In_Time; Event.Handler := Handler; -- 2.30.2