Natools

Check-in [79433e4065]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:time_keys-tests: almost-fully covering test suite for time keys
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 79433e406530610b78e7cf969642735e9c0d80cb
User & Date: nat on 2015-01-15 22:48:35
Other Links: manifest | tags
Context
2015-01-16
22:10
tools: new "timekey" too to provide a CLI interface to Natools.Time_Keys check-in: 25d22b98f4 user: nat tags: trunk
2015-01-15
22:48
time_keys-tests: almost-fully covering test suite for time keys check-in: 79433e4065 user: nat tags: trunk
2015-01-14
20:55
time_keys: new package that provides short printable chronological keys check-in: 0ca258c8c8 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added tests/natools-time_keys-tests.adb version [2238f42765]. 





















































































































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
53
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2015, 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.Formatting;
with Natools.Time_IO.RFC_3339;

package body Natools.Time_Keys.Tests is

   function Image (Date : Ada.Calendar.Time) return String;

   procedure Roundtrip_Test
     (Test : in out NT.Test;
      Time : in Ada.Calendar.Time;
      Expected_Key : in String);


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Image (Date : Ada.Calendar.Time) return String is
   begin
      return Time_IO.RFC_3339.Image
        (Date => Date,
         Subsecond_Digits => Duration'Aft);
   end Image;


   procedure Roundtrip_Test
     (Test : in out NT.Test;
      Time : in Ada.Calendar.Time;
      Expected_Key : in String)
   is
      use type Ada.Calendar.Time;

      Generated_Key : constant String := To_Key (Time, 2);
      Recovered_Time : constant Ada.Calendar.Time := To_Time (Generated_Key);
   begin
      if Generated_Key /= Expected_Key then
         Test.Fail ("Generated key """ & Generated_Key
           & """, expected """ & Expected_Key & '"');
      end if;

      if Recovered_Time /= Time then
         Test.Fail ("Roundtrip time: " & Image (Recovered_Time)
           & ", original: " & Image (Time));
      end if;
   end Roundtrip_Test;



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

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Roundtrips (Report);
   end All_Tests;



   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Roundtrips (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Conversion Roundtrips");
   begin
      if Duration'Small <= 1.0 / 128.0 then
         Roundtrip_Test
           (Test,
            Ada.Calendar.Formatting.Time_Of (2015,  1, 14, 15, 16, 17,
              0.5 + 1.0 / 128.0),
            "VV1EFGHWW");
      end if;

      Roundtrip_Test
        (Test,
         Ada.Calendar.Formatting.Time_Of (2015,  1,  2,  3,  4,  5, 0.5),
         "VV12345W");
      Roundtrip_Test
        (Test,
         Ada.Calendar.Formatting.Time_Of (2047,  1, 14,  8, 44, 36),
         "V~1E8h_");
      Roundtrip_Test
        (Test,
         Ada.Calendar.Formatting.Time_Of (2020, 10,  9,  0,  9,  0),
         "V_A909");
      Roundtrip_Test
        (Test,
         Ada.Calendar.Formatting.Time_Of (2303,  9, 30, 23,  0,  0),
         "Z~9UN");
      Roundtrip_Test
        (Test,
         Ada.Calendar.Formatting.Time_Of (2304, 12, 31,  0,  0,  0),
         "_0CV");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Roundtrips;

end Natools.Time_Keys.Tests;








Added tests/natools-time_keys-tests.ads version [582c5dff9f].































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2015, 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.Tests;

package Natools.Time_Keys.Tests is

   package NT renames Natools.Tests;

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

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

end Natools.Time_Keys.Tests;








Modified tests/test_all.adb
from [c3ed702e48]
to [094996cdd1].




︙


39
40
41
42
43
44
45

46
47
48
49
50
51
52

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53








+








with Natools.S_Expressions.Printers.Pretty.Tests;
with Natools.S_Expressions.Printers.Pretty.Config.Tests;
with Natools.S_Expressions.Templates.Tests;
with Natools.Static_Hash_Maps.S_Expressions.Tests;
with Natools.String_Slice_Set_Tests;
with Natools.String_Slice_Tests;
with Natools.Time_IO.Tests;
with Natools.Time_Keys.Tests;
with Natools.Time_Statistics.Tests;
with Natools.Tests.Text_IO;

procedure Test_All is
   package Uneven_Chunked_Strings is new Natools.Chunked_Strings
     (Default_Allocation_Unit => 7,
      Default_Chunk_Size      => 15);




︙


163
164
165
166
167
168
169




170
171
172
173
174
175
176

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181








+
+
+
+








   Report.Section ("String_Slices.Slice_Sets");
   Natools.String_Slice_Set_Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("Time_IO");
   Natools.Time_IO.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("Time_Keys");
   Natools.Time_Keys.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("Time_Statistics");
   Natools.Time_Statistics.Tests.All_Tests (Report);
   Report.End_Section;

   Natools.Tests.Text_IO.Print_Results (Report.Total_Results);





︙












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