浏览代码

* also process tcallnode.funcretnode in nutils.foreachnode*(),needed
for properly synchronizing regvars after loops. The absense of this
causes the crash in the test program of mantis #11290 under 2.2.1,
and while it doesn't crash under 2.3.1 due to differences in the
code generation, the bug could cause errors in other situations
here as well)

git-svn-id: trunk@10959 -

Jonas Maebe 17 年之前
父节点
当前提交
6ac63bcafe
共有 4 个文件被更改,包括 43 次插入3 次删除
  1. 1 0
      .gitattributes
  2. 3 3
      compiler/ncal.pas
  3. 2 0
      compiler/nutils.pas
  4. 37 0
      tests/webtbs/tw11290.pp

+ 1 - 0
.gitattributes

@@ -8203,6 +8203,7 @@ tests/webtbs/tw1124.pp svneol=native#text/plain
 tests/webtbs/tw11254.pp svneol=native#text/plain
 tests/webtbs/tw11255.pp svneol=native#text/plain
 tests/webtbs/tw11288.pp svneol=native#text/plain
+tests/webtbs/tw11290.pp svneol=native#text/plain
 tests/webtbs/tw1132.pp svneol=native#text/plain
 tests/webtbs/tw1133.pp svneol=native#text/plain
 tests/webtbs/tw1152.pp svneol=native#text/plain

+ 3 - 3
compiler/ncal.pas

@@ -84,9 +84,6 @@ interface
           function  pass1_inline:tnode;
        protected
           pushedparasize : longint;
-          { function return node for initialized types or supplied return variable.
-            When the result is passed in a parameter then it is set to nil }
-          funcretnode    : tnode;
        public
           { the symbol containing the definition of the procedure }
           { to call                                               }
@@ -102,6 +99,9 @@ interface
           { initialize/finalization of temps }
           callinitblock,
           callcleanupblock : tblocknode;
+          { function return node for initialized types or supplied return variable.
+            When the result is passed in a parameter then it is set to nil }
+          funcretnode    : tnode;
           { varargs parasyms }
           varargsparas : tvarargsparalist;
 

+ 2 - 0
compiler/nutils.pas

@@ -113,6 +113,7 @@ implementation
             begin
               result := foreachnode(procmethod,tcallnode(n).callinitblock,f,arg) or result;
               result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
+              result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnode(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
             end;
           ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
@@ -191,6 +192,7 @@ implementation
             begin
               result := foreachnodestatic(procmethod,tcallnode(n).callinitblock,f,arg) or result;
               result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
+              result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
               result := foreachnodestatic(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
             end;
           ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:

+ 37 - 0
tests/webtbs/tw11290.pp

@@ -0,0 +1,37 @@
+program optimiav;
+//compile with -OG2p3
+
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
+ sysutils;
+type
+ stringarty = array of string;
+ ttestclass = class
+  private
+   fignoreexceptionclasses: stringarty;
+  public
+   procedure setignoreexceptionclasses(const avalue: stringarty);
+ end;
+
+procedure ttestclass.setignoreexceptionclasses(const avalue: stringarty);
+var
+ int1: integer;
+begin
+ setlength(fignoreexceptionclasses,length(avalue));
+ for int1:= 0 to high(avalue) do begin
+  fignoreexceptionclasses[int1]:= uppercase(avalue[int1]);
+ end;
+end;
+
+var
+ testclass1: ttestclass;
+ ar1: stringarty;
+begin
+ testclass1:= ttestclass.create;
+ setlength(ar1,2);
+ testclass1.setignoreexceptionclasses(ar1);
+ testclass1.free;
+end.
+