paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 02:28:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* also process tcallnode.funcretnode in nutils.foreachnode*(),needed

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2008-05-12 20:50:43 +00:00
parent 5da751376b
commit 6ac63bcafe
4 changed files with 43 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

6
compiler/ncal.pas
View File

@ -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
compiler/nutils.pas
View File

@ -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
tests/webtbs/tw11290.pp Normal file
View File

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