with Ada.Real_Time.Timing_Events;

generic
   One_Shot : Boolean := True;
   Timer_Name : String := "Generic_Timers";
   For_Duration : in Ada.Real_Time.Time_Span;
   with procedure Action is <>;

package Generic_Timers is

   Timer_Error : exception;

   procedure Start;
   procedure Stop;
   procedure Cancel;

private

   The_Event : Ada.Real_Time.Timing_Events.Timing_Event;

end Generic_Timers;
package Timers_Test is

   procedure Start;
   procedure Shutdown;

end Timers_Test;
with Ada.Exceptions;
with Ada.Text_Io;

with Timers_Test;

procedure All_Timers_Test is

   use Ada;
   use Text_Io;

begin

   Put_Line ("All Timers Test");

   Timers_Test.Start;
   delay 60.0;
   Timers_Test.Shutdown;

exception
   when Error : others =>
      Put_Line ("Testing fails for because of ==> " &
                                     Exceptions.Exception_Information (Error));
end All_Timers_Test;
package body Generic_Timers is

   use Ada;

   protected Events is
      procedure Handler (Event: in out Real_Time.Timing_Events.Timing_Event);
   end Events;

   protected body Events is
      procedure Handler (Event: in out Real_Time.Timing_Events.Timing_Event) is
      begin
         Action;
         if not One_Shot then
            Start;  -- periodic timer continues
         end if;
      end Handler;
   end Events;

   procedure Start is
      use type Ada.Real_Time.Timing_Events.Timing_Event_Handler;
   begin
      if Real_Time.Timing_Events.Current_Handler (The_Event) = null then
         Real_Time.Timing_Events.Set_Handler (
                               The_Event, For_Duration, Events.Handler'access);
      else
         raise Timer_Error with Timer_Name & " started already";
      end if;
   end Start;

   procedure Stop is
      Success : Boolean := False;
      use type Ada.Real_Time.Timing_Events.Timing_Event_Handler;
   begin
      if Real_Time.Timing_Events.Current_Handler (The_Event) /= null then
         Real_Time.Timing_Events.Cancel_Handler (The_Event, Success);
         if not Success then
            raise Timer_Error with "fails to cancel " & Timer_Name;
         end if;
      end if;
   end Stop;

   procedure Cancel renames Stop;

end Generic_Timers;

with Ada.Real_Time;
with Ada.Text_Io;

with Generic_Timers;

package body Timers_Test is

   use Ada;
   use Real_Time;
   use Text_Io;

   -----------------------------------------------------------------------------
   -- Below are generic one shot Timers being tested                          --
   -----------------------------------------------------------------------------
   Three_Seconds : constant Time_Span := Real_Time.Milliseconds (3000);
   Three_Second_Timer_Id : constant String := "Three Second One Shot timer";

   procedure Action_Three is
   begin
      Put_Line ("Three (3) second one shot timer, Generic_Timers, expires");
   end Action_Three;

   Package Three_Second_One_Shot_Timer is new Generic_Timers (
                     True, Three_Second_Timer_Id, Three_Seconds, Action_Three);

   --------------------------------------------------------
   Five_Seconds : constant Time_Span := Real_Time.Milliseconds (5000);
   Five_Second_Timer_Id : constant String := "Five Second One Shot timer";

   procedure Action_Five is
   begin
      Put_Line ("Five (5) second one shot timer, Generic_Timers, expires");
   end Action_Five;

   Package Five_Second_One_Shot_Timer is new Generic_Timers (
                       True, Five_Second_Timer_Id, Five_Seconds, Action_Five);

   -----------------------------------------------------------------------------
   -- Below are generic Periodic Timers being tested                          --
   -----------------------------------------------------------------------------
   One_Seconds : constant Time_Span := Real_Time.Milliseconds (1000);

   procedure Action_One is
   begin
      Put_Line ("One (1) second cyclic timer, Generic_Timers, expires");
   end Action_One;

   Package One_Second_Periodic_Timer is new Generic_Timers (
                  False, "One Second Periodic Timer", One_Seconds, Action_One);

   --------------------------------------------------------
   Two_Seconds : constant Time_Span := Real_Time.Milliseconds (2000);

   procedure Action_Two is
   begin
      Put_Line ("Two (2) second cyclic timer, Generic_Timers, expires");
   end Action_Two;

   Package Two_Second_Periodic_Timer is new Generic_Timers (
                  False, "Two Second Periodic Timer", Two_Seconds, Action_Two);

   --------------------------------------------------------
   Four_Seconds : constant Time_Span := Real_Time.Milliseconds (4000);

   procedure Action_Four is
   begin
      Put_Line ("Four (4) second cyclic timer, Generic_Timers, expires");
   end Action_Four;

   Package Four_Second_Periodic_Timer is new Generic_Timers (
               False, "Four Second Periodic Timer", Four_Seconds, Action_Four);

   --------------------------------------------------------
   Eight_Seconds : constant Time_Span := Real_Time.Milliseconds (8000);

   procedure Action_Eight is
   begin
      Put_Line ("Eight (8) second cyclic timer, Generic_Timers, expires");
   end Action_Eight;

   Package Eight_Second_Periodic_Timer is new Generic_Timers (
            False, "Eight Second Periodic Timer", Eight_Seconds, Action_Eight);

   -----------------------------------------------------------------------------
   -----------------------------------------------------------------------------

   procedure Start is
   begin
      Put_Line ("Timers Test begins");

      One_Second_Periodic_Timer.Start;
      Two_Second_Periodic_Timer.Start;
      Four_Second_Periodic_Timer.Start;
      Eight_Second_Periodic_Timer.Start;

      for Index in 1 .. 2 loop
         Three_Second_One_Shot_Timer.Start;
         Five_Second_One_Shot_Timer.Start;
         delay 6.0;
      end loop;
   end Start;

   procedure Shutdown is
   begin
      One_Second_Periodic_Timer.Cancel;
      Two_Second_Periodic_Timer.Cancel;
      Four_Second_Periodic_Timer.Cancel;
      Eight_Second_Periodic_Timer.Cancel;

      Three_Second_One_Shot_Timer.Cancel;
      Five_Second_One_Shot_Timer.Cancel;
      Put_Line ("Timers testing ends");
   end Shutdown;

end Timers_Test;