paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 09:59:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Silvio Clecio to adapt to new VMT methods (bug ID 30435)

Browse Source 
git-svn-id: trunk@34471 -
This commit is contained in:
michael 2016-09-09 12:29:06 +00:00
parent 556b0fb837
commit 9e6077bee2
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/fcl-fpcunit/src/testutils.pp
View File

@ -67,7 +67,7 @@ type
PMethodNameRec = ^TMethodNameRec; PMethodNameRec = ^TMethodNameRec;
TMethodNameRec = packed record TMethodNameRec = packed record
name : pshortstring; name : pshortstring;
addr : pointer; addr : codepointer;
end; end;
TMethodNameTable = packed record TMethodNameTable = packed record
@ -80,15 +80,15 @@ type
var var
methodTable : pMethodNameTable; methodTable : pMethodNameTable;
i : dword; i : dword;
vmt: TClass; vmt: PVmt;
idx: integer; idx: integer;
pmr: PMethodNameRec; pmr: PMethodNameRec;
begin begin
AList.Clear; AList.Clear;
vmt := aClass; vmt := PVmt(aClass);
while assigned(vmt) do while assigned(vmt) do
begin begin
methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^); methodTable := pMethodNameTable(vmt^.vMethodTable);
if assigned(MethodTable) then if assigned(MethodTable) then
begin begin
pmr := @methodTable^.entries[0]; pmr := @methodTable^.entries[0];
@ -102,7 +102,7 @@ begin
Inc(pmr); Inc(pmr);
end; end;
end; end;
vmt := pClass(pointer(vmt) + vmtParent)^; vmt := vmt^.vParent;
end; end;
end; end;