Natools

natools-cron-tests.adb at [60c4462e44]
Login

File tests/natools-cron-tests.adb artifact a290944379 part of check-in 60c4462e44


------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Cron.Tests is

   --------------------
   -- Test Callbacks --
   --------------------

   overriding procedure Run (Self : in out Test_Callback) is
   begin
      Append (Self.Backend.all, Self.Symbol);
   end Run;


   overriding procedure Run (Self : in out Long_Callback) is
   begin
      Append (Self.Backend.all, Self.Open);
      delay Self.Wait;
      Append (Self.Backend.all, Self.Close);
   end Run;



   --------------------
   -- Bounded String --
   --------------------

   procedure Append (S : in out Bounded_String; C : Character) is
   begin
      S.Size := S.Size + 1;
      S.Data (S.Size) := C;
   end Append;


   function Get (S : Bounded_String) return String is
   begin
      return S.Data (1 .. S.Size);
   end Get;


   procedure Reset (S : in out Bounded_String) is
   begin
      S.Size := 0;
   end Reset;



   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
     is ('"' & Data & '"');

   procedure Check is new NT.Generic_Check (String, "=", Quote, False);



   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Delete_While_Busy (Report);
      Insert_While_Busy (Report);
      Time_Collision (Report);
      Delete_While_Collision (Report);
      Event_List_Fusion (Report);
      Event_List_Extension (Report);
   end All_Tests;



   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      use type Ada.Calendar.Time;

      Test : NT.Test := Report.Item ("Basic black-box usage");
      Total : constant Duration := 10.0;
      Tick : constant Duration := Total / 10;
      Half_Tick : constant Duration := Tick / 2;
      Log : aliased Bounded_String (256);
   begin
      declare
         Beat : constant Cron_Entry := Create
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           (Ada.Calendar.Clock + Half_Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 'o'));
         pragma Unreferenced (One_Time_Entry);

         Test_Entry : Cron_Entry;
      begin
         delay Half_Tick;
         Test_Entry.Set
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         delay 3 * Tick + Half_Tick;
         Test_Entry.Reset;
         delay Half_Tick;
      end;

      Append (Log, '|');
      delay Tick / 10;

      declare
         Beat : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Half_Tick,
             Period => Tick),
            Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Tick,
             Period => -Half_Tick),
            Test_Callback'(Backend => Log'Access, Symbol => 'O'));
         pragma Unreferenced (One_Time_Entry);

         Slow, Fast : Cron_Entry;
      begin
         Slow.Set
           (2 * Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 's'));
         delay 2 * Tick;
         Fast.Set
           (Tick / 5,
            Test_Callback'(Backend => Log'Access, Symbol => 'f'));
         delay Tick + Half_Tick;
         Fast.Reset;
         delay Tick + Half_Tick;
      end;

      --  Timeline, in ticks:
      --  Beat: set at 0.0, finalized at 4.5, run at 1.0, 2.0, 3.0, 4.0.
      --  Test_Entry: set at 0.5, reset at 4.0, run at 1.5, 2.5, 3.5.
      --  Beat: set at 4.5, finalized at 9.5, run at 5.0, 6.0, 7.0, 8.0, 9.0.
      --  Slow: set at 4.5, finalized at 9.5, run at 6.5, 8.5.
      --  Fast: set at 6.5, reset at 8.0,
      --        run at 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.9

      Check (Test, "o.1.1.1.|.O.sff.fffff.s.", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;


   procedure Delete_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Delete entry while callback is running");
      Total : constant Duration := 0.01;
      Log : aliased Bounded_String (256);
   begin
      declare
         Test_Entry : Cron_Entry;
         Guard_Entry : Cron_Entry;
      begin
         Test_Entry.Set (Total / 8, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         Guard_Entry.Set (Total / 2, Test_Callback'
           (Backend => Log'Access,
            Symbol => '.'));

         delay Total / 4;

         Check (Test, "(", Get (Log), "Before wait");
         Test_Entry.Reset;

         delay Total / 2;
         Check (Test, "().", Get (Log), "After wait");
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Busy;


   procedure Delete_While_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test
        := Report.Item ("Delete entry while callback list is running");
      Total : constant Duration := 0.0625;
      Tick : constant Duration := Total / 8;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + 2 * Tick,
               Period => 8 * Tick);
         First, Second : Cron_Entry;
      begin
         First.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => 2 * Tick));
         Second.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '<',
            Close => '>',
            Wait => 2 * Tick));
         delay 3 * Tick;
      end;

      --  Timeline:  0  .  1/4  .  1/2  .  3/4  .   1   .  5/4
      --  Triggers:         *                               *
      --  Log:              (       )<      >               (
      --  End of Block:         ^
      --  End of Test:                          ^

      Check (Test, "(", Get (Log));
      delay 4 * Tick;
      Check (Test, "()<>", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Collision;


   procedure Event_List_Extension (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Extension of synchronized callbacks");
      Total : constant Duration := 0.25;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         First_Tick : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + Total / 8,
               Period => Total / 2);
         Second_Tick : constant Periodic_Time
           := (Origin => First_Tick.Origin + First_Tick.Period,
               Period => First_Tick.Period);

         Head, Middle, Tail, Extra : Cron_Entry;
      begin
         Head.Set (First_Tick, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         Middle.Set (First_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'M'));
         Tail.Set (First_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'T'));

         delay Total / 4;
         Check (Test, "(", Get (Log));

         Extra.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'E'));
         Middle.Reset;

         delay Total / 4;
         Check (Test, "()MT", Get (Log));

         delay Total / 4;
         Check (Test, "()MTE(", Get (Log));

         delay Total / 4;
         Check (Test, "()MTE()T", Get (Log));
      end;

      --  Timeline:  0   .   1/4   .   1/2   .   3/4   .   1
      --  Log:           (         )MT       E(         )T
      --  Code:      *        *         *         *        *

      Check (Test, "()MTE()T", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Event_List_Extension;


   procedure Event_List_Fusion (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Fusion of synchronized callbacks");
      Total : constant Duration := 0.25;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         First_Tick : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + Total / 8,
               Period => Total / 4);
         Second_Tick : constant Periodic_Time
           := (Origin => First_Tick.Origin + First_Tick.Period,
               Period => First_Tick.Period);

         A_Head, A_Tail, B_Head, B_Tail : Cron_Entry;
      begin
         A_Head.Set (First_Tick, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 8));
         A_Tail.Set (First_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'A'));

         delay Total / 8 + Total / 16;
         Check (Test, "(", Get (Log));

         B_Head.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'B'));
         B_Tail.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'b'));

         delay Total / 4 + Total / 8;
         Check (Test, "()ABb()A", Get (Log));

         A_Tail.Reset;
         B_Tail.Reset;

         delay Total / 4;
         Check (Test, "()ABb()AB()", Get (Log));
      end;

      --  Timeline:  0   .   1/4   .   1/2   .   3/4   .   1
      --  Log:           (    )A  Bb(   )A   B(   )
      --  Code:      *     *               *         *   *

      delay Total / 8;
      Check (Test, "()ABb()AB()", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Event_List_Fusion;


   procedure Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
      Total : constant Duration := 1.0;
      Log : aliased Bounded_String (256);
   begin
      declare
         Long, Short : Cron_Entry;
      begin
         Long.Set
           (Total / 8,
            Long_Callback'
              (Backend => Log'Access,
               Open => '(',
               Close => ')',
               Wait => Total / 5));

         delay Total / 8 + Total / 16;

         Short.Set
           (Total / 8,
            Test_Callback'(Backend => Log'Access, Symbol => '.'));

         delay Total / 2 + Total / 8;
      end;

      --  Timeline: 0 . 1/8 . 1/4 .   3/8 . 1/2 .   5/8 . 3/4 . 7/8 . 1
      --  Set:      L       S
      --  Finalize:                                        *
      --  Ticks:         L     L  S    L  S  L  S    L  S  L
      --  Run:           <----L---->S  <----L---->S  <----L---->

      delay Total / 8;
      Check (Test, "().().()", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Insert_While_Busy;


   procedure Time_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Simultaneous activation of events");
      Total : constant Duration := 0.01;
      Tick : constant Duration := Total / 4;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time := (Ada.Calendar.Clock + Tick, Tick);
         First, Second, Third : Cron_Entry;
      begin
         First.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         Second.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '2'));
         Third.Set
           ((Origin => Common.Origin, Period => 2 * Common.Period),
            Test_Callback'(Backend => Log'Access, Symbol => '3'));
         delay Total - Tick / 2;
      end;

      Check (Test, "12312123", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;