Natools

Check-in [8292cedaee]
Login

Check-in [8292cedaee]

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

Overview
Comment:reference_tests: add a task-safety test (that isn't relevant on single-core)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 8292cedaee53fd85eb1fe84cd19a1004d0fb51f5
User & Date: nat 2014-07-15 20:07:29.422
Context
2014-07-16
17:44
references: prepare variants, calling "unsafe" the existing one check-in: ed32c25b9b user: nat tags: trunk
2014-07-15
20:07
reference_tests: add a task-safety test (that isn't relevant on single-core) check-in: 8292cedaee user: nat tags: trunk
2014-07-14
19:04
s_expressions-file_rw_tests: test the new atom-reference reader check-in: 88f1a31b31 user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/natools-reference_tests.adb. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16



17
18
19
20
21
22
23

------------------------------------------------------------------------------
-- Copyright (c) 2013, 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         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------




with Natools.References.Tools;

package body Natools.Reference_Tests is

   package Tools is new Refs.Tools;

   procedure Check_Ref


|














>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar;
with Ada.Exceptions;

with Natools.References.Tools;

package body Natools.Reference_Tests is

   package Tools is new Refs.Tools;

   procedure Check_Ref
︙︙
394
395
396
397
398
399
400









































































401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416

         NT.Item (Report, Name, NT.Success);
      end if;
   exception
      when Error : others => NT.Report_Exception (Report, Name, Error);
   end Test_Reference_Tests;












































































   ---------------------
   -- Test everything --
   ---------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Data_Access (Report);
      Test_Double_Finalize (Report);
      Test_Instance_Counts (Report);
      Test_Reference_Counts (Report);
      Test_Reference_Tests (Report);
   end All_Tests;

end Natools.Reference_Tests;









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>















<

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491


         NT.Item (Report, Name, NT.Success);
      end if;
   exception
      when Error : others => NT.Report_Exception (Report, Name, Error);
   end Test_Reference_Tests;


   procedure Test_Task_Safety (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Task safety");
      Success : Boolean := True;

      protected Protected_Report is
         procedure Report_Exception (Ex : Ada.Exceptions.Exception_Occurrence);
      end Protected_Report;

      protected body Protected_Report is
         procedure Report_Exception
           (Ex : Ada.Exceptions.Exception_Occurrence) is
         begin
            Test.Report_Exception (Ex, NT.Fail);
         end Report_Exception;
      end Protected_Report;

      task type Checker is
         entry Start (Count : in Natural; Ref : in Refs.Immutable_Reference);
      end Checker;

      task body Checker is
         Starting_Value, Last : Natural;
         R : Refs.Immutable_Reference;
      begin
         accept Start (Count : in Natural; Ref : in Refs.Immutable_Reference)
         do
            Last := Count;
            R := Ref;
         end Start;
         Starting_Value := R.Query.Data.Instance_Number;
         for I in 1 .. Last loop
            declare
               Temp : constant Refs.Immutable_Reference := R;
            begin
               if Temp.Query.Data.Instance_Number /= Starting_Value then
                  Success := False;
               end if;
            end;
         end loop;
      exception
         when Error : others =>
            Protected_Report.Report_Exception (Error);
      end Checker;

      Start : constant Ada.Calendar.Time := Ada.Calendar.Clock;
   begin
      declare
         Base : constant Refs.Immutable_Reference
           := Refs.Create (Factory'Access);
      begin
         declare
            Checkers : array (1 .. 16) of Checker;
         begin
            for I in Checkers'Range loop
               Checkers (I).Start (10 ** 6, Base);
            end loop;
         end;

         if not Success then
            Test.Fail ("Success somehow got to False");
         end if;
      end;

      Test.Info ("Test run in "
        & Duration'Image (Ada.Calendar."-" (Ada.Calendar.Clock, Start)));
   exception
      when Error : others =>
         Test.Report_Exception (Error);
         Test.Info ("Test run in "
           & Duration'Image (Ada.Calendar."-" (Ada.Calendar.Clock, Start)));
   end Test_Task_Safety;



   ---------------------
   -- Test everything --
   ---------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Test_Data_Access (Report);
      Test_Double_Finalize (Report);
      Test_Instance_Counts (Report);
      Test_Reference_Counts (Report);
      Test_Reference_Tests (Report);
   end All_Tests;

end Natools.Reference_Tests;
Changes to tests/natools-reference_tests.ads. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19



20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39


40
41
42
43
44
45
46

------------------------------------------------------------------------------
-- Copyright (c) 2013, 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         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Reference_Tests is a test suite for Natools.References           --
-- reference-counted object holder.                                         --



------------------------------------------------------------------------------

with Natools.Tests;

private with Ada.Finalization;
private with GNAT.Debug_Pools;
private with Natools.References;
private with System.Storage_Pools;

package Natools.Reference_Tests is

   package NT renames Natools.Tests;

   procedure All_Tests (Report : in out NT.Reporter'Class);


   procedure Test_Data_Access (Report : in out NT.Reporter'Class);
   procedure Test_Double_Finalize (Report : in out NT.Reporter'Class);
   procedure Test_Instance_Counts (Report : in out NT.Reporter'Class);
   procedure Test_Reference_Counts (Report : in out NT.Reporter'Class);
   procedure Test_Reference_Tests (Report : in out NT.Reporter'Class);



private

   Instance_Count : Integer := 0;

   type Counter is new Ada.Finalization.Limited_Controlled with record
      Instance_Number : Natural := 0;


|

















>
>
>














>






>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Reference_Tests is a test suite for Natools.References           --
-- reference-counted object holder.                                         --
-- Note that the task-safety test is quite long and often reports success   --
-- on task-unsafe code when run on a single core. For these reasons, it is  --
-- not used by All_Tests.                                                   --
------------------------------------------------------------------------------

with Natools.Tests;

private with Ada.Finalization;
private with GNAT.Debug_Pools;
private with Natools.References;
private with System.Storage_Pools;

package Natools.Reference_Tests is

   package NT renames Natools.Tests;

   procedure All_Tests (Report : in out NT.Reporter'Class);
      --  All tests except Test_Task_Safety (see the Note above)

   procedure Test_Data_Access (Report : in out NT.Reporter'Class);
   procedure Test_Double_Finalize (Report : in out NT.Reporter'Class);
   procedure Test_Instance_Counts (Report : in out NT.Reporter'Class);
   procedure Test_Reference_Counts (Report : in out NT.Reporter'Class);
   procedure Test_Reference_Tests (Report : in out NT.Reporter'Class);

   procedure Test_Task_Safety (Report : in out NT.Reporter'Class);

private

   Instance_Count : Integer := 0;

   type Counter is new Ada.Finalization.Limited_Controlled with record
      Instance_Number : Natural := 0;
︙︙
Changes to tests/test_all.adb.
︙︙
84
85
86
87
88
89
90

91
92
93
94
95
96
97


   Report.Section ("HMAC and GNAT_HMAC");
   Natools.HMAC_Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("References");
   Natools.Reference_Tests.All_Tests (Report);

   Report.End_Section;

   Report.Section ("S_Expressions.Atom_Buffers");
   Natools.S_Expressions.Atom_Buffers.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Caches");








>








84
85
86
87
88
89
90
91
92
93
94
95
96
97
98


   Report.Section ("HMAC and GNAT_HMAC");
   Natools.HMAC_Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("References");
   Natools.Reference_Tests.All_Tests (Report);
   Natools.Reference_Tests.Test_Task_Safety (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Atom_Buffers");
   Natools.S_Expressions.Atom_Buffers.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Caches");
︙︙