From 4bbbf12a0a687157743c07ce0aaccf7c2158e9cf Mon Sep 17 00:00:00 2001 From: sam Date: Tue, 6 Oct 2009 07:20:53 +0000 Subject: [PATCH] gcc/ada/ PR ada/41383 * a-rttiev.adb (Time_Of_Event): Return Time_First for unset event. gcc/testsuite/ PR ada/41383 * gnat.dg/timer_cancel.adb: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152487 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/a-rttiev.adb | 8 ++++++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/timer_cancel.adb | 38 ++++++++++++++++++++++++++++++++++ 4 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/timer_cancel.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7af8f31c1e9..d5e34e916ad 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2009-10-06 Samuel Tardieu + PR ada/41383 + * a-rttiev.adb (Time_Of_Event): Return Time_First for unset event. + +2009-10-06 Samuel Tardieu + PR ada/38333 * sem_prag.adb (Process_Import_Or_Interface): Forbid an abstract subprogram to be completed with a "pragma Import". diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb index 2068c786850..55687ec8f6b 100644 --- a/gcc/ada/a-rttiev.adb +++ b/gcc/ada/a-rttiev.adb @@ -332,7 +332,13 @@ package body Ada.Real_Time.Timing_Events is function Time_Of_Event (Event : Timing_Event) return Time is begin - return Event.Timeout; + -- RM D.15(18/2): Time_First must be returned if the event is not set + + if Event.Handler = null then + return Time_First; + else + return Event.Timeout; + end if; end Time_Of_Event; -------------- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c65aab8eb7f..e9214c2b3b4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2009-10-06 Samuel Tardieu + PR ada/41383 + * gnat.dg/timer_cancel.adb: New test. + +2009-10-06 Samuel Tardieu + PR ada/38333 * gnat.dg/specs/import_abstract.ads: New. diff --git a/gcc/testsuite/gnat.dg/timer_cancel.adb b/gcc/testsuite/gnat.dg/timer_cancel.adb new file mode 100644 index 00000000000..c300b47a859 --- /dev/null +++ b/gcc/testsuite/gnat.dg/timer_cancel.adb @@ -0,0 +1,38 @@ +-- { dg-do run } + +with Ada.Real_Time.Timing_Events; +use Ada.Real_Time, Ada.Real_Time.Timing_Events; + +procedure Timer_Cancel is + + E : Timing_Event; + C : Boolean; + + protected Dummy is + procedure Trigger (Event : in out Timing_Event); + end Dummy; + + protected body Dummy is + procedure Trigger (Event : in out Timing_Event) is + begin + null; + end Trigger; + end Dummy; + +begin + Set_Handler (E, Time_Last, Dummy.Trigger'Unrestricted_Access); + + if Time_Of_Event (E) /= Time_Last then + raise Program_Error with "Event time not set correctly"; + end if; + + Cancel_Handler (E, C); + + if not C then + raise Program_Error with "Event triggered already"; + end if; + + if Time_Of_Event (E) /= Time_First then + raise Program_Error with "Event time not reset correctly"; + end if; +end Timer_Cancel; -- 2.11.0