Differences From Artifact [060da149fb]:
- File tests/natools-cron-tests.adb — part of check-in [b3f94db9eb] at 2016-01-08 18:05:29 on branch trunk — cron-tests: lengthen test to help it pass on slow busy machines (user: nat, size: 8082) [annotate] [blame] [check-ins using]
To Artifact [2e657633ab]:
- 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]
1 | ------------------------------------------------------------------------------ | | | 1 2 3 4 5 6 7 8 9 | ------------------------------------------------------------------------------ -- 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 -- |
| ︙ | ︙ | |||
76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
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);
end All_Tests;
-----------------------
-- Inidividual Tests --
-----------------------
| > | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 |
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 --
-----------------------
|
| ︙ | ︙ | |||
180 181 182 183 184 185 186 187 188 189 190 191 192 193 |
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 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
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 |
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
|
| ︙ | ︙ |