Natools

Check-in [3267d1247d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
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: 3267d1247d11584eae744cedc11e1b199dc01a27
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified tests/natools-cron-tests.adb from [060da149fb] to [2e657633ab]. 

1
2

3
4
5
6
7
8
9

1

2
3
4
5
6
7
8
9


-
+








------------------------------------------------------------------------------
-- Copyright (c) 2014-2016, Natacha Porté                                   --
-- 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

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

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
2

3
4
5
6
7
8
9

1

2
3
4
5
6
7
8
9


-
+








------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
-- 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

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);
︙

This page was generated in about 0.004s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47