diff options
| author | Samuel Tardieu <sam@rfc1149.net> | 2009-10-06 07:20:53 +0000 |
|---|---|---|
| committer | Samuel Tardieu <sam@gcc.gnu.org> | 2009-10-06 07:20:53 +0000 |
| commit | 2c12a29243f2b23ba5ef8527b352f819def4a02e (patch) | |
| tree | 73d6d2c0ee6281bab9b079de10675e983b099fb2 | |
| parent | 6fa30ef2813f3d16e1c7fb97f91cebfb14b8efb0 (diff) | |
| download | gcc-2c12a29243f2b23ba5ef8527b352f819def4a02e.zip gcc-2c12a29243f2b23ba5ef8527b352f819def4a02e.tar.gz gcc-2c12a29243f2b23ba5ef8527b352f819def4a02e.tar.bz2 | |
re PR ada/41383 (Timing_Events: Event time not cleared after Cancel_Handler)
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.
From-SVN: r152487
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/a-rttiev.adb | 8 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/timer_cancel.adb | 38 |
4 files changed, 55 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7af8f31..d5e34e9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2009-10-06 Samuel Tardieu <sam@rfc1149.net> + PR ada/41383 + * a-rttiev.adb (Time_Of_Event): Return Time_First for unset event. + +2009-10-06 Samuel Tardieu <sam@rfc1149.net> + 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 2068c78..55687ec 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 c65aab8..e9214c2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2009-10-06 Samuel Tardieu <sam@rfc1149.net> + PR ada/41383 + * gnat.dg/timer_cancel.adb: New test. + +2009-10-06 Samuel Tardieu <sam@rfc1149.net> + 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 0000000..c300b47 --- /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; |