test.adb revision 1.1.1.3 1 1.1 christos ----------------------------------------------------------------
2 1.1 christos -- ZLib for Ada thick binding. --
3 1.1 christos -- --
4 1.1 christos -- Copyright (C) 2002-2003 Dmitriy Anisimkov --
5 1.1 christos -- --
6 1.1 christos -- Open source license information is in the zlib.ads file. --
7 1.1 christos ----------------------------------------------------------------
8 1.1 christos
9 1.1.1.3 christos -- Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp
10 1.1 christos
11 1.1 christos -- The program has a few aims.
12 1.1 christos -- 1. Test ZLib.Ada95 thick binding functionality.
13 1.1 christos -- 2. Show the example of use main functionality of the ZLib.Ada95 binding.
14 1.1 christos -- 3. Build this program automatically compile all ZLib.Ada95 packages under
15 1.1 christos -- GNAT Ada95 compiler.
16 1.1 christos
17 1.1 christos with ZLib.Streams;
18 1.1 christos with Ada.Streams.Stream_IO;
19 1.1 christos with Ada.Numerics.Discrete_Random;
20 1.1 christos
21 1.1 christos with Ada.Text_IO;
22 1.1 christos
23 1.1 christos with Ada.Calendar;
24 1.1 christos
25 1.1 christos procedure Test is
26 1.1 christos
27 1.1 christos use Ada.Streams;
28 1.1 christos use Stream_IO;
29 1.1 christos
30 1.1 christos ------------------------------------
31 1.1 christos -- Test configuration parameters --
32 1.1 christos ------------------------------------
33 1.1 christos
34 1.1 christos File_Size : Count := 100_000;
35 1.1 christos Continuous : constant Boolean := False;
36 1.1 christos
37 1.1 christos Header : constant ZLib.Header_Type := ZLib.Default;
38 1.1 christos -- ZLib.None;
39 1.1 christos -- ZLib.Auto;
40 1.1 christos -- ZLib.GZip;
41 1.1 christos -- Do not use Header other then Default in ZLib versions 1.1.4
42 1.1 christos -- and older.
43 1.1 christos
44 1.1 christos Strategy : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
45 1.1 christos Init_Random : constant := 10;
46 1.1 christos
47 1.1 christos -- End --
48 1.1 christos
49 1.1 christos In_File_Name : constant String := "testzlib.in";
50 1.1 christos -- Name of the input file
51 1.1 christos
52 1.1 christos Z_File_Name : constant String := "testzlib.zlb";
53 1.1 christos -- Name of the compressed file.
54 1.1 christos
55 1.1 christos Out_File_Name : constant String := "testzlib.out";
56 1.1 christos -- Name of the decompressed file.
57 1.1 christos
58 1.1 christos File_In : File_Type;
59 1.1 christos File_Out : File_Type;
60 1.1 christos File_Back : File_Type;
61 1.1 christos File_Z : ZLib.Streams.Stream_Type;
62 1.1 christos
63 1.1 christos Filter : ZLib.Filter_Type;
64 1.1 christos
65 1.1 christos Time_Stamp : Ada.Calendar.Time;
66 1.1 christos
67 1.1 christos procedure Generate_File;
68 1.1 christos -- Generate file of spetsified size with some random data.
69 1.1 christos -- The random data is repeatable, for the good compression.
70 1.1 christos
71 1.1 christos procedure Compare_Streams
72 1.1 christos (Left, Right : in out Root_Stream_Type'Class);
73 1.1 christos -- The procedure compearing data in 2 streams.
74 1.1 christos -- It is for compare data before and after compression/decompression.
75 1.1 christos
76 1.1 christos procedure Compare_Files (Left, Right : String);
77 1.1 christos -- Compare files. Based on the Compare_Streams.
78 1.1 christos
79 1.1 christos procedure Copy_Streams
80 1.1 christos (Source, Target : in out Root_Stream_Type'Class;
81 1.1 christos Buffer_Size : in Stream_Element_Offset := 1024);
82 1.1 christos -- Copying data from one stream to another. It is for test stream
83 1.1 christos -- interface of the library.
84 1.1 christos
85 1.1 christos procedure Data_In
86 1.1 christos (Item : out Stream_Element_Array;
87 1.1 christos Last : out Stream_Element_Offset);
88 1.1 christos -- this procedure is for generic instantiation of
89 1.1 christos -- ZLib.Generic_Translate.
90 1.1 christos -- reading data from the File_In.
91 1.1 christos
92 1.1 christos procedure Data_Out (Item : in Stream_Element_Array);
93 1.1 christos -- this procedure is for generic instantiation of
94 1.1 christos -- ZLib.Generic_Translate.
95 1.1 christos -- writing data to the File_Out.
96 1.1 christos
97 1.1 christos procedure Stamp;
98 1.1 christos -- Store the timestamp to the local variable.
99 1.1 christos
100 1.1 christos procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
101 1.1 christos -- Print the time statistic with the message.
102 1.1 christos
103 1.1 christos procedure Translate is new ZLib.Generic_Translate
104 1.1 christos (Data_In => Data_In,
105 1.1 christos Data_Out => Data_Out);
106 1.1 christos -- This procedure is moving data from File_In to File_Out
107 1.1 christos -- with compression or decompression, depend on initialization of
108 1.1 christos -- Filter parameter.
109 1.1 christos
110 1.1 christos -------------------
111 1.1 christos -- Compare_Files --
112 1.1 christos -------------------
113 1.1 christos
114 1.1 christos procedure Compare_Files (Left, Right : String) is
115 1.1 christos Left_File, Right_File : File_Type;
116 1.1 christos begin
117 1.1 christos Open (Left_File, In_File, Left);
118 1.1 christos Open (Right_File, In_File, Right);
119 1.1 christos Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
120 1.1 christos Close (Left_File);
121 1.1 christos Close (Right_File);
122 1.1 christos end Compare_Files;
123 1.1 christos
124 1.1 christos ---------------------
125 1.1 christos -- Compare_Streams --
126 1.1 christos ---------------------
127 1.1 christos
128 1.1 christos procedure Compare_Streams
129 1.1 christos (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
130 1.1 christos is
131 1.1 christos Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
132 1.1 christos Left_Last, Right_Last : Stream_Element_Offset;
133 1.1 christos begin
134 1.1 christos loop
135 1.1 christos Read (Left, Left_Buffer, Left_Last);
136 1.1 christos Read (Right, Right_Buffer, Right_Last);
137 1.1 christos
138 1.1 christos if Left_Last /= Right_Last then
139 1.1 christos Ada.Text_IO.Put_Line ("Compare error :"
140 1.1 christos & Stream_Element_Offset'Image (Left_Last)
141 1.1 christos & " /= "
142 1.1 christos & Stream_Element_Offset'Image (Right_Last));
143 1.1 christos
144 1.1 christos raise Constraint_Error;
145 1.1 christos
146 1.1 christos elsif Left_Buffer (0 .. Left_Last)
147 1.1 christos /= Right_Buffer (0 .. Right_Last)
148 1.1 christos then
149 1.1 christos Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
150 1.1 christos raise Constraint_Error;
151 1.1 christos
152 1.1 christos end if;
153 1.1 christos
154 1.1 christos exit when Left_Last < Left_Buffer'Last;
155 1.1 christos end loop;
156 1.1 christos end Compare_Streams;
157 1.1 christos
158 1.1 christos ------------------
159 1.1 christos -- Copy_Streams --
160 1.1 christos ------------------
161 1.1 christos
162 1.1 christos procedure Copy_Streams
163 1.1 christos (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
164 1.1 christos Buffer_Size : in Stream_Element_Offset := 1024)
165 1.1 christos is
166 1.1 christos Buffer : Stream_Element_Array (1 .. Buffer_Size);
167 1.1 christos Last : Stream_Element_Offset;
168 1.1 christos begin
169 1.1 christos loop
170 1.1 christos Read (Source, Buffer, Last);
171 1.1 christos Write (Target, Buffer (1 .. Last));
172 1.1 christos
173 1.1 christos exit when Last < Buffer'Last;
174 1.1 christos end loop;
175 1.1 christos end Copy_Streams;
176 1.1 christos
177 1.1 christos -------------
178 1.1 christos -- Data_In --
179 1.1 christos -------------
180 1.1 christos
181 1.1 christos procedure Data_In
182 1.1 christos (Item : out Stream_Element_Array;
183 1.1 christos Last : out Stream_Element_Offset) is
184 1.1 christos begin
185 1.1 christos Read (File_In, Item, Last);
186 1.1 christos end Data_In;
187 1.1 christos
188 1.1 christos --------------
189 1.1 christos -- Data_Out --
190 1.1 christos --------------
191 1.1 christos
192 1.1 christos procedure Data_Out (Item : in Stream_Element_Array) is
193 1.1 christos begin
194 1.1 christos Write (File_Out, Item);
195 1.1 christos end Data_Out;
196 1.1 christos
197 1.1 christos -------------------
198 1.1 christos -- Generate_File --
199 1.1 christos -------------------
200 1.1 christos
201 1.1 christos procedure Generate_File is
202 1.1 christos subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
203 1.1 christos
204 1.1 christos package Random_Elements is
205 1.1 christos new Ada.Numerics.Discrete_Random (Visible_Symbols);
206 1.1 christos
207 1.1 christos Gen : Random_Elements.Generator;
208 1.1 christos Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
209 1.1 christos
210 1.1 christos Buffer_Count : constant Count := File_Size / Buffer'Length;
211 1.1 christos -- Number of same buffers in the packet.
212 1.1 christos
213 1.1 christos Density : constant Count := 30; -- from 0 to Buffer'Length - 2;
214 1.1 christos
215 1.1 christos procedure Fill_Buffer (J, D : in Count);
216 1.1 christos -- Change the part of the buffer.
217 1.1 christos
218 1.1 christos -----------------
219 1.1 christos -- Fill_Buffer --
220 1.1 christos -----------------
221 1.1 christos
222 1.1 christos procedure Fill_Buffer (J, D : in Count) is
223 1.1 christos begin
224 1.1 christos for K in 0 .. D loop
225 1.1 christos Buffer
226 1.1 christos (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
227 1.1 christos := Random_Elements.Random (Gen);
228 1.1 christos
229 1.1 christos end loop;
230 1.1 christos end Fill_Buffer;
231 1.1 christos
232 1.1 christos begin
233 1.1 christos Random_Elements.Reset (Gen, Init_Random);
234 1.1 christos
235 1.1 christos Create (File_In, Out_File, In_File_Name);
236 1.1 christos
237 1.1 christos Fill_Buffer (1, Buffer'Length - 2);
238 1.1 christos
239 1.1 christos for J in 1 .. Buffer_Count loop
240 1.1 christos Write (File_In, Buffer);
241 1.1 christos
242 1.1 christos Fill_Buffer (J, Density);
243 1.1 christos end loop;
244 1.1 christos
245 1.1 christos -- fill remain size.
246 1.1 christos
247 1.1 christos Write
248 1.1 christos (File_In,
249 1.1 christos Buffer
250 1.1 christos (1 .. Stream_Element_Offset
251 1.1 christos (File_Size - Buffer'Length * Buffer_Count)));
252 1.1 christos
253 1.1 christos Flush (File_In);
254 1.1 christos Close (File_In);
255 1.1 christos end Generate_File;
256 1.1 christos
257 1.1 christos ---------------------
258 1.1 christos -- Print_Statistic --
259 1.1 christos ---------------------
260 1.1 christos
261 1.1 christos procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
262 1.1 christos use Ada.Calendar;
263 1.1 christos use Ada.Text_IO;
264 1.1 christos
265 1.1 christos package Count_IO is new Integer_IO (ZLib.Count);
266 1.1 christos
267 1.1 christos Curr_Dur : Duration := Clock - Time_Stamp;
268 1.1 christos begin
269 1.1 christos Put (Msg);
270 1.1 christos
271 1.1 christos Set_Col (20);
272 1.1 christos Ada.Text_IO.Put ("size =");
273 1.1 christos
274 1.1 christos Count_IO.Put
275 1.1 christos (Data_Size,
276 1.1 christos Width => Stream_IO.Count'Image (File_Size)'Length);
277 1.1 christos
278 1.1 christos Put_Line (" duration =" & Duration'Image (Curr_Dur));
279 1.1 christos end Print_Statistic;
280 1.1 christos
281 1.1 christos -----------
282 1.1 christos -- Stamp --
283 1.1 christos -----------
284 1.1 christos
285 1.1 christos procedure Stamp is
286 1.1 christos begin
287 1.1 christos Time_Stamp := Ada.Calendar.Clock;
288 1.1 christos end Stamp;
289 1.1 christos
290 1.1 christos begin
291 1.1 christos Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
292 1.1 christos
293 1.1 christos loop
294 1.1 christos Generate_File;
295 1.1 christos
296 1.1 christos for Level in ZLib.Compression_Level'Range loop
297 1.1 christos
298 1.1 christos Ada.Text_IO.Put_Line ("Level ="
299 1.1 christos & ZLib.Compression_Level'Image (Level));
300 1.1 christos
301 1.1 christos -- Test generic interface.
302 1.1 christos Open (File_In, In_File, In_File_Name);
303 1.1 christos Create (File_Out, Out_File, Z_File_Name);
304 1.1 christos
305 1.1 christos Stamp;
306 1.1 christos
307 1.1 christos -- Deflate using generic instantiation.
308 1.1 christos
309 1.1 christos ZLib.Deflate_Init
310 1.1 christos (Filter => Filter,
311 1.1 christos Level => Level,
312 1.1 christos Strategy => Strategy,
313 1.1 christos Header => Header);
314 1.1 christos
315 1.1 christos Translate (Filter);
316 1.1 christos Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
317 1.1 christos ZLib.Close (Filter);
318 1.1 christos
319 1.1 christos Close (File_In);
320 1.1 christos Close (File_Out);
321 1.1 christos
322 1.1 christos Open (File_In, In_File, Z_File_Name);
323 1.1 christos Create (File_Out, Out_File, Out_File_Name);
324 1.1 christos
325 1.1 christos Stamp;
326 1.1 christos
327 1.1 christos -- Inflate using generic instantiation.
328 1.1 christos
329 1.1 christos ZLib.Inflate_Init (Filter, Header => Header);
330 1.1 christos
331 1.1 christos Translate (Filter);
332 1.1 christos Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
333 1.1 christos
334 1.1 christos ZLib.Close (Filter);
335 1.1 christos
336 1.1 christos Close (File_In);
337 1.1 christos Close (File_Out);
338 1.1 christos
339 1.1 christos Compare_Files (In_File_Name, Out_File_Name);
340 1.1 christos
341 1.1 christos -- Test stream interface.
342 1.1 christos
343 1.1 christos -- Compress to the back stream.
344 1.1 christos
345 1.1 christos Open (File_In, In_File, In_File_Name);
346 1.1 christos Create (File_Back, Out_File, Z_File_Name);
347 1.1 christos
348 1.1 christos Stamp;
349 1.1 christos
350 1.1 christos ZLib.Streams.Create
351 1.1 christos (Stream => File_Z,
352 1.1 christos Mode => ZLib.Streams.Out_Stream,
353 1.1 christos Back => ZLib.Streams.Stream_Access
354 1.1 christos (Stream (File_Back)),
355 1.1 christos Back_Compressed => True,
356 1.1 christos Level => Level,
357 1.1 christos Strategy => Strategy,
358 1.1 christos Header => Header);
359 1.1 christos
360 1.1 christos Copy_Streams
361 1.1 christos (Source => Stream (File_In).all,
362 1.1 christos Target => File_Z);
363 1.1 christos
364 1.1 christos -- Flushing internal buffers to the back stream.
365 1.1 christos
366 1.1 christos ZLib.Streams.Flush (File_Z, ZLib.Finish);
367 1.1 christos
368 1.1 christos Print_Statistic ("Write compress",
369 1.1 christos ZLib.Streams.Write_Total_Out (File_Z));
370 1.1 christos
371 1.1 christos ZLib.Streams.Close (File_Z);
372 1.1 christos
373 1.1 christos Close (File_In);
374 1.1 christos Close (File_Back);
375 1.1 christos
376 1.1 christos -- Compare reading from original file and from
377 1.1 christos -- decompression stream.
378 1.1 christos
379 1.1 christos Open (File_In, In_File, In_File_Name);
380 1.1 christos Open (File_Back, In_File, Z_File_Name);
381 1.1 christos
382 1.1 christos ZLib.Streams.Create
383 1.1 christos (Stream => File_Z,
384 1.1 christos Mode => ZLib.Streams.In_Stream,
385 1.1 christos Back => ZLib.Streams.Stream_Access
386 1.1 christos (Stream (File_Back)),
387 1.1 christos Back_Compressed => True,
388 1.1 christos Header => Header);
389 1.1 christos
390 1.1 christos Stamp;
391 1.1 christos Compare_Streams (Stream (File_In).all, File_Z);
392 1.1 christos
393 1.1 christos Print_Statistic ("Read decompress",
394 1.1 christos ZLib.Streams.Read_Total_Out (File_Z));
395 1.1 christos
396 1.1 christos ZLib.Streams.Close (File_Z);
397 1.1 christos Close (File_In);
398 1.1 christos Close (File_Back);
399 1.1 christos
400 1.1 christos -- Compress by reading from compression stream.
401 1.1 christos
402 1.1 christos Open (File_Back, In_File, In_File_Name);
403 1.1 christos Create (File_Out, Out_File, Z_File_Name);
404 1.1 christos
405 1.1 christos ZLib.Streams.Create
406 1.1 christos (Stream => File_Z,
407 1.1 christos Mode => ZLib.Streams.In_Stream,
408 1.1 christos Back => ZLib.Streams.Stream_Access
409 1.1 christos (Stream (File_Back)),
410 1.1 christos Back_Compressed => False,
411 1.1 christos Level => Level,
412 1.1 christos Strategy => Strategy,
413 1.1 christos Header => Header);
414 1.1 christos
415 1.1 christos Stamp;
416 1.1 christos Copy_Streams
417 1.1 christos (Source => File_Z,
418 1.1 christos Target => Stream (File_Out).all);
419 1.1 christos
420 1.1 christos Print_Statistic ("Read compress",
421 1.1 christos ZLib.Streams.Read_Total_Out (File_Z));
422 1.1 christos
423 1.1 christos ZLib.Streams.Close (File_Z);
424 1.1 christos
425 1.1 christos Close (File_Out);
426 1.1 christos Close (File_Back);
427 1.1 christos
428 1.1 christos -- Decompress to decompression stream.
429 1.1 christos
430 1.1 christos Open (File_In, In_File, Z_File_Name);
431 1.1 christos Create (File_Back, Out_File, Out_File_Name);
432 1.1 christos
433 1.1 christos ZLib.Streams.Create
434 1.1 christos (Stream => File_Z,
435 1.1 christos Mode => ZLib.Streams.Out_Stream,
436 1.1 christos Back => ZLib.Streams.Stream_Access
437 1.1 christos (Stream (File_Back)),
438 1.1 christos Back_Compressed => False,
439 1.1 christos Header => Header);
440 1.1 christos
441 1.1 christos Stamp;
442 1.1 christos
443 1.1 christos Copy_Streams
444 1.1 christos (Source => Stream (File_In).all,
445 1.1 christos Target => File_Z);
446 1.1 christos
447 1.1 christos Print_Statistic ("Write decompress",
448 1.1 christos ZLib.Streams.Write_Total_Out (File_Z));
449 1.1 christos
450 1.1 christos ZLib.Streams.Close (File_Z);
451 1.1 christos Close (File_In);
452 1.1 christos Close (File_Back);
453 1.1 christos
454 1.1 christos Compare_Files (In_File_Name, Out_File_Name);
455 1.1 christos end loop;
456 1.1 christos
457 1.1 christos Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
458 1.1 christos
459 1.1 christos exit when not Continuous;
460 1.1 christos
461 1.1 christos File_Size := File_Size + 1;
462 1.1 christos end loop;
463 1.1 christos end Test;
464