Fossil SCM

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

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button