paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-15 12:29:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Interface thunk class must query owner object interface list

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-07-11 17:47:03 +02:00
parent 1f981116f6
commit 517d1b017c
2 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/inc/objpas.inc
View File

@ -1241,6 +1241,19 @@ begin
FCallBack(Self,aMethod,aCount,aData);
end;
function TInterfaceThunk.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
result:=longint(E_NOINTERFACE);
if (TMethod(FCallBack).Data<>Nil) then
// Query the object that created us, this is normally TVirtualInterface
// Take care: do not call QueryInterface, that would create a never-ending loop !!
if TObject(TMethod(FCallBack).Data).GetInterface(iid,obj) then
result:=S_OK;
if (Result<>S_OK) then
Result:=Inherited QueryInterface(iid,obj);
end;
function TInterfaceThunk.InterfaceVMTOffset : word;
begin

3
rtl/inc/objpash.inc
View File

@ -356,6 +356,7 @@
Private
FCallback : TThunkCallback;
Protected
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
Procedure Thunk(aMethod: Longint; aCount : Longint; aData : PArgData); virtual;
Public
constructor create(aCallBack : TThunkCallback);
@ -623,4 +624,4 @@ Type
end;
operator =(Left, Right: TPtrWrapper) c : Boolean;
operator <>(Left, Right: TPtrWrapper) c : Boolean;
operator <>(Left, Right: TPtrWrapper) c : Boolean;