paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-22 20:59:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix for virtual interface when the class inherited from this class as an interface type in the implementation.

Browse Source
This commit is contained in:
Henrique Gottardi Werlang 2024-08-07 08:21:12 -03:00 committed by Michael Van Canneyt
parent 596ed58822
commit 22504d1d60
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/rtl/src/rtti.pas
View File

@ -2178,6 +2178,8 @@ end;
{ TVirtualInterface }
constructor TVirtualInterface.Create(PIID: PTypeInfo);
var
InterfaceMaps: TJSObject;
function Jump(MethodName: String): JSValue;
begin
@ -2197,15 +2199,12 @@ constructor TVirtualInterface.Create(PIID: PTypeInfo);
while Assigned(InterfaceInfo) do
begin
if InterfaceInfo = TypeInfo(IInterface) then
begin
Result['_AddRef'] := @_AddRef;
Result['_Release'] := @_Release;
Result['QueryInterface'] := @QueryInterface;
end
if InterfaceMaps[InterfaceInfo.InterfaceInfo.GUID] = nil then
for MethodName in InterfaceInfo.Names do
Result[MethodName] := Jump(MethodName)
else
for MethodName in InterfaceInfo.Names do
Result[MethodName] := Jump(MethodName);
Result[MethodName] := TJSObject(InterfaceMaps[InterfaceInfo.InterfaceInfo.GUID])[MethodName];
InterfaceInfo := InterfaceInfo.Ancestor;
end;
@ -2213,16 +2212,15 @@ constructor TVirtualInterface.Create(PIID: PTypeInfo);
var
InterfaceInfo: TTypeInfoInterface;
InterfaceMaps: TJSObject;
begin
FContext := TRttiContext.Create;
InterfaceMaps := TJSObject.New;
FInterfaceType := FContext.GetType(PIID) as TRttiInterfaceType;
if Assigned(FInterfaceType) then
begin
InterfaceInfo := FInterfaceType.InterfaceTypeInfo;
InterfaceMaps := TJSObject.Create(TJSObject(JSThis['$intfmaps']));
while Assigned(InterfaceInfo) do
begin