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.1.4 christos -- Generate file of specified 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.1.4 christos -- The procedure comparing 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