diff options
Diffstat (limited to 'source4/lib/zlib/contrib/pascal/example.pas')
-rw-r--r-- | source4/lib/zlib/contrib/pascal/example.pas | 599 |
1 files changed, 0 insertions, 599 deletions
diff --git a/source4/lib/zlib/contrib/pascal/example.pas b/source4/lib/zlib/contrib/pascal/example.pas deleted file mode 100644 index 5518b36a73..0000000000 --- a/source4/lib/zlib/contrib/pascal/example.pas +++ /dev/null @@ -1,599 +0,0 @@ -(* example.c -- usage example of the zlib compression library - * Copyright (C) 1995-2003 Jean-loup Gailly. - * For conditions of distribution and use, see copyright notice in zlib.h - * - * Pascal translation - * Copyright (C) 1998 by Jacques Nomssi Nzali. - * For conditions of distribution and use, see copyright notice in readme.txt - * - * Adaptation to the zlibpas interface - * Copyright (C) 2003 by Cosmin Truta. - * For conditions of distribution and use, see copyright notice in readme.txt - *) - -program example; - -{$DEFINE TEST_COMPRESS} -{DO NOT $DEFINE TEST_GZIO} -{$DEFINE TEST_DEFLATE} -{$DEFINE TEST_INFLATE} -{$DEFINE TEST_FLUSH} -{$DEFINE TEST_SYNC} -{$DEFINE TEST_DICT} - -uses SysUtils, zlibpas; - -const TESTFILE = 'foo.gz'; - -(* "hello world" would be more standard, but the repeated "hello" - * stresses the compression code better, sorry... - *) -const hello: PChar = 'hello, hello!'; - -const dictionary: PChar = 'hello'; - -var dictId: LongInt; (* Adler32 value of the dictionary *) - -procedure CHECK_ERR(err: Integer; msg: String); -begin - if err <> Z_OK then - begin - WriteLn(msg, ' error: ', err); - Halt(1); - end; -end; - -procedure EXIT_ERR(const msg: String); -begin - WriteLn('Error: ', msg); - Halt(1); -end; - -(* =========================================================================== - * Test compress and uncompress - *) -{$IFDEF TEST_COMPRESS} -procedure test_compress(compr: Pointer; comprLen: LongInt; - uncompr: Pointer; uncomprLen: LongInt); -var err: Integer; - len: LongInt; -begin - len := StrLen(hello)+1; - - err := compress(compr, comprLen, hello, len); - CHECK_ERR(err, 'compress'); - - StrCopy(PChar(uncompr), 'garbage'); - - err := uncompress(uncompr, uncomprLen, compr, comprLen); - CHECK_ERR(err, 'uncompress'); - - if StrComp(PChar(uncompr), hello) <> 0 then - EXIT_ERR('bad uncompress') - else - WriteLn('uncompress(): ', PChar(uncompr)); -end; -{$ENDIF} - -(* =========================================================================== - * Test read/write of .gz files - *) -{$IFDEF TEST_GZIO} -procedure test_gzio(const fname: PChar; (* compressed file name *) - uncompr: Pointer; - uncomprLen: LongInt); -var err: Integer; - len: Integer; - zfile: gzFile; - pos: LongInt; -begin - len := StrLen(hello)+1; - - zfile := gzopen(fname, 'wb'); - if zfile = NIL then - begin - WriteLn('gzopen error'); - Halt(1); - end; - gzputc(zfile, 'h'); - if gzputs(zfile, 'ello') <> 4 then - begin - WriteLn('gzputs err: ', gzerror(zfile, err)); - Halt(1); - end; - {$IFDEF GZ_FORMAT_STRING} - if gzprintf(zfile, ', %s!', 'hello') <> 8 then - begin - WriteLn('gzprintf err: ', gzerror(zfile, err)); - Halt(1); - end; - {$ELSE} - if gzputs(zfile, ', hello!') <> 8 then - begin - WriteLn('gzputs err: ', gzerror(zfile, err)); - Halt(1); - end; - {$ENDIF} - gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *) - gzclose(zfile); - - zfile := gzopen(fname, 'rb'); - if zfile = NIL then - begin - WriteLn('gzopen error'); - Halt(1); - end; - - StrCopy(PChar(uncompr), 'garbage'); - - if gzread(zfile, uncompr, uncomprLen) <> len then - begin - WriteLn('gzread err: ', gzerror(zfile, err)); - Halt(1); - end; - if StrComp(PChar(uncompr), hello) <> 0 then - begin - WriteLn('bad gzread: ', PChar(uncompr)); - Halt(1); - end - else - WriteLn('gzread(): ', PChar(uncompr)); - - pos := gzseek(zfile, -8, SEEK_CUR); - if (pos <> 6) or (gztell(zfile) <> pos) then - begin - WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile)); - Halt(1); - end; - - if gzgetc(zfile) <> ' ' then - begin - WriteLn('gzgetc error'); - Halt(1); - end; - - if gzungetc(' ', zfile) <> ' ' then - begin - WriteLn('gzungetc error'); - Halt(1); - end; - - gzgets(zfile, PChar(uncompr), uncomprLen); - uncomprLen := StrLen(PChar(uncompr)); - if uncomprLen <> 7 then (* " hello!" *) - begin - WriteLn('gzgets err after gzseek: ', gzerror(zfile, err)); - Halt(1); - end; - if StrComp(PChar(uncompr), hello + 6) <> 0 then - begin - WriteLn('bad gzgets after gzseek'); - Halt(1); - end - else - WriteLn('gzgets() after gzseek: ', PChar(uncompr)); - - gzclose(zfile); -end; -{$ENDIF} - -(* =========================================================================== - * Test deflate with small buffers - *) -{$IFDEF TEST_DEFLATE} -procedure test_deflate(compr: Pointer; comprLen: LongInt); -var c_stream: z_stream; (* compression stream *) - err: Integer; - len: LongInt; -begin - len := StrLen(hello)+1; - - c_stream.zalloc := NIL; - c_stream.zfree := NIL; - c_stream.opaque := NIL; - - err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); - CHECK_ERR(err, 'deflateInit'); - - c_stream.next_in := hello; - c_stream.next_out := compr; - - while (c_stream.total_in <> len) and - (c_stream.total_out < comprLen) do - begin - c_stream.avail_out := 1; { force small buffers } - c_stream.avail_in := 1; - err := deflate(c_stream, Z_NO_FLUSH); - CHECK_ERR(err, 'deflate'); - end; - - (* Finish the stream, still forcing small buffers: *) - while TRUE do - begin - c_stream.avail_out := 1; - err := deflate(c_stream, Z_FINISH); - if err = Z_STREAM_END then - break; - CHECK_ERR(err, 'deflate'); - end; - - err := deflateEnd(c_stream); - CHECK_ERR(err, 'deflateEnd'); -end; -{$ENDIF} - -(* =========================================================================== - * Test inflate with small buffers - *) -{$IFDEF TEST_INFLATE} -procedure test_inflate(compr: Pointer; comprLen : LongInt; - uncompr: Pointer; uncomprLen : LongInt); -var err: Integer; - d_stream: z_stream; (* decompression stream *) -begin - StrCopy(PChar(uncompr), 'garbage'); - - d_stream.zalloc := NIL; - d_stream.zfree := NIL; - d_stream.opaque := NIL; - - d_stream.next_in := compr; - d_stream.avail_in := 0; - d_stream.next_out := uncompr; - - err := inflateInit(d_stream); - CHECK_ERR(err, 'inflateInit'); - - while (d_stream.total_out < uncomprLen) and - (d_stream.total_in < comprLen) do - begin - d_stream.avail_out := 1; (* force small buffers *) - d_stream.avail_in := 1; - err := inflate(d_stream, Z_NO_FLUSH); - if err = Z_STREAM_END then - break; - CHECK_ERR(err, 'inflate'); - end; - - err := inflateEnd(d_stream); - CHECK_ERR(err, 'inflateEnd'); - - if StrComp(PChar(uncompr), hello) <> 0 then - EXIT_ERR('bad inflate') - else - WriteLn('inflate(): ', PChar(uncompr)); -end; -{$ENDIF} - -(* =========================================================================== - * Test deflate with large buffers and dynamic change of compression level - *) -{$IFDEF TEST_DEFLATE} -procedure test_large_deflate(compr: Pointer; comprLen: LongInt; - uncompr: Pointer; uncomprLen: LongInt); -var c_stream: z_stream; (* compression stream *) - err: Integer; -begin - c_stream.zalloc := NIL; - c_stream.zfree := NIL; - c_stream.opaque := NIL; - - err := deflateInit(c_stream, Z_BEST_SPEED); - CHECK_ERR(err, 'deflateInit'); - - c_stream.next_out := compr; - c_stream.avail_out := Integer(comprLen); - - (* At this point, uncompr is still mostly zeroes, so it should compress - * very well: - *) - c_stream.next_in := uncompr; - c_stream.avail_in := Integer(uncomprLen); - err := deflate(c_stream, Z_NO_FLUSH); - CHECK_ERR(err, 'deflate'); - if c_stream.avail_in <> 0 then - EXIT_ERR('deflate not greedy'); - - (* Feed in already compressed data and switch to no compression: *) - deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY); - c_stream.next_in := compr; - c_stream.avail_in := Integer(comprLen div 2); - err := deflate(c_stream, Z_NO_FLUSH); - CHECK_ERR(err, 'deflate'); - - (* Switch back to compressing mode: *) - deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED); - c_stream.next_in := uncompr; - c_stream.avail_in := Integer(uncomprLen); - err := deflate(c_stream, Z_NO_FLUSH); - CHECK_ERR(err, 'deflate'); - - err := deflate(c_stream, Z_FINISH); - if err <> Z_STREAM_END then - EXIT_ERR('deflate should report Z_STREAM_END'); - - err := deflateEnd(c_stream); - CHECK_ERR(err, 'deflateEnd'); -end; -{$ENDIF} - -(* =========================================================================== - * Test inflate with large buffers - *) -{$IFDEF TEST_INFLATE} -procedure test_large_inflate(compr: Pointer; comprLen: LongInt; - uncompr: Pointer; uncomprLen: LongInt); -var err: Integer; - d_stream: z_stream; (* decompression stream *) -begin - StrCopy(PChar(uncompr), 'garbage'); - - d_stream.zalloc := NIL; - d_stream.zfree := NIL; - d_stream.opaque := NIL; - - d_stream.next_in := compr; - d_stream.avail_in := Integer(comprLen); - - err := inflateInit(d_stream); - CHECK_ERR(err, 'inflateInit'); - - while TRUE do - begin - d_stream.next_out := uncompr; (* discard the output *) - d_stream.avail_out := Integer(uncomprLen); - err := inflate(d_stream, Z_NO_FLUSH); - if err = Z_STREAM_END then - break; - CHECK_ERR(err, 'large inflate'); - end; - - err := inflateEnd(d_stream); - CHECK_ERR(err, 'inflateEnd'); - - if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then - begin - WriteLn('bad large inflate: ', d_stream.total_out); - Halt(1); - end - else - WriteLn('large_inflate(): OK'); -end; -{$ENDIF} - -(* =========================================================================== - * Test deflate with full flush - *) -{$IFDEF TEST_FLUSH} -procedure test_flush(compr: Pointer; var comprLen : LongInt); -var c_stream: z_stream; (* compression stream *) - err: Integer; - len: Integer; -begin - len := StrLen(hello)+1; - - c_stream.zalloc := NIL; - c_stream.zfree := NIL; - c_stream.opaque := NIL; - - err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION); - CHECK_ERR(err, 'deflateInit'); - - c_stream.next_in := hello; - c_stream.next_out := compr; - c_stream.avail_in := 3; - c_stream.avail_out := Integer(comprLen); - err := deflate(c_stream, Z_FULL_FLUSH); - CHECK_ERR(err, 'deflate'); - - Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *) - c_stream.avail_in := len - 3; - - err := deflate(c_stream, Z_FINISH); - if err <> Z_STREAM_END then - CHECK_ERR(err, 'deflate'); - - err := deflateEnd(c_stream); - CHECK_ERR(err, 'deflateEnd'); - - comprLen := c_stream.total_out; -end; -{$ENDIF} - -(* =========================================================================== - * Test inflateSync() - *) -{$IFDEF TEST_SYNC} -procedure test_sync(compr: Pointer; comprLen: LongInt; - uncompr: Pointer; uncomprLen : LongInt); -var err: Integer; - d_stream: z_stream; (* decompression stream *) -begin - StrCopy(PChar(uncompr), 'garbage'); - - d_stream.zalloc := NIL; - d_stream.zfree := NIL; - d_stream.opaque := NIL; - - d_stream.next_in := compr; - d_stream.avail_in := 2; (* just read the zlib header *) - - err := inflateInit(d_stream); - CHECK_ERR(err, 'inflateInit'); - - d_stream.next_out := uncompr; - d_stream.avail_out := Integer(uncomprLen); - - inflate(d_stream, Z_NO_FLUSH); - CHECK_ERR(err, 'inflate'); - - d_stream.avail_in := Integer(comprLen-2); (* read all compressed data *) - err := inflateSync(d_stream); (* but skip the damaged part *) - CHECK_ERR(err, 'inflateSync'); - - err := inflate(d_stream, Z_FINISH); - if err <> Z_DATA_ERROR then - EXIT_ERR('inflate should report DATA_ERROR'); - (* Because of incorrect adler32 *) - - err := inflateEnd(d_stream); - CHECK_ERR(err, 'inflateEnd'); - - WriteLn('after inflateSync(): hel', PChar(uncompr)); -end; -{$ENDIF} - -(* =========================================================================== - * Test deflate with preset dictionary - *) -{$IFDEF TEST_DICT} -procedure test_dict_deflate(compr: Pointer; comprLen: LongInt); -var c_stream: z_stream; (* compression stream *) - err: Integer; -begin - c_stream.zalloc := NIL; - c_stream.zfree := NIL; - c_stream.opaque := NIL; - - err := deflateInit(c_stream, Z_BEST_COMPRESSION); - CHECK_ERR(err, 'deflateInit'); - - err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary)); - CHECK_ERR(err, 'deflateSetDictionary'); - - dictId := c_stream.adler; - c_stream.next_out := compr; - c_stream.avail_out := Integer(comprLen); - - c_stream.next_in := hello; - c_stream.avail_in := StrLen(hello)+1; - - err := deflate(c_stream, Z_FINISH); - if err <> Z_STREAM_END then - EXIT_ERR('deflate should report Z_STREAM_END'); - - err := deflateEnd(c_stream); - CHECK_ERR(err, 'deflateEnd'); -end; -{$ENDIF} - -(* =========================================================================== - * Test inflate with a preset dictionary - *) -{$IFDEF TEST_DICT} -procedure test_dict_inflate(compr: Pointer; comprLen: LongInt; - uncompr: Pointer; uncomprLen: LongInt); -var err: Integer; - d_stream: z_stream; (* decompression stream *) -begin - StrCopy(PChar(uncompr), 'garbage'); - - d_stream.zalloc := NIL; - d_stream.zfree := NIL; - d_stream.opaque := NIL; - - d_stream.next_in := compr; - d_stream.avail_in := Integer(comprLen); - - err := inflateInit(d_stream); - CHECK_ERR(err, 'inflateInit'); - - d_stream.next_out := uncompr; - d_stream.avail_out := Integer(uncomprLen); - - while TRUE do - begin - err := inflate(d_stream, Z_NO_FLUSH); - if err = Z_STREAM_END then - break; - if err = Z_NEED_DICT then - begin - if d_stream.adler <> dictId then - EXIT_ERR('unexpected dictionary'); - err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary)); - end; - CHECK_ERR(err, 'inflate with dict'); - end; - - err := inflateEnd(d_stream); - CHECK_ERR(err, 'inflateEnd'); - - if StrComp(PChar(uncompr), hello) <> 0 then - EXIT_ERR('bad inflate with dict') - else - WriteLn('inflate with dictionary: ', PChar(uncompr)); -end; -{$ENDIF} - -var compr, uncompr: Pointer; - comprLen, uncomprLen: LongInt; - -begin - if zlibVersion^ <> ZLIB_VERSION[1] then - EXIT_ERR('Incompatible zlib version'); - - WriteLn('zlib version: ', zlibVersion); - WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags])); - - comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *) - uncomprLen := comprLen; - GetMem(compr, comprLen); - GetMem(uncompr, uncomprLen); - if (compr = NIL) or (uncompr = NIL) then - EXIT_ERR('Out of memory'); - (* compr and uncompr are cleared to avoid reading uninitialized - * data and to ensure that uncompr compresses well. - *) - FillChar(compr^, comprLen, 0); - FillChar(uncompr^, uncomprLen, 0); - - {$IFDEF TEST_COMPRESS} - WriteLn('** Testing compress'); - test_compress(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - - {$IFDEF TEST_GZIO} - WriteLn('** Testing gzio'); - if ParamCount >= 1 then - test_gzio(ParamStr(1), uncompr, uncomprLen) - else - test_gzio(TESTFILE, uncompr, uncomprLen); - {$ENDIF} - - {$IFDEF TEST_DEFLATE} - WriteLn('** Testing deflate with small buffers'); - test_deflate(compr, comprLen); - {$ENDIF} - {$IFDEF TEST_INFLATE} - WriteLn('** Testing inflate with small buffers'); - test_inflate(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - - {$IFDEF TEST_DEFLATE} - WriteLn('** Testing deflate with large buffers'); - test_large_deflate(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - {$IFDEF TEST_INFLATE} - WriteLn('** Testing inflate with large buffers'); - test_large_inflate(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - - {$IFDEF TEST_FLUSH} - WriteLn('** Testing deflate with full flush'); - test_flush(compr, comprLen); - {$ENDIF} - {$IFDEF TEST_SYNC} - WriteLn('** Testing inflateSync'); - test_sync(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - comprLen := uncomprLen; - - {$IFDEF TEST_DICT} - WriteLn('** Testing deflate and inflate with preset dictionary'); - test_dict_deflate(compr, comprLen); - test_dict_inflate(compr, comprLen, uncompr, uncomprLen); - {$ENDIF} - - FreeMem(compr, comprLen); - FreeMem(uncompr, uncomprLen); -end. |