* fixed coping of goto/label nodes

git-svn-id: trunk@5053 -

.gitattributes

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

compiler/nflw.pas

@@ -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
+        { force a valid labelnode }
-          the copiedto field is returned and the copiedto field is reset to nil.
+        if not(assigned(labelnode)) then
-        }
-        { assume no copying }
-        newlabelnode:=labelnode;
-        for i:=0 to labelnode.copiedto.referingotonodes.count-1 do
           begin
-            { copy labelnode? }
+            if assigned(labelsym) and assigned(labelsym.code) then
-            if labelnode.copiedto.referinggotonodes[i]=self then
+              labelnode:=tlabelnode(labelsym.code)
-              begin
+            else
-                oldlabelnode.copiedto:=newlabelnode;
+              internalerror(200610291);
           end;
-          end;
+        p.labelnode:=tlabelnode(labelnode._getcopy);
-        p.labelnode:=newlabelnode;
-        p.labelnode.referinggotonodes.add(self);
-        }
         result:=p;
      end;
 
@@ -1217,13 +1205,12 @@ implementation
 
 
    function tlabelnode._getcopy : tnode;
-     var
-        p : tlabelnode;
      begin
-        p:=tlabelnode(inherited _getcopy);
+        if not(assigned(copiedto)) then
-        p.exceptionblock:=exceptionblock;
+          copiedto:=tlabelnode(inherited _getcopy);
+        copiedto.exceptionblock:=exceptionblock;
 
-        result:=p;
+        result:=copiedto;
      end;
 
 

compiler/node.pas

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

tests/tbs/tb0507.pp

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