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

* fcl-fpcunit/src/testutils.pp, GetMethodList: avoid range errors at runtime if compiled with -Cr.

Browse Source 
git-svn-id: trunk@20646 -
This commit is contained in:
sergei 2012-03-28 10:55:17 +00:00
parent bab72f0025
commit 8b40abdd19
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -64,6 +64,7 @@ end;
procedure GetMethodList(AClass: TClass; AList: TStrings); procedure GetMethodList(AClass: TClass; AList: TStrings);
type type
PMethodNameRec = ^TMethodNameRec;
TMethodNameRec = packed record TMethodNameRec = packed record
name : pshortstring; name : pshortstring;
addr : pointer; addr : pointer;
@ -81,6 +82,7 @@ var
i : dword; i : dword;
vmt: TClass; vmt: TClass;
idx: integer; idx: integer;
pmr: PMethodNameRec;
begin begin
AList.Clear; AList.Clear;
vmt := aClass; vmt := aClass;
@ -89,13 +91,15 @@ begin
methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^); methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
if assigned(MethodTable) then if assigned(MethodTable) then
begin begin
pmr := @methodTable^.entries[0];
for i := 0 to MethodTable^.count - 1 do for i := 0 to MethodTable^.count - 1 do
begin begin
idx := aList.IndexOf(MethodTable^.entries[i].name^); idx := aList.IndexOf(pmr^.name^);
if (idx <> - 1) then if (idx <> - 1) then
//found overridden method so delete it //found overridden method so delete it
aList.Delete(idx); aList.Delete(idx);
aList.AddObject(MethodTable^.entries[i].name^, TObject(MethodTable^.entries[i].addr)); aList.AddObject(pmr^.name^, TObject(pmr^.addr));
Inc(pmr);
end; end;
end; end;
vmt := pClass(pointer(vmt) + vmtParent)^; vmt := pClass(pointer(vmt) + vmtParent)^;