Artifact 2e657633ab541f99b5b9d43231c03b44dad73b6b:
- File
tests/natools-cron-tests.adb
— part of check-in
[3267d1247d]
at
2017-04-12 20:54:47
on branch trunk
— cron-tests: new test to show an issue with unsafe access to Event_List
Thanks to OpenBSD for providing an environment where this issue could happen accidentally. Now to find a fix... (user: nat, size: 9496) [annotate] [blame] [check-ins using]
------------------------------------------------------------------------------ -- 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); 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, Get (Log), "o.1.1.1.|.O.sff.fffff.s."); 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; begin Test_Entry.Set (Total / 8, Long_Callback' (Backend => Log'Access, Open => '(', Close => ')', Wait => Total / 4)); delay Total / 4; end; Check (Test, Get (Log), "(", "Before wait"); delay Total / 2; Check (Test, Get (Log), "()", "After wait"); 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 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, Get (Log), "12312123"); exception when Error : others => Test.Report_Exception (Error); end Time_Collision; end Natools.Cron.Tests;