* fixed coping of goto/label nodes

git-svn-id: trunk@5053 -
This commit is contained in:
florian 2006-10-29 09:50:39 +00:00
parent ad1c431896
commit 3d85bfbf7b
4 changed files with 75 additions and 26 deletions

1
.gitattributes vendored
View File

@ -6036,6 +6036,7 @@ tests/tbs/tb0503.pp svneol=native#text/plain
tests/tbs/tb0504.pp svneol=native#text/plain
tests/tbs/tb0505.pp svneol=native#text/plain
tests/tbs/tb0506.pp svneol=native#text/plain
tests/tbs/tb0507.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain
tests/tbs/ub0119.pp svneol=native#text/plain

View File

@ -1101,7 +1101,7 @@ implementation
if not(assigned(labelnode)) then
begin
if assigned(labelsym.code) then
if assigned(labelsym) and assigned(labelsym.code) then
labelnode:=tlabelnode(labelsym.code)
else
internalerror(200506183);
@ -1117,32 +1117,20 @@ implementation
function tgotonode._getcopy : tnode;
var
p : tgotonode;
{ i : longint; }
i : longint;
begin
p:=tgotonode(inherited _getcopy);
{
p.exceptionblock:=exceptionblock;
{ When we copying, we do an ugly trick to determine if the label used
by the current goto node is already copied: if the referinggotonodes
contains the current label, it isn't copied yet, so copy also the
label node and set the copiedto field to the newly created node.
If a label to copy is reached the copiedto field is checked. If it's non nil
the copiedto field is returned and the copiedto field is reset to nil.
}
{ assume no copying }
newlabelnode:=labelnode;
for i:=0 to labelnode.copiedto.referingotonodes.count-1 do
{ force a valid labelnode }
if not(assigned(labelnode)) then
begin
{ copy labelnode? }
if labelnode.copiedto.referinggotonodes[i]=self then
begin
oldlabelnode.copiedto:=newlabelnode;
end;
if assigned(labelsym) and assigned(labelsym.code) then
labelnode:=tlabelnode(labelsym.code)
else
internalerror(200610291);
end;
p.labelnode:=newlabelnode;
p.labelnode.referinggotonodes.add(self);
}
p.labelnode:=tlabelnode(labelnode._getcopy);
result:=p;
end;
@ -1217,13 +1205,12 @@ implementation
function tlabelnode._getcopy : tnode;
var
p : tlabelnode;
begin
p:=tlabelnode(inherited _getcopy);
p.exceptionblock:=exceptionblock;
if not(assigned(copiedto)) then
copiedto:=tlabelnode(inherited _getcopy);
copiedto.exceptionblock:=exceptionblock;
result:=p;
result:=copiedto;
end;

View File

@ -439,6 +439,7 @@ implementation
uses
cutils,verbose,ppu,
symconst,
nutils,nflw,
defutil;
const
@ -827,9 +828,18 @@ implementation
end;
function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult;
begin
result:=fen_true;
if n.nodetype=labeln then
tlabelnode(n).copiedto:=nil;
end;
function tnode.getcopy : tnode;
begin
result:=_getcopy;
foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil);
end;

51
tests/tbs/tb0507.pp Normal file
View File

@ -0,0 +1,51 @@
{$inline on}
var
j : longint;
procedure p1;inline;
label l;
var
i:longint;
begin
i:=0;
l:
inc(i);
while i<2 do
begin
goto l;
goto l;
goto l;
end;
end;
procedure p2;inline;
label l;
begin
goto l;
goto l;
goto l;
l:
end;
procedure p3;inline;
begin
j:=j+1;
end;
begin
j:=0;
p1;
p1;
p1;
p1;
p2;
p2;
p2;
p2;
p3;
end.