paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 13:19:12 +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/tw16065.pp svneol=native#text/pascal
tests/webtbs/tw16083.pp svneol=native#text/plain tests/webtbs/tw16083.pp svneol=native#text/plain
tests/webtbs/tw16108.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/tw16161.pp svneol=native#text/pascal
tests/webtbs/tw16163.pp svneol=native#text/plain tests/webtbs/tw16163.pp svneol=native#text/plain
tests/webtbs/tw1617.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 uses
cclasses,constexp, cclasses,constexp,
node,globtype,globals, node,globtype,globals,
aasmbase,aasmtai,aasmdata,ncon,symtype; aasmbase,aasmtai,aasmdata,ncon,nflw,symtype;
type type
TLabelType = (ltOrdinal, ltConstString); TLabelType = (ltOrdinal, ltConstString);
@ -59,6 +59,8 @@ interface
tcaseblock = record tcaseblock = record
{ label (only used in pass_generate_code) } { label (only used in pass_generate_code) }
blocklabel : tasmlabel; blocklabel : tasmlabel;
statementlabel : tlabelnode;
{ instructions } { instructions }
statement : tnode; statement : tnode;
end; end;
@ -128,7 +130,7 @@ implementation
verbose, verbose,
symconst,symdef,symsym,symtable,defutil,defcmp, symconst,symdef,symsym,symtable,defutil,defcmp,
htypechk,pass_1, htypechk,pass_1,
nadd,nbas,ncnv,nld,nflw,cgobj,cgbase, nadd,nbas,ncnv,nld,cgobj,cgbase,
widestr; widestr;
@ -651,8 +653,9 @@ implementation
i : integer; i : integer;
node_thenblock,node_elseblock,if_node : tnode; node_thenblock,node_elseblock,if_node : tnode;
tempcaseexpr : ttempcreatenode; tempcaseexpr : ttempcreatenode;
if_block, init_block : tblocknode; if_block, init_block,stmt_block : tblocknode;
stmt : tstatementnode; stmt : tstatementnode;
endlabel : tlabelnode;
function makeifblock(const labtree : pcaselabel; prevconditblock : tnode): tnode; function makeifblock(const labtree : pcaselabel; prevconditblock : tnode): tnode;
var var
@ -675,8 +678,7 @@ implementation
result := result :=
cifnode.create( cifnode.create(
condit, pcaseblock(blocks[labtree^.blockid])^.statement, result); condit, cgotonode.create(pcaseblock(blocks[labtree^.blockid])^.statementlabel.labsym), result);
pcaseblock(blocks[labtree^.blockid])^.statement := nil;
if assigned(labtree^.greater) then if assigned(labtree^.greater) then
result := makeifblock(labtree^.greater, result); result := makeifblock(labtree^.greater, result);
@ -742,17 +744,34 @@ implementation
if (labels^.label_type = ltConstString) then if (labels^.label_type = ltConstString) then
begin begin
if_node := makeifblock(labels, elseblock); endlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrofend'));
if assigned(init_block) then stmt_block:=internalstatements(stmt);
for i:=0 to blocks.count-1 do
begin begin
firstpass(tnode(init_block)); pcaseblock(blocks[i])^.statementlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrof'));
if_block := internalstatements(stmt); addstatement(stmt,pcaseblock(blocks[i])^.statementlabel);
addstatement(stmt, init_block); addstatement(stmt,pcaseblock(blocks[i])^.statement);
addstatement(stmt, if_node); pcaseblock(blocks[i])^.statement:=nil;
result := if_block; addstatement(stmt,cgotonode.create(endlabel.labsym));
end end;
else
result := if_node; 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; elseblock := nil;
exit; exit;
end; 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.