xref: /netbsd-src/external/gpl3/gdb/dist/zlib/contrib/pascal/example.pas (revision 212397c69a103ae7e5eafa8731ddfae671d2dee7)
1*212397c6Schristos (* example.c -- usage example of the zlib compression library
2*212397c6Schristos  * Copyright (C) 1995-2003 Jean-loup Gailly.
3*212397c6Schristos  * For conditions of distribution and use, see copyright notice in zlib.h
4*212397c6Schristos  *
5*212397c6Schristos  * Pascal translation
6*212397c6Schristos  * Copyright (C) 1998 by Jacques Nomssi Nzali.
7*212397c6Schristos  * For conditions of distribution and use, see copyright notice in readme.txt
8*212397c6Schristos  *
9*212397c6Schristos  * Adaptation to the zlibpas interface
10*212397c6Schristos  * Copyright (C) 2003 by Cosmin Truta.
11*212397c6Schristos  * For conditions of distribution and use, see copyright notice in readme.txt
12*212397c6Schristos  *)
13*212397c6Schristos 
14*212397c6Schristos program example;
15*212397c6Schristos 
16*212397c6Schristos {$DEFINE TEST_COMPRESS}
17*212397c6Schristos {DO NOT $DEFINE TEST_GZIO}
18*212397c6Schristos {$DEFINE TEST_DEFLATE}
19*212397c6Schristos {$DEFINE TEST_INFLATE}
20*212397c6Schristos {$DEFINE TEST_FLUSH}
21*212397c6Schristos {$DEFINE TEST_SYNC}
22*212397c6Schristos {$DEFINE TEST_DICT}
23*212397c6Schristos 
24*212397c6Schristos uses SysUtils, zlibpas;
25*212397c6Schristos 
26*212397c6Schristos const TESTFILE = 'foo.gz';
27*212397c6Schristos 
28*212397c6Schristos (* "hello world" would be more standard, but the repeated "hello"
29*212397c6Schristos  * stresses the compression code better, sorry...
30*212397c6Schristos  *)
31*212397c6Schristos const hello: PChar = 'hello, hello!';
32*212397c6Schristos 
33*212397c6Schristos const dictionary: PChar = 'hello';
34*212397c6Schristos 
35*212397c6Schristos var dictId: LongInt; (* Adler32 value of the dictionary *)
36*212397c6Schristos 
37*212397c6Schristos procedure CHECK_ERR(err: Integer; msg: String);
38*212397c6Schristos begin
39*212397c6Schristos   if err <> Z_OK then
40*212397c6Schristos   begin
41*212397c6Schristos     WriteLn(msg, ' error: ', err);
42*212397c6Schristos     Halt(1);
43*212397c6Schristos   end;
44*212397c6Schristos end;
45*212397c6Schristos 
46*212397c6Schristos procedure EXIT_ERR(const msg: String);
47*212397c6Schristos begin
48*212397c6Schristos   WriteLn('Error: ', msg);
49*212397c6Schristos   Halt(1);
50*212397c6Schristos end;
51*212397c6Schristos 
52*212397c6Schristos (* ===========================================================================
53*212397c6Schristos  * Test compress and uncompress
54*212397c6Schristos  *)
55*212397c6Schristos {$IFDEF TEST_COMPRESS}
56*212397c6Schristos procedure test_compress(compr: Pointer; comprLen: LongInt;
57*212397c6Schristos                         uncompr: Pointer; uncomprLen: LongInt);
58*212397c6Schristos var err: Integer;
59*212397c6Schristos     len: LongInt;
60*212397c6Schristos begin
61*212397c6Schristos   len := StrLen(hello)+1;
62*212397c6Schristos 
63*212397c6Schristos   err := compress(compr, comprLen, hello, len);
64*212397c6Schristos   CHECK_ERR(err, 'compress');
65*212397c6Schristos 
66*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
67*212397c6Schristos 
68*212397c6Schristos   err := uncompress(uncompr, uncomprLen, compr, comprLen);
69*212397c6Schristos   CHECK_ERR(err, 'uncompress');
70*212397c6Schristos 
71*212397c6Schristos   if StrComp(PChar(uncompr), hello) <> 0 then
72*212397c6Schristos     EXIT_ERR('bad uncompress')
73*212397c6Schristos   else
74*212397c6Schristos     WriteLn('uncompress(): ', PChar(uncompr));
75*212397c6Schristos end;
76*212397c6Schristos {$ENDIF}
77*212397c6Schristos 
78*212397c6Schristos (* ===========================================================================
79*212397c6Schristos  * Test read/write of .gz files
80*212397c6Schristos  *)
81*212397c6Schristos {$IFDEF TEST_GZIO}
82*212397c6Schristos procedure test_gzio(const fname: PChar; (* compressed file name *)
83*212397c6Schristos                     uncompr: Pointer;
84*212397c6Schristos                     uncomprLen: LongInt);
85*212397c6Schristos var err: Integer;
86*212397c6Schristos     len: Integer;
87*212397c6Schristos     zfile: gzFile;
88*212397c6Schristos     pos: LongInt;
89*212397c6Schristos begin
90*212397c6Schristos   len := StrLen(hello)+1;
91*212397c6Schristos 
92*212397c6Schristos   zfile := gzopen(fname, 'wb');
93*212397c6Schristos   if zfile = NIL then
94*212397c6Schristos   begin
95*212397c6Schristos     WriteLn('gzopen error');
96*212397c6Schristos     Halt(1);
97*212397c6Schristos   end;
98*212397c6Schristos   gzputc(zfile, 'h');
99*212397c6Schristos   if gzputs(zfile, 'ello') <> 4 then
100*212397c6Schristos   begin
101*212397c6Schristos     WriteLn('gzputs err: ', gzerror(zfile, err));
102*212397c6Schristos     Halt(1);
103*212397c6Schristos   end;
104*212397c6Schristos   {$IFDEF GZ_FORMAT_STRING}
105*212397c6Schristos   if gzprintf(zfile, ', %s!', 'hello') <> 8 then
106*212397c6Schristos   begin
107*212397c6Schristos     WriteLn('gzprintf err: ', gzerror(zfile, err));
108*212397c6Schristos     Halt(1);
109*212397c6Schristos   end;
110*212397c6Schristos   {$ELSE}
111*212397c6Schristos   if gzputs(zfile, ', hello!') <> 8 then
112*212397c6Schristos   begin
113*212397c6Schristos     WriteLn('gzputs err: ', gzerror(zfile, err));
114*212397c6Schristos     Halt(1);
115*212397c6Schristos   end;
116*212397c6Schristos   {$ENDIF}
117*212397c6Schristos   gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *)
118*212397c6Schristos   gzclose(zfile);
119*212397c6Schristos 
120*212397c6Schristos   zfile := gzopen(fname, 'rb');
121*212397c6Schristos   if zfile = NIL then
122*212397c6Schristos   begin
123*212397c6Schristos     WriteLn('gzopen error');
124*212397c6Schristos     Halt(1);
125*212397c6Schristos   end;
126*212397c6Schristos 
127*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
128*212397c6Schristos 
129*212397c6Schristos   if gzread(zfile, uncompr, uncomprLen) <> len then
130*212397c6Schristos   begin
131*212397c6Schristos     WriteLn('gzread err: ', gzerror(zfile, err));
132*212397c6Schristos     Halt(1);
133*212397c6Schristos   end;
134*212397c6Schristos   if StrComp(PChar(uncompr), hello) <> 0 then
135*212397c6Schristos   begin
136*212397c6Schristos     WriteLn('bad gzread: ', PChar(uncompr));
137*212397c6Schristos     Halt(1);
138*212397c6Schristos   end
139*212397c6Schristos   else
140*212397c6Schristos     WriteLn('gzread(): ', PChar(uncompr));
141*212397c6Schristos 
142*212397c6Schristos   pos := gzseek(zfile, -8, SEEK_CUR);
143*212397c6Schristos   if (pos <> 6) or (gztell(zfile) <> pos) then
144*212397c6Schristos   begin
145*212397c6Schristos     WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile));
146*212397c6Schristos     Halt(1);
147*212397c6Schristos   end;
148*212397c6Schristos 
149*212397c6Schristos   if gzgetc(zfile) <> ' ' then
150*212397c6Schristos   begin
151*212397c6Schristos     WriteLn('gzgetc error');
152*212397c6Schristos     Halt(1);
153*212397c6Schristos   end;
154*212397c6Schristos 
155*212397c6Schristos   if gzungetc(' ', zfile) <> ' ' then
156*212397c6Schristos   begin
157*212397c6Schristos     WriteLn('gzungetc error');
158*212397c6Schristos     Halt(1);
159*212397c6Schristos   end;
160*212397c6Schristos 
161*212397c6Schristos   gzgets(zfile, PChar(uncompr), uncomprLen);
162*212397c6Schristos   uncomprLen := StrLen(PChar(uncompr));
163*212397c6Schristos   if uncomprLen <> 7 then (* " hello!" *)
164*212397c6Schristos   begin
165*212397c6Schristos     WriteLn('gzgets err after gzseek: ', gzerror(zfile, err));
166*212397c6Schristos     Halt(1);
167*212397c6Schristos   end;
168*212397c6Schristos   if StrComp(PChar(uncompr), hello + 6) <> 0 then
169*212397c6Schristos   begin
170*212397c6Schristos     WriteLn('bad gzgets after gzseek');
171*212397c6Schristos     Halt(1);
172*212397c6Schristos   end
173*212397c6Schristos   else
174*212397c6Schristos     WriteLn('gzgets() after gzseek: ', PChar(uncompr));
175*212397c6Schristos 
176*212397c6Schristos   gzclose(zfile);
177*212397c6Schristos end;
178*212397c6Schristos {$ENDIF}
179*212397c6Schristos 
180*212397c6Schristos (* ===========================================================================
181*212397c6Schristos  * Test deflate with small buffers
182*212397c6Schristos  *)
183*212397c6Schristos {$IFDEF TEST_DEFLATE}
184*212397c6Schristos procedure test_deflate(compr: Pointer; comprLen: LongInt);
185*212397c6Schristos var c_stream: z_stream; (* compression stream *)
186*212397c6Schristos     err: Integer;
187*212397c6Schristos     len: LongInt;
188*212397c6Schristos begin
189*212397c6Schristos   len := StrLen(hello)+1;
190*212397c6Schristos 
191*212397c6Schristos   c_stream.zalloc := NIL;
192*212397c6Schristos   c_stream.zfree := NIL;
193*212397c6Schristos   c_stream.opaque := NIL;
194*212397c6Schristos 
195*212397c6Schristos   err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
196*212397c6Schristos   CHECK_ERR(err, 'deflateInit');
197*212397c6Schristos 
198*212397c6Schristos   c_stream.next_in := hello;
199*212397c6Schristos   c_stream.next_out := compr;
200*212397c6Schristos 
201*212397c6Schristos   while (c_stream.total_in <> len) and
202*212397c6Schristos         (c_stream.total_out < comprLen) do
203*212397c6Schristos   begin
204*212397c6Schristos     c_stream.avail_out := 1; { force small buffers }
205*212397c6Schristos     c_stream.avail_in := 1;
206*212397c6Schristos     err := deflate(c_stream, Z_NO_FLUSH);
207*212397c6Schristos     CHECK_ERR(err, 'deflate');
208*212397c6Schristos   end;
209*212397c6Schristos 
210*212397c6Schristos   (* Finish the stream, still forcing small buffers: *)
211*212397c6Schristos   while TRUE do
212*212397c6Schristos   begin
213*212397c6Schristos     c_stream.avail_out := 1;
214*212397c6Schristos     err := deflate(c_stream, Z_FINISH);
215*212397c6Schristos     if err = Z_STREAM_END then
216*212397c6Schristos       break;
217*212397c6Schristos     CHECK_ERR(err, 'deflate');
218*212397c6Schristos   end;
219*212397c6Schristos 
220*212397c6Schristos   err := deflateEnd(c_stream);
221*212397c6Schristos   CHECK_ERR(err, 'deflateEnd');
222*212397c6Schristos end;
223*212397c6Schristos {$ENDIF}
224*212397c6Schristos 
225*212397c6Schristos (* ===========================================================================
226*212397c6Schristos  * Test inflate with small buffers
227*212397c6Schristos  *)
228*212397c6Schristos {$IFDEF TEST_INFLATE}
229*212397c6Schristos procedure test_inflate(compr: Pointer; comprLen : LongInt;
230*212397c6Schristos                        uncompr: Pointer; uncomprLen : LongInt);
231*212397c6Schristos var err: Integer;
232*212397c6Schristos     d_stream: z_stream; (* decompression stream *)
233*212397c6Schristos begin
234*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
235*212397c6Schristos 
236*212397c6Schristos   d_stream.zalloc := NIL;
237*212397c6Schristos   d_stream.zfree := NIL;
238*212397c6Schristos   d_stream.opaque := NIL;
239*212397c6Schristos 
240*212397c6Schristos   d_stream.next_in := compr;
241*212397c6Schristos   d_stream.avail_in := 0;
242*212397c6Schristos   d_stream.next_out := uncompr;
243*212397c6Schristos 
244*212397c6Schristos   err := inflateInit(d_stream);
245*212397c6Schristos   CHECK_ERR(err, 'inflateInit');
246*212397c6Schristos 
247*212397c6Schristos   while (d_stream.total_out < uncomprLen) and
248*212397c6Schristos         (d_stream.total_in < comprLen) do
249*212397c6Schristos   begin
250*212397c6Schristos     d_stream.avail_out := 1; (* force small buffers *)
251*212397c6Schristos     d_stream.avail_in := 1;
252*212397c6Schristos     err := inflate(d_stream, Z_NO_FLUSH);
253*212397c6Schristos     if err = Z_STREAM_END then
254*212397c6Schristos       break;
255*212397c6Schristos     CHECK_ERR(err, 'inflate');
256*212397c6Schristos   end;
257*212397c6Schristos 
258*212397c6Schristos   err := inflateEnd(d_stream);
259*212397c6Schristos   CHECK_ERR(err, 'inflateEnd');
260*212397c6Schristos 
261*212397c6Schristos   if StrComp(PChar(uncompr), hello) <> 0 then
262*212397c6Schristos     EXIT_ERR('bad inflate')
263*212397c6Schristos   else
264*212397c6Schristos     WriteLn('inflate(): ', PChar(uncompr));
265*212397c6Schristos end;
266*212397c6Schristos {$ENDIF}
267*212397c6Schristos 
268*212397c6Schristos (* ===========================================================================
269*212397c6Schristos  * Test deflate with large buffers and dynamic change of compression level
270*212397c6Schristos  *)
271*212397c6Schristos {$IFDEF TEST_DEFLATE}
272*212397c6Schristos procedure test_large_deflate(compr: Pointer; comprLen: LongInt;
273*212397c6Schristos                              uncompr: Pointer; uncomprLen: LongInt);
274*212397c6Schristos var c_stream: z_stream; (* compression stream *)
275*212397c6Schristos     err: Integer;
276*212397c6Schristos begin
277*212397c6Schristos   c_stream.zalloc := NIL;
278*212397c6Schristos   c_stream.zfree := NIL;
279*212397c6Schristos   c_stream.opaque := NIL;
280*212397c6Schristos 
281*212397c6Schristos   err := deflateInit(c_stream, Z_BEST_SPEED);
282*212397c6Schristos   CHECK_ERR(err, 'deflateInit');
283*212397c6Schristos 
284*212397c6Schristos   c_stream.next_out := compr;
285*212397c6Schristos   c_stream.avail_out := Integer(comprLen);
286*212397c6Schristos 
287*212397c6Schristos   (* At this point, uncompr is still mostly zeroes, so it should compress
288*212397c6Schristos    * very well:
289*212397c6Schristos    *)
290*212397c6Schristos   c_stream.next_in := uncompr;
291*212397c6Schristos   c_stream.avail_in := Integer(uncomprLen);
292*212397c6Schristos   err := deflate(c_stream, Z_NO_FLUSH);
293*212397c6Schristos   CHECK_ERR(err, 'deflate');
294*212397c6Schristos   if c_stream.avail_in <> 0 then
295*212397c6Schristos     EXIT_ERR('deflate not greedy');
296*212397c6Schristos 
297*212397c6Schristos   (* Feed in already compressed data and switch to no compression: *)
298*212397c6Schristos   deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
299*212397c6Schristos   c_stream.next_in := compr;
300*212397c6Schristos   c_stream.avail_in := Integer(comprLen div 2);
301*212397c6Schristos   err := deflate(c_stream, Z_NO_FLUSH);
302*212397c6Schristos   CHECK_ERR(err, 'deflate');
303*212397c6Schristos 
304*212397c6Schristos   (* Switch back to compressing mode: *)
305*212397c6Schristos   deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
306*212397c6Schristos   c_stream.next_in := uncompr;
307*212397c6Schristos   c_stream.avail_in := Integer(uncomprLen);
308*212397c6Schristos   err := deflate(c_stream, Z_NO_FLUSH);
309*212397c6Schristos   CHECK_ERR(err, 'deflate');
310*212397c6Schristos 
311*212397c6Schristos   err := deflate(c_stream, Z_FINISH);
312*212397c6Schristos   if err <> Z_STREAM_END then
313*212397c6Schristos     EXIT_ERR('deflate should report Z_STREAM_END');
314*212397c6Schristos 
315*212397c6Schristos   err := deflateEnd(c_stream);
316*212397c6Schristos   CHECK_ERR(err, 'deflateEnd');
317*212397c6Schristos end;
318*212397c6Schristos {$ENDIF}
319*212397c6Schristos 
320*212397c6Schristos (* ===========================================================================
321*212397c6Schristos  * Test inflate with large buffers
322*212397c6Schristos  *)
323*212397c6Schristos {$IFDEF TEST_INFLATE}
324*212397c6Schristos procedure test_large_inflate(compr: Pointer; comprLen: LongInt;
325*212397c6Schristos                              uncompr: Pointer; uncomprLen: LongInt);
326*212397c6Schristos var err: Integer;
327*212397c6Schristos     d_stream: z_stream; (* decompression stream *)
328*212397c6Schristos begin
329*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
330*212397c6Schristos 
331*212397c6Schristos   d_stream.zalloc := NIL;
332*212397c6Schristos   d_stream.zfree := NIL;
333*212397c6Schristos   d_stream.opaque := NIL;
334*212397c6Schristos 
335*212397c6Schristos   d_stream.next_in := compr;
336*212397c6Schristos   d_stream.avail_in := Integer(comprLen);
337*212397c6Schristos 
338*212397c6Schristos   err := inflateInit(d_stream);
339*212397c6Schristos   CHECK_ERR(err, 'inflateInit');
340*212397c6Schristos 
341*212397c6Schristos   while TRUE do
342*212397c6Schristos   begin
343*212397c6Schristos     d_stream.next_out := uncompr;            (* discard the output *)
344*212397c6Schristos     d_stream.avail_out := Integer(uncomprLen);
345*212397c6Schristos     err := inflate(d_stream, Z_NO_FLUSH);
346*212397c6Schristos     if err = Z_STREAM_END then
347*212397c6Schristos       break;
348*212397c6Schristos     CHECK_ERR(err, 'large inflate');
349*212397c6Schristos   end;
350*212397c6Schristos 
351*212397c6Schristos   err := inflateEnd(d_stream);
352*212397c6Schristos   CHECK_ERR(err, 'inflateEnd');
353*212397c6Schristos 
354*212397c6Schristos   if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then
355*212397c6Schristos   begin
356*212397c6Schristos     WriteLn('bad large inflate: ', d_stream.total_out);
357*212397c6Schristos     Halt(1);
358*212397c6Schristos   end
359*212397c6Schristos   else
360*212397c6Schristos     WriteLn('large_inflate(): OK');
361*212397c6Schristos end;
362*212397c6Schristos {$ENDIF}
363*212397c6Schristos 
364*212397c6Schristos (* ===========================================================================
365*212397c6Schristos  * Test deflate with full flush
366*212397c6Schristos  *)
367*212397c6Schristos {$IFDEF TEST_FLUSH}
368*212397c6Schristos procedure test_flush(compr: Pointer; var comprLen : LongInt);
369*212397c6Schristos var c_stream: z_stream; (* compression stream *)
370*212397c6Schristos     err: Integer;
371*212397c6Schristos     len: Integer;
372*212397c6Schristos begin
373*212397c6Schristos   len := StrLen(hello)+1;
374*212397c6Schristos 
375*212397c6Schristos   c_stream.zalloc := NIL;
376*212397c6Schristos   c_stream.zfree := NIL;
377*212397c6Schristos   c_stream.opaque := NIL;
378*212397c6Schristos 
379*212397c6Schristos   err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
380*212397c6Schristos   CHECK_ERR(err, 'deflateInit');
381*212397c6Schristos 
382*212397c6Schristos   c_stream.next_in := hello;
383*212397c6Schristos   c_stream.next_out := compr;
384*212397c6Schristos   c_stream.avail_in := 3;
385*212397c6Schristos   c_stream.avail_out := Integer(comprLen);
386*212397c6Schristos   err := deflate(c_stream, Z_FULL_FLUSH);
387*212397c6Schristos   CHECK_ERR(err, 'deflate');
388*212397c6Schristos 
389*212397c6Schristos   Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *)
390*212397c6Schristos   c_stream.avail_in := len - 3;
391*212397c6Schristos 
392*212397c6Schristos   err := deflate(c_stream, Z_FINISH);
393*212397c6Schristos   if err <> Z_STREAM_END then
394*212397c6Schristos     CHECK_ERR(err, 'deflate');
395*212397c6Schristos 
396*212397c6Schristos   err := deflateEnd(c_stream);
397*212397c6Schristos   CHECK_ERR(err, 'deflateEnd');
398*212397c6Schristos 
399*212397c6Schristos   comprLen := c_stream.total_out;
400*212397c6Schristos end;
401*212397c6Schristos {$ENDIF}
402*212397c6Schristos 
403*212397c6Schristos (* ===========================================================================
404*212397c6Schristos  * Test inflateSync()
405*212397c6Schristos  *)
406*212397c6Schristos {$IFDEF TEST_SYNC}
407*212397c6Schristos procedure test_sync(compr: Pointer; comprLen: LongInt;
408*212397c6Schristos                     uncompr: Pointer; uncomprLen : LongInt);
409*212397c6Schristos var err: Integer;
410*212397c6Schristos     d_stream: z_stream; (* decompression stream *)
411*212397c6Schristos begin
412*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
413*212397c6Schristos 
414*212397c6Schristos   d_stream.zalloc := NIL;
415*212397c6Schristos   d_stream.zfree := NIL;
416*212397c6Schristos   d_stream.opaque := NIL;
417*212397c6Schristos 
418*212397c6Schristos   d_stream.next_in := compr;
419*212397c6Schristos   d_stream.avail_in := 2; (* just read the zlib header *)
420*212397c6Schristos 
421*212397c6Schristos   err := inflateInit(d_stream);
422*212397c6Schristos   CHECK_ERR(err, 'inflateInit');
423*212397c6Schristos 
424*212397c6Schristos   d_stream.next_out := uncompr;
425*212397c6Schristos   d_stream.avail_out := Integer(uncomprLen);
426*212397c6Schristos 
427*212397c6Schristos   inflate(d_stream, Z_NO_FLUSH);
428*212397c6Schristos   CHECK_ERR(err, 'inflate');
429*212397c6Schristos 
430*212397c6Schristos   d_stream.avail_in := Integer(comprLen-2);   (* read all compressed data *)
431*212397c6Schristos   err := inflateSync(d_stream);               (* but skip the damaged part *)
432*212397c6Schristos   CHECK_ERR(err, 'inflateSync');
433*212397c6Schristos 
434*212397c6Schristos   err := inflate(d_stream, Z_FINISH);
435*212397c6Schristos   if err <> Z_DATA_ERROR then
436*212397c6Schristos     EXIT_ERR('inflate should report DATA_ERROR');
437*212397c6Schristos     (* Because of incorrect adler32 *)
438*212397c6Schristos 
439*212397c6Schristos   err := inflateEnd(d_stream);
440*212397c6Schristos   CHECK_ERR(err, 'inflateEnd');
441*212397c6Schristos 
442*212397c6Schristos   WriteLn('after inflateSync(): hel', PChar(uncompr));
443*212397c6Schristos end;
444*212397c6Schristos {$ENDIF}
445*212397c6Schristos 
446*212397c6Schristos (* ===========================================================================
447*212397c6Schristos  * Test deflate with preset dictionary
448*212397c6Schristos  *)
449*212397c6Schristos {$IFDEF TEST_DICT}
450*212397c6Schristos procedure test_dict_deflate(compr: Pointer; comprLen: LongInt);
451*212397c6Schristos var c_stream: z_stream; (* compression stream *)
452*212397c6Schristos     err: Integer;
453*212397c6Schristos begin
454*212397c6Schristos   c_stream.zalloc := NIL;
455*212397c6Schristos   c_stream.zfree := NIL;
456*212397c6Schristos   c_stream.opaque := NIL;
457*212397c6Schristos 
458*212397c6Schristos   err := deflateInit(c_stream, Z_BEST_COMPRESSION);
459*212397c6Schristos   CHECK_ERR(err, 'deflateInit');
460*212397c6Schristos 
461*212397c6Schristos   err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary));
462*212397c6Schristos   CHECK_ERR(err, 'deflateSetDictionary');
463*212397c6Schristos 
464*212397c6Schristos   dictId := c_stream.adler;
465*212397c6Schristos   c_stream.next_out := compr;
466*212397c6Schristos   c_stream.avail_out := Integer(comprLen);
467*212397c6Schristos 
468*212397c6Schristos   c_stream.next_in := hello;
469*212397c6Schristos   c_stream.avail_in := StrLen(hello)+1;
470*212397c6Schristos 
471*212397c6Schristos   err := deflate(c_stream, Z_FINISH);
472*212397c6Schristos   if err <> Z_STREAM_END then
473*212397c6Schristos     EXIT_ERR('deflate should report Z_STREAM_END');
474*212397c6Schristos 
475*212397c6Schristos   err := deflateEnd(c_stream);
476*212397c6Schristos   CHECK_ERR(err, 'deflateEnd');
477*212397c6Schristos end;
478*212397c6Schristos {$ENDIF}
479*212397c6Schristos 
480*212397c6Schristos (* ===========================================================================
481*212397c6Schristos  * Test inflate with a preset dictionary
482*212397c6Schristos  *)
483*212397c6Schristos {$IFDEF TEST_DICT}
484*212397c6Schristos procedure test_dict_inflate(compr: Pointer; comprLen: LongInt;
485*212397c6Schristos                             uncompr: Pointer; uncomprLen: LongInt);
486*212397c6Schristos var err: Integer;
487*212397c6Schristos     d_stream: z_stream; (* decompression stream *)
488*212397c6Schristos begin
489*212397c6Schristos   StrCopy(PChar(uncompr), 'garbage');
490*212397c6Schristos 
491*212397c6Schristos   d_stream.zalloc := NIL;
492*212397c6Schristos   d_stream.zfree := NIL;
493*212397c6Schristos   d_stream.opaque := NIL;
494*212397c6Schristos 
495*212397c6Schristos   d_stream.next_in := compr;
496*212397c6Schristos   d_stream.avail_in := Integer(comprLen);
497*212397c6Schristos 
498*212397c6Schristos   err := inflateInit(d_stream);
499*212397c6Schristos   CHECK_ERR(err, 'inflateInit');
500*212397c6Schristos 
501*212397c6Schristos   d_stream.next_out := uncompr;
502*212397c6Schristos   d_stream.avail_out := Integer(uncomprLen);
503*212397c6Schristos 
504*212397c6Schristos   while TRUE do
505*212397c6Schristos   begin
506*212397c6Schristos     err := inflate(d_stream, Z_NO_FLUSH);
507*212397c6Schristos     if err = Z_STREAM_END then
508*212397c6Schristos       break;
509*212397c6Schristos     if err = Z_NEED_DICT then
510*212397c6Schristos     begin
511*212397c6Schristos       if d_stream.adler <> dictId then
512*212397c6Schristos         EXIT_ERR('unexpected dictionary');
513*212397c6Schristos       err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary));
514*212397c6Schristos     end;
515*212397c6Schristos     CHECK_ERR(err, 'inflate with dict');
516*212397c6Schristos   end;
517*212397c6Schristos 
518*212397c6Schristos   err := inflateEnd(d_stream);
519*212397c6Schristos   CHECK_ERR(err, 'inflateEnd');
520*212397c6Schristos 
521*212397c6Schristos   if StrComp(PChar(uncompr), hello) <> 0 then
522*212397c6Schristos     EXIT_ERR('bad inflate with dict')
523*212397c6Schristos   else
524*212397c6Schristos     WriteLn('inflate with dictionary: ', PChar(uncompr));
525*212397c6Schristos end;
526*212397c6Schristos {$ENDIF}
527*212397c6Schristos 
528*212397c6Schristos var compr, uncompr: Pointer;
529*212397c6Schristos     comprLen, uncomprLen: LongInt;
530*212397c6Schristos 
531*212397c6Schristos begin
532*212397c6Schristos   if zlibVersion^ <> ZLIB_VERSION[1] then
533*212397c6Schristos     EXIT_ERR('Incompatible zlib version');
534*212397c6Schristos 
535*212397c6Schristos   WriteLn('zlib version: ', zlibVersion);
536*212397c6Schristos   WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags]));
537*212397c6Schristos 
538*212397c6Schristos   comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *)
539*212397c6Schristos   uncomprLen := comprLen;
540*212397c6Schristos   GetMem(compr, comprLen);
541*212397c6Schristos   GetMem(uncompr, uncomprLen);
542*212397c6Schristos   if (compr = NIL) or (uncompr = NIL) then
543*212397c6Schristos     EXIT_ERR('Out of memory');
544*212397c6Schristos   (* compr and uncompr are cleared to avoid reading uninitialized
545*212397c6Schristos    * data and to ensure that uncompr compresses well.
546*212397c6Schristos    *)
547*212397c6Schristos   FillChar(compr^, comprLen, 0);
548*212397c6Schristos   FillChar(uncompr^, uncomprLen, 0);
549*212397c6Schristos 
550*212397c6Schristos   {$IFDEF TEST_COMPRESS}
551*212397c6Schristos   WriteLn('** Testing compress');
552*212397c6Schristos   test_compress(compr, comprLen, uncompr, uncomprLen);
553*212397c6Schristos   {$ENDIF}
554*212397c6Schristos 
555*212397c6Schristos   {$IFDEF TEST_GZIO}
556*212397c6Schristos   WriteLn('** Testing gzio');
557*212397c6Schristos   if ParamCount >= 1 then
558*212397c6Schristos     test_gzio(ParamStr(1), uncompr, uncomprLen)
559*212397c6Schristos   else
560*212397c6Schristos     test_gzio(TESTFILE, uncompr, uncomprLen);
561*212397c6Schristos   {$ENDIF}
562*212397c6Schristos 
563*212397c6Schristos   {$IFDEF TEST_DEFLATE}
564*212397c6Schristos   WriteLn('** Testing deflate with small buffers');
565*212397c6Schristos   test_deflate(compr, comprLen);
566*212397c6Schristos   {$ENDIF}
567*212397c6Schristos   {$IFDEF TEST_INFLATE}
568*212397c6Schristos   WriteLn('** Testing inflate with small buffers');
569*212397c6Schristos   test_inflate(compr, comprLen, uncompr, uncomprLen);
570*212397c6Schristos   {$ENDIF}
571*212397c6Schristos 
572*212397c6Schristos   {$IFDEF TEST_DEFLATE}
573*212397c6Schristos   WriteLn('** Testing deflate with large buffers');
574*212397c6Schristos   test_large_deflate(compr, comprLen, uncompr, uncomprLen);
575*212397c6Schristos   {$ENDIF}
576*212397c6Schristos   {$IFDEF TEST_INFLATE}
577*212397c6Schristos   WriteLn('** Testing inflate with large buffers');
578*212397c6Schristos   test_large_inflate(compr, comprLen, uncompr, uncomprLen);
579*212397c6Schristos   {$ENDIF}
580*212397c6Schristos 
581*212397c6Schristos   {$IFDEF TEST_FLUSH}
582*212397c6Schristos   WriteLn('** Testing deflate with full flush');
583*212397c6Schristos   test_flush(compr, comprLen);
584*212397c6Schristos   {$ENDIF}
585*212397c6Schristos   {$IFDEF TEST_SYNC}
586*212397c6Schristos   WriteLn('** Testing inflateSync');
587*212397c6Schristos   test_sync(compr, comprLen, uncompr, uncomprLen);
588*212397c6Schristos   {$ENDIF}
589*212397c6Schristos   comprLen := uncomprLen;
590*212397c6Schristos 
591*212397c6Schristos   {$IFDEF TEST_DICT}
592*212397c6Schristos   WriteLn('** Testing deflate and inflate with preset dictionary');
593*212397c6Schristos   test_dict_deflate(compr, comprLen);
594*212397c6Schristos   test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
595*212397c6Schristos   {$ENDIF}
596*212397c6Schristos 
597*212397c6Schristos   FreeMem(compr, comprLen);
598*212397c6Schristos   FreeMem(uncompr, uncomprLen);
599*212397c6Schristos end.
600