Overview
| Comment: | 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... |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
3267d1247d11584eae744cedc11e1b19 |
| User & Date: | nat on 2017-04-12 20:54:47 |
| Other Links: | manifest | tags |
Context
|
2017-04-13
| ||
| 20:30 | cron: fix incorrect concurrent access to Event_List internals check-in: ffb7e43a74 user: nat tags: trunk | |
|
2017-04-12
| ||
| 20:54 |
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... check-in: 3267d1247d user: nat tags: trunk | |
|
2017-04-11
| ||
| 21:28 | s_expressions-parsers-tests: test the new memory-backed parser check-in: 35261eb800 user: nat tags: trunk | |
Changes
Modified tests/natools-cron-tests.adb from [060da149fb] to [2e657633ab].
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
|
| ︙ | ︙ |
Modified tests/natools-cron-tests.ads from [da53241e6e] to [460bcc2dff].
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 -- |
| ︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
package NT renames Natools.Tests;
procedure All_Tests (Report : in out NT.Reporter'Class);
procedure Basic_Usage (Report : in out NT.Reporter'Class);
procedure Delete_While_Busy (Report : in out NT.Reporter'Class);
procedure Insert_While_Busy (Report : in out NT.Reporter'Class);
procedure Time_Collision (Report : in out NT.Reporter'Class);
private
type Bounded_String (Max_Size : Natural) is record
Data : String (1 .. Max_Size);
| > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
package NT renames Natools.Tests;
procedure All_Tests (Report : in out NT.Reporter'Class);
procedure Basic_Usage (Report : in out NT.Reporter'Class);
procedure Delete_While_Busy (Report : in out NT.Reporter'Class);
procedure Delete_While_Collision (Report : in out NT.Reporter'Class);
procedure Insert_While_Busy (Report : in out NT.Reporter'Class);
procedure Time_Collision (Report : in out NT.Reporter'Class);
private
type Bounded_String (Max_Size : Natural) is record
Data : String (1 .. Max_Size);
|
| ︙ | ︙ |