From e4a2fb7f35de72f4ea19bda0fb64e2da715602fc Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Thu, 21 Dec 2006 21:03:47 +0000
Subject: [PATCH]   * fixed mantis 7975 and 7107 (ie 200311075 when working
 using somewhat     complex method calls in inlined procedures)

git-svn-id: trunk@5666 -
---
 .gitattributes          |  2 ++
 compiler/ncal.pas       | 31 +++++++++++++++++++++++--------
 compiler/ppu.pas        |  2 +-
 tests/webtbs/tw7975.pp  | 31 +++++++++++++++++++++++++++++++
 tests/webtbs/tw7975a.pp | 11 +++++++++++
 5 files changed, 68 insertions(+), 9 deletions(-)
 create mode 100644 tests/webtbs/tw7975.pp
 create mode 100644 tests/webtbs/tw7975a.pp

diff --git a/.gitattributes b/.gitattributes
index a10a2912e3..fbbc99db10 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index d88e4a268a..a437dd07d0 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -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;
 
 
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 6412b8688e..fd29feeedf 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=70;
+  CurrentPPUVersion=71;
 
 { buffer sizes }
   maxentrysize = 1024;
diff --git a/tests/webtbs/tw7975.pp b/tests/webtbs/tw7975.pp
new file mode 100644
index 0000000000..290d9bbe29
--- /dev/null
+++ b/tests/webtbs/tw7975.pp
@@ -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.
diff --git a/tests/webtbs/tw7975a.pp b/tests/webtbs/tw7975a.pp
new file mode 100644
index 0000000000..b201298342
--- /dev/null
+++ b/tests/webtbs/tw7975a.pp
@@ -0,0 +1,11 @@
+{$inline on}
+{$mode objfpc}
+uses tw7975;
+
+var
+  c: tc;
+begin
+  c := tc.create;
+  writeln(test(c));
+  c.free;
+end.