paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-07 03:58:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

JitClass: Allow looking up Interfaces via TObject.GetInterface

Browse Source
This commit is contained in:
Martin 2021-11-27 20:10:35 +01:00
parent 7114800c05
commit 818c1c82d8
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/jitclasses/jitclass.pas
View File

@ -336,6 +336,8 @@ type
implementation implementation
const EmptyIntf : array [0..3] of PtrUInt = (0,0,0,0); // Count ond Entries
function GetVMTSize(AClass: TClass): integer; function GetVMTSize(AClass: TClass): integer;
const const
MAX_VMT_SIZE = 100000; MAX_VMT_SIZE = 100000;
@ -1190,6 +1192,8 @@ begin
vmtIntfTable vmtIntfTable
vmtMsgStrPtr vmtMsgStrPtr
*) *)
FJitPVmt^.vIntfTable:=@EmptyIntf; // A nil pointer stops the recursion
// set vmtParent // set vmtParent
{$IFDEF HasVMTParent} {$IFDEF HasVMTParent}
FJitPVmt^.vParent:=AncestorVMT; FJitPVmt^.vParent:=AncestorVMT;