paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 09:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix block logic error, causing failure of tw12830.pp

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-07-12 12:10:09 +02:00
parent e4356a0d38
commit 87d084dd21
1 changed files with 59 additions and 34 deletions

93
packages/paszlib/src/infblock.pas
View File

@ -171,6 +171,9 @@ function inflate_blocks (var s : inflate_blocks_state;
var z : z_stream;
r : integer) : integer; { initial return code }
Type
tblockaction = (baFallThrough,baContinue,baExit);
var
t : cardinal; { temporary storage }
b : cardinal; { bit buffer }
@ -189,7 +192,7 @@ var
var
cs : pInflate_codes_state;
procedure do_btree;
function do_btree : TBlockAction;
begin
while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
@ -210,7 +213,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
dec(n);
b := b or (cardinal(p^) shl k);
@ -247,7 +250,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
s.sub.trees.index := 0;
{$IFDEF ZLIB_DEBUG}
@ -255,9 +258,10 @@ var
{$ENDIF}
s.mode := DTREE;
{ fall through again }
do_btree:=baFallThrough;
end;
procedure do_dtree;
function do_dtree : TBlockaction;
begin
while TRUE do
@ -283,7 +287,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
dec(n);
b := b or (cardinal(p^) shl k);
@ -333,7 +337,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
dec(n);
b := b or (cardinal(p^) shl k);
@ -368,7 +372,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
if c = 16 then
c := s.sub.trees.blens^[i - 1]
@ -405,7 +409,7 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
{$IFDEF ZLIB_DEBUG}
Tracev('inflate: trees ok');
@ -423,14 +427,16 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
s.sub.decode.codes := cs;
end;
s.mode := CODES;
do_dtree:=baFallThrough;
end;
function do_codes: boolean;
function do_codes: tblockaction;
begin
{ update pointers }
@ -445,7 +451,7 @@ var
if (r <> Z_STREAM_END) then
begin
inflate_blocks := inflate_flush(s, z, r);
exit;
exit(baExit);
end;
r := Z_OK;
inflate_codes_free(s.sub.decode.codes, z);
@ -471,7 +477,7 @@ var
if (not s.last) then
begin
s.mode := ZTYPE;
exit(false); { break for switch statement in C-code }
exit(baContinue); { break for switch statement in C-code }
end;
{$ifndef patch112}
if (k > 7) then { return unused byte, if any }
@ -485,10 +491,10 @@ var
end;
{$endif}
s.mode := DRY;
do_codes:=true;
do_codes:=baFallThrough;
end;
procedure do_dry;
function do_dry : tblockaction;
begin
{FLUSH}
@ -513,9 +519,10 @@ var
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
exit(baExit);
end;
s.mode := BLKDONE;
do_dry:=baFallThrough;
end;
procedure do_blkdone;
@ -880,44 +887,62 @@ begin
s.mode := BTREE;
{ fall trough case is handled by the while }
{ try GOTO for speed - Nomssi }
do_btree;
do_dtree;
if not do_codes then
continue;
do_dry;
if do_btree=baExit then
Exit;
if do_dtree=baExit then
Exit;
Case do_codes of
baContinue : continue;
baExit : Exit;
end;
if do_dry=baExit then
exit;
do_blkdone;
exit;
end;
BTREE:
begin
do_btree;
do_dtree;
if not do_codes then
continue;
do_dry;
if do_btree=baExit then
Exit;
if do_dtree=baExit then
Exit;
Case do_codes of
baContinue : continue;
baExit : Exit;
end;
if do_dry=baExit then
exit;
do_blkdone;
exit;
end;
DTREE:
begin
do_dtree;
if not do_codes then
continue;
do_dry;
if do_dtree=baExit then
Exit;
Case do_codes of
baContinue : continue;
baExit : Exit;
end;
if do_dry=baExit then
exit;
do_blkdone;
exit;
end;
CODES:
begin
if not do_codes then
continue;
do_dry;
Case do_codes of
baContinue : continue;
baExit : Exit;
end;
if do_dry=baExit then
exit;
do_blkdone;
exit;
end;
DRY:
begin
do_dry;
if do_dry=baExit then
exit;
do_blkdone;
exit;
end;