Browse Source

* when copying goto nodes take care if the label node is part of the copied tree
or not, resolves #35820

git-svn-id: trunk@43793 -

florian 5 years ago
parent
commit
fd0012deff
4 changed files with 56 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 4 1
      compiler/nflw.pas
  3. 10 0
      compiler/node.pas
  4. 41 0
      tests/webtbs/tw35820.pp

+ 1 - 0
.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

+ 4 - 1
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

+ 10 - 0
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;
 

+ 41 - 0
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.