paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 14:47:17 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ add data record for easier access to a class' data

Browse Source 
git-svn-id: trunk@37420 -
This commit is contained in:
svenbarth 2017-10-07 21:40:42 +00:00
parent 3d3298f64d
commit 1ae344394a
1 changed files with 35 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/objpas/typinfo.pp
View File

@ -426,6 +426,26 @@ unit typinfo;
{ PropertyTable: TPropData }
end;
PClassData = ^TClassData;
TClassData =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
private
function GetUnitName: ShortString; inline;
function GetPropertyTable: PPropData; inline;
public
ClassType : TClass;
Parent : PPTypeInfo;
PropCount : SmallInt;
property UnitName: ShortString read GetUnitName;
property PropertyTable: PPropData read GetPropertyTable;
private
UnitNameField : ShortString;
{ PropertyTable: TPropData }
end;
PTypeData = ^TTypeData;
TTypeData =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@ -2851,6 +2871,21 @@ begin
Result := aligntoptr(PropertyTable^.Tail);
end;
{ TClassData }
function TClassData.GetUnitName: ShortString;
begin
Result := UnitNameField;
end;
function TClassData.GetPropertyTable: PPropData;
var
p: PByte;
begin
p := PByte(@UnitNameField[0]) + SizeOf(UnitNameField[0]) + Length(UnitNameField);
Result := AlignTypeData(p);
end;
{ TTypeData }
function TTypeData.GetBaseType: PTypeInfo;