annotate src/zlib-1.2.7/contrib/pascal/example.pas @ 169:223a55898ab9 tip default

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