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: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $ 10 11 -- Test/demo program for the generic read interface. 12 13 with Ada.Numerics.Discrete_Random; 14 with Ada.Streams; 15 with Ada.Text_IO; 16 17 with ZLib; 18 19 procedure Read is 20 21 use Ada.Streams; 22 23 ------------------------------------ 24 -- Test configuration parameters -- 25 ------------------------------------ 26 27 File_Size : Stream_Element_Offset := 100_000; 28 29 Continuous : constant Boolean := False; 30 -- If this constant is True, the test would be repeated again and again, 31 -- with increment File_Size for every iteration. 32 33 Header : constant ZLib.Header_Type := ZLib.Default; 34 -- Do not use Header other than Default in ZLib versions 1.1.4 and older. 35 36 Init_Random : constant := 8; 37 -- We are using the same random sequence, in case of we catch bug, 38 -- so we would be able to reproduce it. 39 40 -- End -- 41 42 Pack_Size : Stream_Element_Offset; 43 Offset : Stream_Element_Offset; 44 45 Filter : ZLib.Filter_Type; 46 47 subtype Visible_Symbols 48 is Stream_Element range 16#20# .. 16#7E#; 49 50 package Random_Elements is new 51 Ada.Numerics.Discrete_Random (Visible_Symbols); 52 53 Gen : Random_Elements.Generator; 54 Period : constant Stream_Element_Offset := 200; 55 -- Period constant variable for random generator not to be very random. 56 -- Bigger period, harder random. 57 58 Read_Buffer : Stream_Element_Array (1 .. 2048); 59 Read_First : Stream_Element_Offset; 60 Read_Last : Stream_Element_Offset; 61 62 procedure Reset; 63 64 procedure Read 65 (Item : out Stream_Element_Array; 66 Last : out Stream_Element_Offset); 67 -- this procedure is for generic instantiation of 68 -- ZLib.Read 69 -- reading data from the File_In. 70 71 procedure Read is new ZLib.Read 72 (Read, 73 Read_Buffer, 74 Rest_First => Read_First, 75 Rest_Last => Read_Last); 76 77 ---------- 78 -- Read -- 79 ---------- 80 81 procedure Read 82 (Item : out Stream_Element_Array; 83 Last : out Stream_Element_Offset) is 84 begin 85 Last := Stream_Element_Offset'Min 86 (Item'Last, 87 Item'First + File_Size - Offset); 88 89 for J in Item'First .. Last loop 90 if J < Item'First + Period then 91 Item (J) := Random_Elements.Random (Gen); 92 else 93 Item (J) := Item (J - Period); 94 end if; 95 96 Offset := Offset + 1; 97 end loop; 98 end Read; 99 100 ----------- 101 -- Reset -- 102 ----------- 103 104 procedure Reset is 105 begin 106 Random_Elements.Reset (Gen, Init_Random); 107 Pack_Size := 0; 108 Offset := 1; 109 Read_First := Read_Buffer'Last + 1; 110 Read_Last := Read_Buffer'Last; 111 end Reset; 112 113 begin 114 Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version); 115 116 loop 117 for Level in ZLib.Compression_Level'Range loop 118 119 Ada.Text_IO.Put ("Level =" 120 & ZLib.Compression_Level'Image (Level)); 121 122 -- Deflate using generic instantiation. 123 124 ZLib.Deflate_Init 125 (Filter, 126 Level, 127 Header => Header); 128 129 Reset; 130 131 Ada.Text_IO.Put 132 (Stream_Element_Offset'Image (File_Size) & " ->"); 133 134 loop 135 declare 136 Buffer : Stream_Element_Array (1 .. 1024); 137 Last : Stream_Element_Offset; 138 begin 139 Read (Filter, Buffer, Last); 140 141 Pack_Size := Pack_Size + Last - Buffer'First + 1; 142 143 exit when Last < Buffer'Last; 144 end; 145 end loop; 146 147 Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size)); 148 149 ZLib.Close (Filter); 150 end loop; 151 152 exit when not Continuous; 153 154 File_Size := File_Size + 1; 155 end loop; 156 end Read; 157
