Ver Fonte

* fixed mantis 7975 and 7107 (ie 200311075 when working using somewhat
complex method calls in inlined procedures)

git-svn-id: trunk@5666 -

Jonas Maebe há 18 anos atrás
pai
commit
e4a2fb7f35
5 ficheiros alterados com 68 adições e 9 exclusões
  1. 2 0
      .gitattributes
  2. 23 8
      compiler/ncal.pas
  3. 1 1
      compiler/ppu.pas
  4. 31 0
      tests/webtbs/tw7975.pp
  5. 11 0
      tests/webtbs/tw7975a.pp

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

+ 23 - 8
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;
 
 

+ 1 - 1
compiler/ppu.pas

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

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

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