* use new pool functionality for property instances

* extended test

git-svn-id: trunk@37418 -

packages/rtl-objpas/src/inc/rtti.pp

@@ -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] !

packages/rtl-objpas/tests/tests.rtti.pas

@@ -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;