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
|
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
|
+
-
-
-
+
+
+
-
+
+
+
-
+
-
+
-
+
-
+
|
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --
------------------------------------------------------------------------------
with Ada.Streams;
with Ada.Strings.Unbounded;
with Natools.Smaz_256;
with Natools.Smaz_Generic;
with Natools.Smaz_Original;
package body Natools.Smaz_Tests is
function Image (S : Ada.Streams.Stream_Element_Array) return String;
procedure Roundtrip_Test
generic
with package Smaz is new Natools.Smaz_Generic (<>);
procedure Generic_Roundtrip_Test
(Test : in out NT.Test;
Dict : in Smaz_256.Dictionary;
Dict : in Smaz.Dictionary;
Decompressed : in String;
Compressed : in Ada.Streams.Stream_Element_Array);
function Image (S : Ada.Streams.Stream_Element_Array) return String;
------------------------------
-- Local Helper Subprograms --
------------------------------
function Image (S : Ada.Streams.Stream_Element_Array) return String is
use Ada.Strings.Unbounded;
Result : Unbounded_String;
begin
for I in S'Range loop
Append (Result, Ada.Streams.Stream_Element'Image (S (I)));
end loop;
return To_String (Result);
end Image;
procedure Roundtrip_Test
procedure Generic_Roundtrip_Test
(Test : in out NT.Test;
Dict : in Smaz_256.Dictionary;
Dict : in Smaz.Dictionary;
Decompressed : in String;
Compressed : in Ada.Streams.Stream_Element_Array)
is
use type Ada.Streams.Stream_Element_Array;
use type Ada.Streams.Stream_Element_Offset;
begin
declare
First_OK : Boolean := False;
begin
declare
Buffer : constant Ada.Streams.Stream_Element_Array
:= Smaz_256.Compress (Dict, Decompressed);
:= Smaz.Compress (Dict, Decompressed);
begin
First_OK := True;
if Buffer /= Compressed then
Test.Fail ("Bad compression of """ & Decompressed & '"');
Test.Info ("Found: " & Image (Buffer));
Test.Info ("Expected:" & Image (Compressed));
declare
Round : constant String
:= Smaz_256.Decompress (Dict, Buffer);
:= Smaz.Decompress (Dict, Buffer);
begin
if Round /= Decompressed then
Test.Info ("Roundtrip failed, got: """ & Round & '"');
else
Test.Info ("Roundtrip OK");
end if;
end;
|
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
|
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
|
-
+
-
+
-
+
+
+
+
+
-
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
end;
declare
First_OK : Boolean := False;
begin
declare
Buffer : constant String
:= Smaz_256.Decompress (Dict, Compressed);
:= Smaz.Decompress (Dict, Compressed);
begin
First_OK := True;
if Buffer /= Decompressed then
Test.Fail ("Bad decompression of " & Image (Compressed));
Test.Info ("Found: """ & Buffer & '"');
Test.Info ("Expected:""" & Decompressed & '"');
declare
Round : constant Ada.Streams.Stream_Element_Array
:= Smaz_256.Compress (Dict, Buffer);
:= Smaz.Compress (Dict, Buffer);
begin
if Round /= Compressed then
Test.Info ("Roundtrip failed, got: " & Image (Round));
else
Test.Info ("Roundtrip OK");
end if;
end;
end if;
end;
exception
when Error : others =>
if not First_OK then
Test.Info ("During compression of " & Image (Compressed));
end if;
Test.Report_Exception (Error, NT.Fail);
end;
end Roundtrip_Test;
end Generic_Roundtrip_Test;
procedure Roundtrip_Test is new Generic_Roundtrip_Test (Natools.Smaz_256);
-------------------------
-- Complete Test Suite --
-------------------------
procedure All_Tests (Report : in out NT.Reporter'Class) is
begin
Report.Section ("Base 256");
Sample_Strings (Report);
All_Tests_256 (Report);
Report.End_Section;
end All_Tests;
----------------------
-- Individual Tests --
----------------------
------------------------------
-- Test Suite for Each Base --
------------------------------
procedure All_Tests_256 (Report : in out NT.Reporter'Class) is
begin
Sample_Strings_256 (Report);
end All_Tests_256;
-------------------------------
-- Individual Base-256 Tests --
-------------------------------
procedure Sample_Strings (Report : in out NT.Reporter'Class) is
procedure Sample_Strings_256 (Report : in out NT.Reporter'Class) is
Test : NT.Test := Report.Item ("Roundtrip on sample strings");
begin
Roundtrip_Test (Test, Smaz_Original.Dictionary,
"This is a small string",
(254, 84, 76, 56, 172, 62, 173, 152, 62, 195, 70));
Roundtrip_Test (Test, Smaz_Original.Dictionary,
"foobar",
|
179
180
181
182
183
184
185
186
187
188
|
198
199
200
201
202
203
204
205
206
207
|
-
+
|
48, 243, 152, 0, 255, 7, 49, 48, 32, 50, 48, 32, 51,
48, 161, 45, 60, 33, 166, 0, 231, 71, 151, 3, 3, 87));
Roundtrip_Test (Test, Smaz_Original.Dictionary,
": : : :",
(255, 6, 58, 32, 58, 32, 58, 32, 58));
exception
when Error : others => Test.Report_Exception (Error);
end Sample_Strings;
end Sample_Strings_256;
end Natools.Smaz_Tests;
|