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;