summaryrefslogtreecommitdiffhomepage
path: root/contrib/zlib/contrib/pascal/example.pas
diff options
context:
space:
mode:
authorAki <please@ignore.pl>2024-03-02 22:57:02 +0100
committerAki <please@ignore.pl>2024-03-03 00:59:45 +0100
commitca18c5b1b5004ffa88b6b3b85cd038d1217c09c6 (patch)
tree1ba5a8734c96f892322cd65af7cf33041ba4cb68 /contrib/zlib/contrib/pascal/example.pas
parente70158ea57302e2fa2d588b67fc8dc18265192eb (diff)
downloadstarshatter-ca18c5b1b5004ffa88b6b3b85cd038d1217c09c6.zip
starshatter-ca18c5b1b5004ffa88b6b3b85cd038d1217c09c6.tar.gz
starshatter-ca18c5b1b5004ffa88b6b3b85cd038d1217c09c6.tar.bz2
zlib sources removed from this tree
This, for whatever reason, breaks std::fs exception handling. All remaining external projects will be moved to use this approach soon. This is to prepare it for more new libraries which would otherwise make the tree grow even further.
Diffstat (limited to 'contrib/zlib/contrib/pascal/example.pas')
-rw-r--r--contrib/zlib/contrib/pascal/example.pas599
1 files changed, 0 insertions, 599 deletions
diff --git a/contrib/zlib/contrib/pascal/example.pas b/contrib/zlib/contrib/pascal/example.pas
deleted file mode 100644
index 5518b36..0000000
--- a/contrib/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.