diff --git a/.gitattributes b/.gitattributes index b1b9e11f8a..cf49e065cd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -17865,6 +17865,7 @@ tests/webtbs/tw3576.pp svneol=native#text/plain tests/webtbs/tw3577.pp svneol=native#text/plain tests/webtbs/tw3578.pp svneol=native#text/plain tests/webtbs/tw3579.pp svneol=native#text/plain +tests/webtbs/tw35820.pp svneol=native#text/pascal tests/webtbs/tw3583.pp svneol=native#text/plain tests/webtbs/tw35862.pp svneol=native#text/pascal tests/webtbs/tw35878.pp svneol=native#text/plain diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 94f46d331b..e60922b8c3 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -2162,8 +2162,11 @@ implementation end; p.labelsym:=labelsym; + { do not copy the label node here as we do not know if the label node is part of the tree or not, + this will be fixed after the copying in node.setuplabelnode: if the labelnode has copiedto set, + labelnode of the goto node is update } if assigned(labelnode) then - p.labelnode:=tlabelnode(labelnode.dogetcopy) + p.labelnode:=labelnode else begin { don't trigger IE when there was already an error, i.e. the diff --git a/compiler/node.pas b/compiler/node.pas index 0bd3d4b7b4..0c2ba4efbb 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -1319,9 +1319,19 @@ implementation end; + function setuplabelnode(var n : tnode;arg : pointer) : foreachnoderesult; + begin + result:=fen_true; + if (n.nodetype=goton) and assigned(tgotonode(n).labelnode) and + assigned(tgotonode(n).labelnode.copiedto) then + tgotonode(n).labelnode:=tgotonode(n).labelnode.copiedto; + end; + + function tnode.getcopy : tnode; begin result:=dogetcopy; + foreachnodestatic(pm_postprocess,result,@setuplabelnode,nil); foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil); end; diff --git a/tests/webtbs/tw35820.pp b/tests/webtbs/tw35820.pp new file mode 100644 index 0000000000..0d5cd3f04d --- /dev/null +++ b/tests/webtbs/tw35820.pp @@ -0,0 +1,41 @@ +program BugExample; + +{$mode ObjFPC} +{$GOTO ON} + +type SubRange = 1..3; + + procedure Blah(const I: SubRange); inline; + var + B: Boolean = True; + label + Top; + begin + Top: + case I of + 1: + WriteLn(2); + 2: + if B then + begin + B := False; + WriteLn('Resetting!'); + goto Top; + end + else + WriteLn(4); + 3: + WriteLn(6); + end; + end; + + procedure DoIt; + begin + Blah(1); + Blah(2); + Blah(3); + end; + +begin + DoIt; +end.