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:
svenbarth 2014-02-21 22:49:19 +00:00
parent 500920030b
commit 60a07770f1
3 changed files with 63 additions and 15 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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
View 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.