Natools

Check-in [28738393c8]
Login

Check-in [28738393c8]

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

Overview
Comment:natools-accumulators-tests: New black-box test suite for string accumulators
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 28738393c8058db46fe98811b1cf427e2037adb6
User & Date: nat 2013-09-10 17:49:19.209
Context
2013-09-10
17:50
chunked_strings-tests: run String_Accumulator tests on Chunked_String objects check-in: 1ac63b4194 user: nat tags: trunk
17:49
natools-accumulators-tests: New black-box test suite for string accumulators check-in: 28738393c8 user: nat tags: trunk
2013-09-09
18:18
Add coverage analysis configuration check-in: 423c312ac9 user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added tests/natools-accumulators-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
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199

------------------------------------------------------------------------------
-- 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.           --
------------------------------------------------------------------------------

package body Natools.Accumulators.Tests is
   package NT renames Natools.Tests;

   procedure Check_Emptiness
     (Report : in out NT.Reporter'Class;
      Accumulator : in out String_Accumulator'Class;
      Test_Name : in String);
   --  Add an item to Report, success being emptiness of Accumulator

   procedure Check_Contents
     (Report : in out NT.Reporter'Class;
      Accumulator : in out String_Accumulator'Class;
      Test_Name : in String;
      Reference : in String);
   --  Add an item to Report, success being Accumulator matching Reference



   procedure Check_Contents
     (Report : in out NT.Reporter'Class;
      Accumulator : in out String_Accumulator'Class;
      Test_Name : in String;
      Reference : in String)
   is
      S : constant String := Accumulator.To_String;
      L : constant Natural := Accumulator.Length;
   begin
      if S'Length /= L then
         NT.Item (Report, Test_Name, NT.Fail);
         NT.Info
           (Report,
            "Inconsistent length" & Natural'Image (L)
            & " for string """ & S & '"');
      elsif S /= Reference then
         NT.Item (Report, Test_Name, NT.Fail);
         NT.Info (Report, "Accumulated """ & S & '"');
         NT.Info (Report, "Reference   """ & Reference & '"');
      else
         NT.Item (Report, Test_Name, NT.Success);
      end if;
   end Check_Contents;


   procedure Check_Emptiness
     (Report : in out NT.Reporter'Class;
      Accumulator : in out String_Accumulator'Class;
      Test_Name : in String)
   is
      L : constant Natural := Accumulator.Length;
      S : constant String := Accumulator.To_String;
   begin
      if L /= 0 or S /= "" then
         NT.Item (Report, Test_Name, NT.Fail);
         NT.Info (Report, "Accumulator.Length is" & Natural'Image (L));
         NT.Info (Report, "Accumulator.To_String is """ & S & '"');
      else
         NT.Item (Report, Test_Name, NT.Success);
      end if;
   end Check_Emptiness;


   procedure Test
     (Report : in out Natools.Tests.Reporter'Class;
      Accumulator : in out String_Accumulator'Class)
   is
      Part_1 : constant String
        := "The quick brown fox jumps over the lazy dog.";
      Part_2 : constant String
        := "Lorem ipsum dolor sit amet, consectetur adipisicing elit.";
      L_1 : constant Natural := 10;
      L_2 : constant Natural := 7;
   begin
      declare
         Name : constant String := "Soft_Reset";
      begin
         Accumulator.Soft_Reset;
         Check_Emptiness (Report, Accumulator, Name);
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "String append";
      begin
         Accumulator.Append (Part_1);
         Check_Contents (Report, Accumulator, Name, Part_1);
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "Character accumulation";
      begin
         for I in Part_2'Range loop
            Accumulator.Append (String'(1 => Part_2 (I)));
         end loop;

         Check_Contents (Report, Accumulator, Name, Part_1 & Part_2);
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "Tail extraction";
         OK : Boolean := True;
      begin
         declare
            T : constant String := Accumulator.Tail (L_1);
         begin
            if T'Length /= L_1 then
               NT.Item (Report, Name, NT.Fail);
               NT.Info (Report,
                  "Wrong tail length" & Natural'Image (T'Length)
                  & ", expected" & Natural'Image (L_1));
               OK := False;
            elsif T /= Part_2 (Part_2'Last - L_1 + 1 .. Part_2'Last) then
               NT.Item (Report, Name, NT.Fail);
               NT.Info (Report, "Incorrect tail """ & T & '"');
               NT.Info (Report, "Expected """
                 & Part_2 (Part_2'Last - L_1 + 1 .. Part_2'Last) & '"');
               OK := False;
            end if;
         end;

         if OK then
            Check_Contents (Report, Accumulator, Name, Part_1 & Part_2);
         end if;
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "Unappend";
      begin
         Accumulator.Unappend (Part_2 (Part_2'Last - L_2 + 1 .. Part_2'Last));
         Check_Contents (Report, Accumulator, Name,
           Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2));
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "No-op Unappend";
      begin
         Accumulator.Unappend (Part_1);
         Check_Contents (Report, Accumulator, Name,
           Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2));
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "In-place To_String";
         Target : String (1 .. Part_1'Length + Part_2'Length)
           := (others => '*');
      begin
         Accumulator.To_String (Target);
         Target (Part_1'Length + Part_2'Length - L_2 + 1 .. Target'Last)
           := Part_2 (Part_2'Last - L_2 + 1 .. Part_2'Last);

         if Target /= Part_1 & Part_2 then
            NT.Item (Report, Name, NT.Fail);
            NT.Info (Report, "Found """ & Target & '"');
            NT.Info (Report, "Expected """ & Target & '"');
         else
            Check_Contents (Report, Accumulator, Name,
              Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2));
         end if;
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;

      declare
         Name : constant String := "Hard_Reset";
      begin
         Accumulator.Hard_Reset;
         Check_Emptiness (Report, Accumulator, Name);
      exception
         when Error : others => NT.Report_Exception (Report, Name, Error);
      end;
   end Test;

end Natools.Accumulators.Tests;
Added tests/natools-accumulators-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

------------------------------------------------------------------------------
-- 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.Accumulators.Tests is a test suite for any object implementing   --
-- the accumulator interface.                                               --
------------------------------------------------------------------------------

with Natools.Tests;

package Natools.Accumulators.Tests is
   pragma Preelaborate (Tests);

   procedure Test
     (Report : in out Natools.Tests.Reporter'Class;
      Accumulator : in out String_Accumulator'Class);
      --  Run a sequence of tests on Accumulator.
      --  This append a sequence of items to Report in the current section.

end Natools.Accumulators.Tests;