mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 06:10:38 +02:00
* fixed mantis 7975 and 7107 (ie 200311075 when working using somewhat
complex method calls in inlined procedures) git-svn-id: trunk@5666 -
This commit is contained in:
parent
569bec8e80
commit
e4a2fb7f35
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -7794,6 +7794,8 @@ tests/webtbs/tw7817a.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw7817b.pp svneol=native#text/plain
|
tests/webtbs/tw7817b.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7847.pp svneol=native#text/plain
|
tests/webtbs/tw7847.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7963.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/ub1873.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||||
|
@ -108,6 +108,7 @@ interface
|
|||||||
destructor destroy;override;
|
destructor destroy;override;
|
||||||
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
|
||||||
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
procedure ppuwrite(ppufile:tcompilerppufile);override;
|
||||||
|
procedure derefnode;override;
|
||||||
procedure buildderefimpl;override;
|
procedure buildderefimpl;override;
|
||||||
procedure derefimpl;override;
|
procedure derefimpl;override;
|
||||||
function dogetcopy : tnode;override;
|
function dogetcopy : tnode;override;
|
||||||
@ -1123,29 +1124,43 @@ implementation
|
|||||||
|
|
||||||
constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
|
||||||
begin
|
begin
|
||||||
|
methodpointerinit:=tblocknode(ppuloadnode(ppufile));
|
||||||
|
methodpointer:=ppuloadnode(ppufile);
|
||||||
|
methodpointerdone:=tblocknode(ppuloadnode(ppufile));
|
||||||
|
_funcretnode:=ppuloadnode(ppufile);
|
||||||
inherited ppuload(t,ppufile);
|
inherited ppuload(t,ppufile);
|
||||||
ppufile.getderef(symtableprocentryderef);
|
ppufile.getderef(symtableprocentryderef);
|
||||||
{$warning FIXME: No withsymtable support}
|
{$warning FIXME: No withsymtable support}
|
||||||
symtableproc:=nil;
|
symtableproc:=nil;
|
||||||
ppufile.getderef(procdefinitionderef);
|
ppufile.getderef(procdefinitionderef);
|
||||||
ppufile.getsmallset(callnodeflags);
|
ppufile.getsmallset(callnodeflags);
|
||||||
methodpointer:=ppuloadnode(ppufile);
|
|
||||||
methodpointerinit:=tblocknode(ppuloadnode(ppufile));
|
|
||||||
methodpointerdone:=tblocknode(ppuloadnode(ppufile));
|
|
||||||
_funcretnode:=ppuloadnode(ppufile);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
|
procedure tcallnode.ppuwrite(ppufile:tcompilerppufile);
|
||||||
begin
|
begin
|
||||||
|
ppuwritenode(ppufile,methodpointerinit);
|
||||||
|
ppuwritenode(ppufile,methodpointer);
|
||||||
|
ppuwritenode(ppufile,methodpointerdone);
|
||||||
|
ppuwritenode(ppufile,_funcretnode);
|
||||||
inherited ppuwrite(ppufile);
|
inherited ppuwrite(ppufile);
|
||||||
ppufile.putderef(symtableprocentryderef);
|
ppufile.putderef(symtableprocentryderef);
|
||||||
ppufile.putderef(procdefinitionderef);
|
ppufile.putderef(procdefinitionderef);
|
||||||
ppufile.putsmallset(callnodeflags);
|
ppufile.putsmallset(callnodeflags);
|
||||||
ppuwritenode(ppufile,methodpointer);
|
end;
|
||||||
ppuwritenode(ppufile,methodpointerinit);
|
|
||||||
ppuwritenode(ppufile,methodpointerdone);
|
|
||||||
ppuwritenode(ppufile,_funcretnode);
|
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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -43,7 +43,7 @@ type
|
|||||||
{$endif Test_Double_checksum}
|
{$endif Test_Double_checksum}
|
||||||
|
|
||||||
const
|
const
|
||||||
CurrentPPUVersion=70;
|
CurrentPPUVersion=71;
|
||||||
|
|
||||||
{ buffer sizes }
|
{ buffer sizes }
|
||||||
maxentrysize = 1024;
|
maxentrysize = 1024;
|
||||||
|
31
tests/webtbs/tw7975.pp
Normal file
31
tests/webtbs/tw7975.pp
Normal 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
11
tests/webtbs/tw7975a.pp
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
{$inline on}
|
||||||
|
{$mode objfpc}
|
||||||
|
uses tw7975;
|
||||||
|
|
||||||
|
var
|
||||||
|
c: tc;
|
||||||
|
begin
|
||||||
|
c := tc.create;
|
||||||
|
writeln(test(c));
|
||||||
|
c.free;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user