Natools

Check-in [7daa408712]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
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 on 2014-08-14 17:11:27
Other Links: manifest | tags
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified tests/natools-cron-tests.adb from [ee998ac3ee] to [f5d96a3e68].

︙
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

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;


   procedure Check
     (Test : in out NT.Test;
      Found : in Bounded_String;
      Expected : in String;

   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
      Context : in String := "") is
   begin
      if Get (Found) /= Expected then
         if Context /= "" then
            Test.Fail (Context
              & ": found """ & Get (Found) & """, expected """
              & Expected & '"');
         else
     is ('"' & Data & '"');

            Test.Fail ("Found """ & Get (Found) & """, expected """
              & Expected & '"');
         end if;
      end if;
   end Check;
   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

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

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

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

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

end Natools.Cron.Tests;

Modified tests/natools-cron-tests.ads from [2ed458e779] to [da53241e6e].

︙
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

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

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

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