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

* fixed mantis 7975 and 7107 (ie 200311075 when working using somewhat

Browse Source 
complex method calls in inlined procedures)

git-svn-id: trunk@5666 -
This commit is contained in:
Jonas Maebe 2006-12-21 21:03:47 +00:00
parent 569bec8e80
commit e4a2fb7f35
5 changed files with 68 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -7794,6 +7794,8 @@ tests/webtbs/tw7817a.pp svneol=native#text/plain
tests/webtbs/tw7817b.pp svneol=native#text/plain
tests/webtbs/tw7847.pp svneol=native#text/plain
tests/webtbs/tw7963.pp svneol=native#text/plain
tests/webtbs/tw7975.pp svneol=native#text/plain
tests/webtbs/tw7975a.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

31
compiler/ncal.pas
View File

@ -108,6 +108,7 @@ interface
destructor destroy;override;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure derefnode;override;
procedure buildderefimpl;override;
procedure derefimpl;override;
function dogetcopy : tnode;override;
@ -1123,29 +1124,43 @@ implementation
constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
methodpointerinit:=tblocknode(ppuloadnode(ppufile));
methodpointer:=ppuloadnode(ppufile);
methodpointerdone:=tblocknode(ppuloadnode(ppufile));
_funcretnode:=ppuloadnode(ppufile);
inherited ppuload(t,ppufile);
ppufile.getderef(symtableprocentryderef);
{$warning FIXME: No withsymtable support}
symtableproc:=nil;
ppufile.getderef(procdefinitionderef);
ppufile.getsmallset(callnodeflags);
methodpointer:=ppuloadnode(ppufile);
methodpointerinit:=tblocknode(ppuloadnode(ppufile));
methodpointerdone:=tblocknode(ppuloadnode(ppufile));
_funcretnode:=ppuloadnode(ppufile);
end;
procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
begin
ppuwritenode(ppufile,methodpointerinit);
ppuwritenode(ppufile,methodpointer);
ppuwritenode(ppufile,methodpointerdone);
ppuwritenode(ppufile,_funcretnode);
inherited ppuwrite(ppufile);
ppufile.putderef(symtableprocentryderef);
ppufile.putderef(procdefinitionderef);
ppufile.putsmallset(callnodeflags);
ppuwritenode(ppufile,methodpointer);
ppuwritenode(ppufile,methodpointerinit);
ppuwritenode(ppufile,methodpointerdone);
ppuwritenode(ppufile,_funcretnode);
end;
procedure tcallnode.derefnode;
begin
if assigned(methodpointerinit) then
methodpointerinit.derefnode;
if assigned(methodpointer) then
methodpointer.derefnode;
if assigned(methodpointerdone) then
methodpointerdone.derefnode;
if assigned(_funcretnode) then
_funcretnode.derefnode;
inherited derefnode;
end;

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=70;
CurrentPPUVersion=71;
{ buffer sizes }
maxentrysize = 1024;

31
tests/webtbs/tw7975.pp Normal file
View File

@ -0,0 +1,31 @@
{$mode objfpc}
{$inline on}
unit tw7975;
interface
type
tc = class
function t(const s: string): string; virtual;
pref: string;
parent: tc;
end;
function test(c: tc): string; inline;
implementation
function tc.t(const s: string): string;
begin
result := s + ' -- passed t';
end;
function test(c: tc): string; inline;
begin
c.pref := 'bla';
c.parent := c;
result := c.parent.t('a'+c.pref);
end;
end.

11
tests/webtbs/tw7975a.pp Normal file
View File

@ -0,0 +1,11 @@
{$inline on}
{$mode objfpc}
uses tw7975;
var
c: tc;
begin
c := tc.create;
writeln(test(c));
c.free;
end.