VirtualBox

source: vbox/trunk/src/libs/zlib-1.2.1/contrib/ada/test.adb@ 27361

最後變更 在這個檔案從27361是 6392,由 vboxsync 提交於 17 年 前

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

© 2024 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy Automated Access Etiquette