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

* handle multiple string labels in one case branch correctly, resolves #16130

Browse Source 
git-svn-id: trunk@15212 -
This commit is contained in:
florian 2010-05-02 21:44:24 +00:00
parent 722dbaa616
commit f3c572edc5
3 changed files with 63 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10339,6 +10339,7 @@ tests/webtbs/tw16040.pp svneol=native#text/plain
tests/webtbs/tw16065.pp svneol=native#text/pascal
tests/webtbs/tw16083.pp svneol=native#text/plain
tests/webtbs/tw16108.pp svneol=native#text/plain
tests/webtbs/tw16130.pp svneol=native#text/pascal
tests/webtbs/tw16161.pp svneol=native#text/pascal
tests/webtbs/tw16163.pp svneol=native#text/plain
tests/webtbs/tw1617.pp svneol=native#text/plain

49
compiler/nset.pas
View File

@ -28,7 +28,7 @@ interface
uses
cclasses,constexp,
node,globtype,globals,
aasmbase,aasmtai,aasmdata,ncon,symtype;
aasmbase,aasmtai,aasmdata,ncon,nflw,symtype;
type
TLabelType = (ltOrdinal, ltConstString);
@ -59,6 +59,8 @@ interface
tcaseblock = record
{ label (only used in pass_generate_code) }
blocklabel : tasmlabel;
statementlabel : tlabelnode;
{ instructions }
statement : tnode;
end;
@ -128,7 +130,7 @@ implementation
verbose,
symconst,symdef,symsym,symtable,defutil,defcmp,
htypechk,pass_1,
nadd,nbas,ncnv,nld,nflw,cgobj,cgbase,
nadd,nbas,ncnv,nld,cgobj,cgbase,
widestr;
@ -651,8 +653,9 @@ implementation
i : integer;
node_thenblock,node_elseblock,if_node : tnode;
tempcaseexpr : ttempcreatenode;
if_block, init_block : tblocknode;
if_block, init_block,stmt_block : tblocknode;
stmt : tstatementnode;
endlabel : tlabelnode;
function makeifblock(const labtree : pcaselabel; prevconditblock : tnode): tnode;
var
@ -675,8 +678,7 @@ implementation
result :=
cifnode.create(
condit, pcaseblock(blocks[labtree^.blockid])^.statement, result);
pcaseblock(blocks[labtree^.blockid])^.statement := nil;
condit, cgotonode.create(pcaseblock(blocks[labtree^.blockid])^.statementlabel.labsym), result);
if assigned(labtree^.greater) then
result := makeifblock(labtree^.greater, result);
@ -742,17 +744,34 @@ implementation
if (labels^.label_type = ltConstString) then
begin
if_node := makeifblock(labels, elseblock);
if assigned(init_block) then
endlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrofend'));
stmt_block:=internalstatements(stmt);
for i:=0 to blocks.count-1 do
begin
firstpass(tnode(init_block));
if_block := internalstatements(stmt);
addstatement(stmt, init_block);
addstatement(stmt, if_node);
result := if_block;
end
else
result := if_node;
pcaseblock(blocks[i])^.statementlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrof'));
addstatement(stmt,pcaseblock(blocks[i])^.statementlabel);
addstatement(stmt,pcaseblock(blocks[i])^.statement);
pcaseblock(blocks[i])^.statement:=nil;
addstatement(stmt,cgotonode.create(endlabel.labsym));
end;
firstpass(tnode(stmt_block));
if_node := makeifblock(labels, elseblock);
if assigned(init_block) then
firstpass(tnode(init_block));
if_block := internalstatements(stmt);
if assigned(init_block) then
addstatement(stmt, init_block);
addstatement(stmt, if_node);
addstatement(stmt,cgotonode.create(endlabel.labsym));
addstatement(stmt, stmt_block);
addstatement(stmt, endlabel);
result := if_block;
elseblock := nil;
exit;
end;

28
tests/webtbs/tw16130.pp Normal file
View File

@ -0,0 +1,28 @@
var
S :String;
begin
S := 'H';
case S of
'HH','H': WriteLn('1');
end;
S := 'HH';
case S of
'HH': WriteLn('2');
end;
case S of
'HH','H': WriteLn('3');
end;
case S of
'H','HH': WriteLn('4');
end;
S := 'A';
case S of
'HH': WriteLn('2');
end;
case S of
'HH','H': WriteLn('3');
end;
case S of
'H','HH': WriteLn('4');
end;
end.