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

* Access VMT members using TVmt record instead of pointer manipulations.

Browse Source 
* Check FieldTable<>nil before dereferencing. It should be nil if class doesn't have published fields, but currently compiler always generates field table. This produces redundant data and isn't Delphi compatible, therefore it's subject to fix.
* Use ClassNameIs to check the class name instead of doing case-insensitive comparing manually.

git-svn-id: trunk@20305 -
This commit is contained in:
sergei 2012-02-11 10:16:50 +00:00
parent 57647f4521
commit 4b5c8bcac2
1 changed files with 25 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
rtl/objpas/classes/reader.inc
View File

@ -539,28 +539,30 @@ type
function GetFieldClass(Instance: TObject; const ClassName: string): TPersistentClass; function GetFieldClass(Instance: TObject; const ClassName: string): TPersistentClass;
var var
UClassName: String; ShortClassName: shortstring;
ClassType: TClass; ClassType: TClass;
ClassTable: PFieldClassTable; ClassTable: PFieldClassTable;
i: Integer; i: Integer;
{ FieldTable: PFieldTable; } FieldTable: PFieldTable;
begin begin
// At first, try to locate the class in the class tables // At first, try to locate the class in the class tables
UClassName := UpperCase(ClassName); ShortClassName := ClassName;
ClassType := Instance.ClassType; ClassType := Instance.ClassType;
while ClassType <> TPersistent do while ClassType <> TPersistent do
begin begin
{ FieldTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^); } FieldTable := PFieldTable(PVmt(ClassType)^.vFieldTable);
ClassTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^)^.ClassTable; if Assigned(FieldTable) then
if Assigned(ClassTable) then begin
ClassTable := FieldTable^.ClassTable;
for i := 0 to ClassTable^.Count - 1 do for i := 0 to ClassTable^.Count - 1 do
begin begin
Result := ClassTable^.Entries[i]; Result := ClassTable^.Entries[i];
if UpperCase(Result.ClassName) = UClassName then if Result.ClassNameIs(ShortClassName) then
exit; exit;
end; end;
// Try again with the parent class type end;
ClassType := ClassType.ClassParent; // Try again with the parent class type
ClassType := ClassType.ClassParent;
end; end;
Result := Classes.GetClass(ClassName); Result := Classes.GetClass(ClassName);
end; end;
@ -1638,10 +1640,11 @@ function TReader.FindComponentClass(const AClassName: String): TComponentClass;
var var
PersistentClass: TPersistentClass; PersistentClass: TPersistentClass;
UClassName: shortstring; ShortClassName: shortstring;
procedure FindInFieldTable(RootComponent: TComponent); procedure FindInFieldTable(RootComponent: TComponent);
var var
FieldTable: PFieldTable;
FieldClassTable: PFieldClassTable; FieldClassTable: PFieldClassTable;
Entry: TPersistentClass; Entry: TPersistentClass;
i: Integer; i: Integer;
@ -1651,16 +1654,20 @@ var
// it is not necessary to look in the FieldTable of TComponent, // it is not necessary to look in the FieldTable of TComponent,
// because TComponent doesn't have published properties that are // because TComponent doesn't have published properties that are
// descendants of TComponent // descendants of TComponent
while ComponentClassType<>TComponent do begin while ComponentClassType<>TComponent do
FieldClassTable := begin
PFieldTable((Pointer(ComponentClassType)+vmtFieldTable)^)^.ClassTable; FieldTable:=PVmt(ComponentClassType)^.vFieldTable;
if assigned(FieldClassTable) then begin if assigned(FieldTable) then
for i := 0 to FieldClassTable^.Count -1 do begin begin
FieldClassTable := FieldTable^.ClassTable;
for i := 0 to FieldClassTable^.Count -1 do
begin
Entry := FieldClassTable^.Entries[i]; Entry := FieldClassTable^.Entries[i];
//writeln(format('Looking for %s in field table of class %s. Found %s', //writeln(format('Looking for %s in field table of class %s. Found %s',
//[AClassName, ComponentClassType.ClassName, Entry.ClassName])); //[AClassName, ComponentClassType.ClassName, Entry.ClassName]));
if (UpperCase(Entry.ClassName)=UClassName) and if Entry.ClassNameIs(ShortClassName) and
(Entry.InheritsFrom(TComponent)) then begin (Entry.InheritsFrom(TComponent)) then
begin
Result := TComponentClass(Entry); Result := TComponentClass(Entry);
Exit; Exit;
end; end;
@ -1673,7 +1680,7 @@ var
begin begin
Result := nil; Result := nil;
UClassName:=UpperCase(AClassName); ShortClassName:=AClassName;
FindInFieldTable(Root); FindInFieldTable(Root);
if (Result=nil) and assigned(LookupRoot) and (LookupRoot<>Root) then if (Result=nil) and assigned(LookupRoot) and (LookupRoot<>Root) then