paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use new pool functionality for property instances

Browse Source 
* extended test

git-svn-id: trunk@37418 -
This commit is contained in:
svenbarth 2017-10-07 17:32:28 +00:00
parent 1cbb4266d7
commit d9bc656852
2 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -284,7 +284,6 @@ type
function GetTypeSize: integer; override;
function GetBaseType: TRttiType; override;
public
destructor Destroy; override;
function GetProperties: specialize TArray<TRttiProperty>; override;
property MetaClassType: TClass read GetMetaClassType;
property DeclaringUnitName: string read GetDeclaringUnitName;
@ -1671,14 +1670,6 @@ begin
Result:=sizeof(TObject);
end;
destructor TRttiInstanceType.Destroy;
var
i: Integer;
begin
for i := 0 to high(FProperties) do
FProperties[i].Free;
end;
function TRttiInstanceType.GetProperties: specialize TArray<TRttiProperty>;
type
PPropData = ^TPropData;
@ -1689,6 +1680,7 @@ var
PPD: PPropData;
TP: PPropInfo;
Count: longint;
obj: TRttiObject;
begin
if not FPropertiesResolved then
begin
@ -1711,8 +1703,15 @@ begin
While Count>0 do
begin
// Don't overwrite properties with the same name
if FProperties[TP^.NameIndex]=nil then
FProperties[TP^.NameIndex]:=TRttiProperty.Create(TypeRttiType, TP);
if FProperties[TP^.NameIndex]=nil then begin
obj := GRttiPool.GetByHandle(TP);
if Assigned(obj) then
FProperties[TP^.NameIndex] := obj as TRttiProperty
else begin
FProperties[TP^.NameIndex] := TRttiProperty.Create(TypeRttiType, TP);
GRttiPool.AddObject(FProperties[TP^.NameIndex]);
end;
end;
// Point to TP next propinfo record.
// Located at Name[Length(Name)+1] !

14
packages/rtl-objpas/tests/tests.rtti.pas
View File

@ -76,6 +76,10 @@ type
property PubPropSetRO: integer read FPubPropRO;
property PubPropSetRW: integer read FPubPropRW write FPubPropRW;
end;
TGetClassPropertiesSub = class(TGetClassProperties)
end;
{$M-}
{ TTestValueClass }
@ -864,7 +868,8 @@ procedure TTestCase1.GetClassProperties;
var
LContext: TRttiContext;
LType: TRttiType;
PropList: {$ifdef fpc}specialize{$endif} TArray<TRttiProperty>;
PropList, PropList2: {$ifdef fpc}specialize{$endif} TArray<TRttiProperty>;
i: LongInt;
begin
LContext := TRttiContext.Create;
@ -877,6 +882,13 @@ begin
CheckEquals('PubPropSetRO', PropList[2].Name);
CheckEquals('PubPropSetRW', PropList[3].Name);
LType := LContext.GetType(TypeInfo(TGetClassPropertiesSub));
PropList2 := LType.GetProperties;
CheckEquals(Length(PropList), Length(PropList2));
for i := 0 to High(PropList) do
Check(PropList[i] = PropList2[i], 'Property instances are not equal');
LContext.Free;
end;