mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 08:48:08 +02:00
Fix cycling after addition of the new case simplification.
nset.pas, tcasenode.simplify: don't assume a specific order of the case labels + added test based on ppu.pas, tppu.getaint where no matching case label was found because of the ordering git-svn-id: trunk@26825 -
This commit is contained in:
parent
500920030b
commit
60a07770f1
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10161,6 +10161,7 @@ tests/tbs/tb0601.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0602.pp svneol=native#text/plain
|
||||
tests/tbs/tb0603.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0604.pp svneol=native#text/pascal
|
||||
tests/tbs/tb0605.pp svneol=native#text/pascal
|
||||
tests/tbs/tb205.pp svneol=native#text/plain
|
||||
tests/tbs/tbs0594.pp svneol=native#text/pascal
|
||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||
|
@ -844,27 +844,32 @@ implementation
|
||||
function tcasenode.simplify(forinline:boolean):tnode;
|
||||
var
|
||||
tmp: pcaselabel;
|
||||
walkup: boolean;
|
||||
begin
|
||||
result:=nil;
|
||||
if left.nodetype=ordconstn then
|
||||
begin
|
||||
tmp:=labels;
|
||||
{ walk the case labels as long as the upper bound is smaller than
|
||||
the constant }
|
||||
while assigned(tmp) and (tmp^._high<tordconstnode(left).value) do
|
||||
tmp:=tmp^.greater;
|
||||
{ check whether the constant is inside the range }
|
||||
if assigned(tmp) and
|
||||
(tmp^._low<=tordconstnode(left).value) and
|
||||
(tmp^._high>=tordconstnode(left).value) then
|
||||
{ check all case labels until we find one that fits }
|
||||
walkup:=assigned(tmp^.greater);
|
||||
while assigned(tmp) do
|
||||
begin
|
||||
if tmp^.blockid>=blocks.count then
|
||||
internalerror(2014022101);
|
||||
result:=pcaseblock(blocks[tmp^.blockid])^.statement;
|
||||
if not assigned(result) then
|
||||
internalerror(2014022102);
|
||||
result:=result.getcopy;
|
||||
exit;
|
||||
if (tmp^._low<=tordconstnode(left).value) and
|
||||
(tmp^._high>=tordconstnode(left).value) then
|
||||
begin
|
||||
if tmp^.blockid>=blocks.count then
|
||||
internalerror(2014022101);
|
||||
result:=pcaseblock(blocks[tmp^.blockid])^.statement;
|
||||
if not assigned(result) then
|
||||
internalerror(2014022102);
|
||||
result:=result.getcopy;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if walkup then
|
||||
tmp:=tmp^.greater
|
||||
else
|
||||
tmp:=tmp^.less;
|
||||
end;
|
||||
{ no label did match; use the else block if available }
|
||||
if assigned(elseblock) then
|
||||
|
42
tests/tbs/tb0605.pp
Normal file
42
tests/tbs/tb0605.pp
Normal file
@ -0,0 +1,42 @@
|
||||
program tb0605;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
type
|
||||
aint = longint;
|
||||
|
||||
function getint64: int64;
|
||||
begin
|
||||
Result := 64;
|
||||
end;
|
||||
|
||||
function getlongint: longint;
|
||||
begin
|
||||
Result := 32;
|
||||
end;
|
||||
|
||||
function getword: word;
|
||||
begin
|
||||
result := 16;
|
||||
end;
|
||||
|
||||
function getbyte: byte;
|
||||
begin
|
||||
result := 8;
|
||||
end;
|
||||
|
||||
function getaint: longint;
|
||||
begin
|
||||
result:=4;
|
||||
case sizeof(aint) of
|
||||
8: result:=getint64;
|
||||
4: result:=getlongint;
|
||||
2: result:=smallint(getword);
|
||||
1: result:=shortint(getbyte);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if getaint <> 32 then
|
||||
Halt(1);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user