diff --git a/.gitattributes b/.gitattributes index 7886ecbc77..598ccbbfd1 100644 --- a/.gitattributes +++ b/.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 diff --git a/tests/webtbs/tw16365.pp b/tests/webtbs/tw16365.pp new file mode 100644 index 0000000000..cb9164b2bb --- /dev/null +++ b/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. + +