Browse Source

+ test from mantis #16365, already works

git-svn-id: trunk@16447 -
Jonas Maebe 14 years ago
parent
commit
11399b9b13
2 changed files with 81 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 80 0
      tests/webtbs/tw16365.pp

+ 1 - 0
.gitattributes

@@ -10677,6 +10677,7 @@ tests/webtbs/tw16315b.pp svneol=native#text/pascal
 tests/webtbs/tw16326.pp svneol=native#text/plain
 tests/webtbs/tw16328.pp svneol=native#text/plain
 tests/webtbs/tw1634.pp svneol=native#text/plain
+tests/webtbs/tw16365.pp svneol=native#text/plain
 tests/webtbs/tw16366.pp svneol=native#text/plain
 tests/webtbs/tw16377.pp svneol=native#text/plain
 tests/webtbs/tw16402.pp svneol=native#text/plain

+ 80 - 0
tests/webtbs/tw16365.pp

@@ -0,0 +1,80 @@
+program delegation;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ sysutils;
+
+type
+ itest = interface
+  function test: longint;
+ end;
+ 
+ timpclass = class(tobject,itest)
+  protected
+   function _addref: integer; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function _release: integer; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function QueryInterface(constref IID: TGUID; out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+  public
+   function test: longint;
+ end;
+ 
+ ttestclass = class(tobject,itest)
+  private
+   fimp: timpclass;
+   property imp: timpclass read fimp implements itest;
+  public
+   constructor create;
+   destructor destroy; override;
+ end;
+
+{ timpclass }
+
+function timpclass.test: longint;
+begin
+ writeln('test');
+ result:=123456;
+end;
+
+function timpclass._addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ result:= -1;
+end;
+
+function timpclass._release: integer;  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ result:= -1;
+end;
+
+function timpclass.QueryInterface(constref IID: TGUID; out Obj): HResult;  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ if GetInterface(IID, Obj) then begin
+   Result:=0
+ end
+ else begin
+  result:= integer(e_nointerface);
+ end;
+end;
+
+{ ttestclass }
+
+constructor ttestclass.create;
+begin
+ fimp:= timpclass.create;
+end;
+
+destructor ttestclass.destroy;
+begin
+ inherited;
+ fimp.free;
+end;
+
+var
+ testclass: ttestclass;
+begin
+ testclass:= ttestclass.create;
+ if itest(testclass).test<>123456 then  //<<<<---- AV
+   halt(1);
+ testclass.free;
+end.
+
+