Merged revisions 10959 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10959 | jonas | 2008-05-12 22:50:43 +0200 (Mon, 12 May 2008) | 7 lines

  * 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: branches/fixes_2_2@10983 -

.gitattributes

@@ -7999,6 +7999,7 @@ tests/webtbs/tw1123.pp svneol=native#text/plain
 tests/webtbs/tw1124.pp svneol=native#text/plain
 tests/webtbs/tw11254.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

compiler/ncal.pas

@@ -62,9 +62,6 @@ interface
           function  gen_vmt_tree:tnode;
           procedure bind_parasym;
 
-          { function return node, this is used to pass the data for a
-            ret_in_param return value }
-          _funcretnode    : tnode;
           procedure setfuncretnode(const returnnode: tnode);
           procedure convert_carg_array_of_const;
           procedure order_parameters;
@@ -89,6 +86,9 @@ interface
           procdefinitionderef : tderef;
           methodpointerinit,
           methodpointerdone : tblocknode;
+          { function return node, this is used to pass the data for a
+            ret_in_param return value }
+          _funcretnode    : tnode;
           { tree that contains the pointer to the object for this method }
           methodpointer  : tnode;
           { varargs parasyms }

compiler/nutils.pas

@@ -124,6 +124,7 @@ implementation
             { not in one statement, won't work because of b- }
             result := foreachnode(tcallnode(n).methodpointerinit,f,arg) or result;
             result := foreachnode(tcallnode(n).methodpointer,f,arg) or result;
+            result := foreachnode(tcallnode(n)._funcretnode,f,arg) or result;
             result := foreachnode(tcallnode(n).methodpointerdone,f,arg) or result;
           end;
         ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
@@ -171,6 +172,7 @@ implementation
             begin
               result := foreachnodestatic(procmethod,tcallnode(n).methodpointerinit,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).methodpointerdone,f,arg) or result;
             end;
           ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:

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