[Bug ada/41383] New: Timing_Events: Event time not cleared after Cancel_Handler

[reet at codelabs dot ch]

ARM D.15 about Ada.Real_Time.Timing_Events states:

9/2 An object of type Timing_Event is said to be set if it is associated
with a non-null value of type Timing_Event_Handler and cleared
otherwise. All Timing_Event objects are initially cleared.

17/2 The procedure Cancel_Handler clears the event if it is set.
Cancelled is assigned True if the event was set prior to it being
cleared; otherwise it is assigned False.

18/2 The function Time_Of_Event returns the time of the event if the
event is set; otherwise it returns Real_Time.Time_First.

There's a bug in the Cancel_Handler() procedure, because the event time remains
set and is not reset to Ada.Real_Time.Time_First (as required by 18/2).

Here is a small reproducer:

--

with Ada.Real_Time.Timing_Events;

package Timers is

   use Ada.Real_Time.Timing_Events;

   protected type Timer_Type is
      procedure Setup (At_Time : Ada.Real_Time.Time);
      function Get_Time return Ada.Real_Time.Time;
      procedure Stop (Status : out Boolean);
   private
      procedure Handle (Event : in out Timing_Event);

      Event : Timing_Event;
   end Timer_Type;

end Timers;

--

package body Timers is

   protected body Timer_Type is

      function Get_Time return Ada.Real_Time.Time is
      begin
         return Event.Time_Of_Event;
      end Get_Time;

      procedure Handle (Event : in out Timing_Event) is
      begin
         null;
      end Handle;

      procedure Setup (At_Time : Ada.Real_Time.Time) is
      begin
         Event.Set_Handler (At_Time => At_Time,
                            Handler => Handle'Access);
      end Setup;

      procedure Stop (Status : out Boolean) is
      begin
         Event.Cancel_Handler (Cancelled => Status);
      end Stop;

   end Timer_Type;

end Timers;

--

with Ada.Text_IO;
with Ada.Real_Time;

with Timers;

procedure Cancel_Handler is
   use Ada.Real_Time;

   Handler : Timers.Timer_Type;
   Timer   : constant Time := Clock + Minutes (60);
begin
   if Handler.Get_Time = Time_First then
      Ada.Text_IO.Put_Line ("Time is Time_First ...");
   end if;

   Handler.Setup (At_Time => Timer);
   if Handler.Get_Time = Timer then
      Ada.Text_IO.Put_Line ("Handler set ...");
   end if;

   declare
      Stopped : Boolean := False;
   begin
      Handler.Stop (Status => Stopped);

      if Stopped then
         Ada.Text_IO.Put_Line ("Timer cancelled ...");
         if Handler.Get_Time = Timer then
            Ada.Text_IO.Put_Line ("Why is the time still set then?");
         end if;
      end if;
   end;
end Cancel_Handler;


-- 
           Summary: Timing_Events: Event time not cleared after
                    Cancel_Handler
           Product: gcc
           Version: 4.4.1
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: reet at codelabs dot ch
 GCC build triplet: i486-linux-gnu
  GCC host triplet: i486-linux-gnu
GCC target triplet: i486-linux-gnu


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=41383