Natools

Check-in [7daa408712]
Login

Check-in [7daa408712]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:cron-tests: use the new Generic_Check tool
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7daa408712f1cb12587f37e2c97ecaab487a1c1a
User & Date: nat 2014-08-14 17:11:27.938
Context
2014-08-15
17:27
time_io-human: new package for human-friendly I/O of time-related types check-in: 576830db63 user: nat tags: trunk
2014-08-14
17:11
cron-tests: use the new Generic_Check tool check-in: 7daa408712 user: nat tags: trunk
2014-08-13
20:27
tests: add Generic_Check helper procedure check-in: 8608b41131 user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/natools-cron-tests.adb.
︙︙
54
55
56
57
58
59
60
61

62

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84


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


   procedure Check

     (Test : in out NT.Test;

      Found : in Bounded_String;
      Expected : in String;
      Context : in String := "") is
   begin
      if Get (Found) /= Expected then
         if Context /= "" then
            Test.Fail (Context
              & ": found """ & Get (Found) & """, expected """
              & Expected & '"');
         else
            Test.Fail ("Found """ & Get (Found) & """, expected """
              & Expected & '"');
         end if;
      end if;
   end Check;



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









|
>
|
>
|
|
<
<
<
<
<
<
|
|
<
<
<
<
|








54
55
56
57
58
59
60
61
62
63
64
65
66






67
68




69
70
71
72
73
74
75
76


   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 --
   -------------------------
︙︙
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

      --  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, Log, ".1.1.1.|..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");








|








140
141
142
143
144
145
146
147
148
149
150
151
152
153
154

      --  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), ".1.1.1.|..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");
︙︙
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         delay Total / 4;
      end;

      Check (Test, Log, "(", "Before wait");
      delay Total / 2;
      Check (Test, 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");








|

|








162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

           (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 Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
︙︙
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224

      --  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, 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");








|








202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

      --  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");
︙︙
237
238
239
240
241
242
243
244
245
246
247
248
249

           (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, Log, "12312123");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;








|






229
230
231
232
233
234
235
236
237
238
239
240
241

           (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;
Changes to tests/natools-cron-tests.ads.
︙︙
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

      Size : Natural := 0;
   end record;

   procedure Append (S : in out Bounded_String; C : Character);
   function Get (S : Bounded_String) return String;
   procedure Reset (S : in out Bounded_String);

   procedure Check
     (Test : in out NT.Test;
      Found : in Bounded_String;
      Expected : in String;
      Context : in String := "");


   type Test_Callback (Backend : access Bounded_String) is new Callback with
   record
      Symbol : Character;
   end record;

   overriding procedure Run (Self : in out Test_Callback);








<
<
<
<
<
<








38
39
40
41
42
43
44






45
46
47
48
49
50
51

      Size : Natural := 0;
   end record;

   procedure Append (S : in out Bounded_String; C : Character);
   function Get (S : Bounded_String) return String;
   procedure Reset (S : in out Bounded_String);








   type Test_Callback (Backend : access Bounded_String) is new Callback with
   record
      Symbol : Character;
   end record;

   overriding procedure Run (Self : in out Test_Callback);
︙︙