* save/restore itype and implementsgetter fields of timplementedinterface

    to/from ppu, because it can be required while resolving type casts
    (mantis #22741)

git-svn-id: trunk@22266 -

.gitattributes

@@ -12817,6 +12817,7 @@ tests/webtbs/tw2268.pp svneol=native#text/plain
 tests/webtbs/tw2269.pp svneol=native#text/plain
 tests/webtbs/tw22705.pp svneol=native#text/plain
 tests/webtbs/tw2274.pp svneol=native#text/plain
+tests/webtbs/tw22741.pp svneol=native#text/plain
 tests/webtbs/tw22744.pp svneol=native#text/pascal
 tests/webtbs/tw2277.pp svneol=native#text/plain
 tests/webtbs/tw2280.pp svneol=native#text/plain
@@ -13609,6 +13610,8 @@ tests/webtbs/uw21808b.pp svneol=native#text/plain
 tests/webtbs/uw2266a.inc svneol=native#text/plain
 tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain
+tests/webtbs/uw22741a.pp svneol=native#text/plain
+tests/webtbs/uw22741b.pp svneol=native#text/plain
 tests/webtbs/uw2364.pp svneol=native#text/plain
 tests/webtbs/uw2706a.pp svneol=native#text/plain
 tests/webtbs/uw2706b.pp svneol=native#text/plain

compiler/ppu.pas

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

compiler/symdef.pas

@@ -242,9 +242,10 @@ interface
          NameMappings : TFPHashList;
          ProcDefs     : TFPObjectList;
          ImplementsGetter :  tsym;
+         ImplementsGetterDeref : tderef;
          ImplementsField : tsym;
          constructor create(aintf: tobjectdef);
-         constructor create_deref(d:tderef);
+         constructor create_deref(intfd,getterd:tderef);
          destructor  destroy; override;
          function  getcopy:TImplementedInterface;
          procedure buildderef;
@@ -5189,7 +5190,7 @@ implementation
       var
          i,
          implintfcount : longint;
-         d : tderef;
+         d, getterd : tderef;
          ImplIntf : TImplementedInterface;
          vmtentry : pvmtentry;
       begin
@@ -5240,8 +5241,10 @@ implementation
              for i:=0 to implintfcount-1 do
                begin
                  ppufile.getderef(d);
-                 ImplIntf:=TImplementedInterface.Create_deref(d);
+                 ppufile.getderef(getterd);
+                 ImplIntf:=TImplementedInterface.Create_deref(d,getterd);
                  ImplIntf.IOffset:=ppufile.getlongint;
+                 byte(ImplIntf.IType):=ppufile.getbyte;
                  ImplementedInterfaces.Add(ImplIntf);
                end;
            end
@@ -5425,7 +5428,9 @@ implementation
                begin
                  ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]);
                  ppufile.putderef(ImplIntf.intfdefderef);
+                 ppufile.putderef(ImplIntf.ImplementsGetterDeref);
                  ppufile.putlongint(ImplIntf.Ioffset);
+                 ppufile.putbyte(byte(ImplIntf.IType));
                end;
            end;
 
@@ -6275,11 +6280,12 @@ implementation
       end;
 
 
-    constructor TImplementedInterface.create_deref(d:tderef);
+    constructor TImplementedInterface.create_deref(intfd,getterd:tderef);
       begin
         inherited create;
         intfdef:=nil;
-        intfdefderef:=d;
+        intfdefderef:=intfd;
+        ImplementsGetterDeref:=getterd;
         IOffset:=-1;
         IType:=etStandard;
         NameMappings:=nil;
@@ -6314,12 +6320,14 @@ implementation
     procedure TImplementedInterface.buildderef;
       begin
         intfdefderef.build(intfdef);
+        ImplementsGetterDeref.build(ImplementsGetter);
       end;
 
 
     procedure TImplementedInterface.deref;
       begin
         intfdef:=tobjectdef(intfdefderef.resolve);
+        ImplementsGetter:=tsym(ImplementsGetterDeref.resolve);
       end;
 
 

tests/webtbs/tw22741.pp

@@ -0,0 +1,29 @@
+{ %recompile }
+{ %opt=-gh }
+
+program tw22741;
+{$mode objfpc}
+    uses uw22741a;
+    type
+        te= class(td)
+            procedure address(d: td); virtual;
+        end;
+            procedure te.address(d: td);
+                var anIo: iIO;
+            begin
+                writeln(d.className);
+                writeln(nativeuint(iIO(d)));
+                writeln(nativeuint(iIO(d.fiio)));
+                anIo:= d;
+                writeln(nativeuint(anIo));
+            end;
+    var
+        e1, e2: te;
+begin
+    e1:= te.create;
+    e2:= te.create;
+    e1.address(e2);
+    e1.destroy;
+    e2.destroy;
+end.
+

tests/webtbs/uw22741a.pp

@@ -0,0 +1,54 @@
+unit uw22741a;
+{$mode objfpc}
+
+interface
+    uses uw22741b;
+
+    type
+        iIO= interface
+            procedure read;
+            procedure write;
+        end;
+
+        tc= class(tInterfaceObject, iIO)
+            procedure read; virtual;
+            procedure write; virtual;
+            destructor destroy; override;
+        end;
+    type
+        td= class(tObject, iIO)
+            ftc: tc;
+            fiio: iIO;
+            property io: tc read ftc implements iIO;
+            constructor create; virtual;
+            destructor destroy; override;
+        end;
+
+
+implementation
+
+
+procedure tc.read; begin end;
+procedure tc.write; begin end;
+destructor tc.destroy;
+begin
+    writeln('tc ', nativeuint(self), ' destroyed');
+    inherited;
+end;
+
+constructor td.create;
+begin
+    inherited;
+    ftc:= tc.create;
+    fiio:= ftc; // increace reference counter to one
+end;
+destructor td.destroy;
+begin
+    fiio:= nil; // ftc is automatically destroyed
+    ftc.free;
+    writeln('td ', nativeuint(self), ' destroyed');
+    inherited;
+end;
+
+end.
+

tests/webtbs/uw22741b.pp

@@ -0,0 +1,48 @@
+unit uw22741b;
+{$mode objfpc}
+
+interface
+
+type
+    iBase = interface
+        function getSelf: tObject;
+    end;
+
+    tInterfaceObject= class(tObject, iBase)
+        public
+            function getSelf: tObject;
+            function queryInterface({$IFDEF FPC_HAS_CONSTREF}constRef{$ELSE}const{$ENDIF} iid: tGuid; out obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
+            function _addRef: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
+            function _release: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
+    end;
+
+
+implementation
+
+
+function tInterfaceObject.getSelf: tObject;
+begin
+    result:= self;
+end;
+
+function tInterfaceObject.queryInterface({$IFDEF FPC_HAS_CONSTREF}constRef{$ELSE}const{$ENDIF} iid: tGuid; out obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+    if getInterface(iId, obj) then
+        result:= S_OK
+    else
+        result:= longint(E_NOINTERFACE);
+end;
+
+function tInterfaceObject._addRef: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+    result:= 1;
+end;
+
+function tInterfaceObject._release: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+    result:= 1;
+end;
+
+
+end.
+