paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-18 07:06:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ test from mantis #16365, already works

Browse Source 
git-svn-id: trunk@16447 -
This commit is contained in:
Jonas Maebe 2010-11-26 14:38:15 +00:00
parent eec6d74ac0
commit 11399b9b13
2 changed files with 81 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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
tests/webtbs/tw16365.pp Normal file
View File

@ -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.