Browse Source

* since the property data is different for records, classes and interfaces they need to be handled by the concrete Rtti type (currently only TRttiInstanceType) and not the general TRttiType type

git-svn-id: trunk@37416 -
svenbarth 7 years ago
parent
commit
f8d919970a
1 changed files with 62 additions and 57 deletions
  1. 62 57
      packages/rtl-objpas/src/inc/rtti.pp

+ 62 - 57
packages/rtl-objpas/src/inc/rtti.pp

@@ -174,8 +174,6 @@ type
   TRttiType = class(TRttiNamedObject)
   TRttiType = class(TRttiNamedObject)
   private
   private
     FTypeInfo: PTypeInfo;
     FTypeInfo: PTypeInfo;
-    FPropertiesResolved: boolean;
-    FProperties: specialize TArray<TRttiProperty>;
     function GetAsInstance: TRttiInstanceType;
     function GetAsInstance: TRttiInstanceType;
   protected
   protected
     FTypeData: PTypeData;
     FTypeData: PTypeData;
@@ -191,9 +189,8 @@ type
     function GetBaseType: TRttiType; virtual;
     function GetBaseType: TRttiType; virtual;
   public
   public
     constructor create(ATypeInfo : PTypeInfo);
     constructor create(ATypeInfo : PTypeInfo);
-    function GetProperties: specialize TArray<TRttiProperty>;
+    function GetProperties: specialize TArray<TRttiProperty>; virtual;
     function GetProperty(const AName: string): TRttiProperty; virtual;
     function GetProperty(const AName: string): TRttiProperty; virtual;
-    destructor destroy; override;
     property IsInstance: boolean read GetIsInstance;
     property IsInstance: boolean read GetIsInstance;
     property isManaged: boolean read GetIsManaged;
     property isManaged: boolean read GetIsManaged;
     property IsOrdinal: boolean read GetIsOrdinal;
     property IsOrdinal: boolean read GetIsOrdinal;
@@ -278,6 +275,8 @@ type
 
 
   TRttiInstanceType = class(TRttiStructuredType)
   TRttiInstanceType = class(TRttiStructuredType)
   private
   private
+    FPropertiesResolved: Boolean;
+    FProperties: specialize TArray<TRttiProperty>;
     function GetDeclaringUnitName: string;
     function GetDeclaringUnitName: string;
     function GetMetaClassType: TClass;
     function GetMetaClassType: TClass;
   protected
   protected
@@ -285,6 +284,8 @@ type
     function GetTypeSize: integer; override;
     function GetTypeSize: integer; override;
     function GetBaseType: TRttiType; override;
     function GetBaseType: TRttiType; override;
   public
   public
+    destructor Destroy; override;
+    function GetProperties: specialize TArray<TRttiProperty>; override;
     property MetaClassType: TClass read GetMetaClassType;
     property MetaClassType: TClass read GetMetaClassType;
     property DeclaringUnitName: string read GetDeclaringUnitName;
     property DeclaringUnitName: string read GetDeclaringUnitName;
   end;
   end;
@@ -1615,6 +1616,62 @@ begin
   Result:=sizeof(TObject);
   Result:=sizeof(TObject);
 end;
 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;
+var
+  TypeInfo: PTypeInfo;
+  TypeRttiType: TRttiType;
+  TD: PTypeData;
+  PPD: PPropData;
+  TP: PPropInfo;
+  Count: longint;
+begin
+  if not FPropertiesResolved then
+    begin
+      TypeInfo := FTypeInfo;
+
+      // Get the total properties count
+      SetLength(FProperties,FTypeData^.PropCount);
+      // Clear list
+      FillChar(FProperties[0],FTypeData^.PropCount*sizeof(TRttiProperty),0);
+      TypeRttiType:= self;
+      repeat
+        TD:=GetTypeData(TypeInfo);
+
+        // published properties count for this object
+        // skip the attribute-info if available
+        PPD := aligntoptr(PPropData(pointer(@TD^.UnitName)+PByte(@TD^.UnitName)^+1));
+        Count:=PPD^.PropCount;
+        // Now point TP to first propinfo record.
+        TP:=PPropInfo(@PPD^.PropList);
+        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);
+
+            // Point to TP next propinfo record.
+            // Located at Name[Length(Name)+1] !
+            TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
+            Dec(Count);
+          end;
+        TypeInfo:=TD^.Parentinfo;
+        TypeRttiType:= GRttiPool.GetType(TypeInfo);
+      until TypeInfo=nil;
+    end;
+
+  result := FProperties;
+end;
+
 { TRttiMember }
 { TRttiMember }
 
 
 function TRttiMember.GetVisibility: TMemberVisibility;
 function TRttiMember.GetVisibility: TMemberVisibility;
@@ -1880,51 +1937,8 @@ begin
 end;
 end;
 
 
 function TRttiType.GetProperties: specialize TArray<TRttiProperty>;
 function TRttiType.GetProperties: specialize TArray<TRttiProperty>;
-type
-  PPropData = ^TPropData;
-var
-  TypeInfo: PTypeInfo;
-  TypeRttiType: TRttiType;
-  TD: PTypeData;
-  PPD: PPropData;
-  TP: PPropInfo;
-  Count: longint;
 begin
 begin
-  if not FPropertiesResolved then
-    begin
-      TypeInfo := FTypeInfo;
-
-      // Get the total properties count
-      SetLength(FProperties,FTypeData^.PropCount);
-      // Clear list
-      FillChar(FProperties[0],FTypeData^.PropCount*sizeof(TRttiProperty),0);
-      TypeRttiType:= self;
-      repeat
-        TD:=GetTypeData(TypeInfo);
-
-        // published properties count for this object
-        // skip the attribute-info if available
-        PPD := aligntoptr(PPropData(pointer(@TD^.UnitName)+PByte(@TD^.UnitName)^+1));
-        Count:=PPD^.PropCount;
-        // Now point TP to first propinfo record.
-        TP:=PPropInfo(@PPD^.PropList);
-        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);
-
-            // Point to TP next propinfo record.
-            // Located at Name[Length(Name)+1] !
-            TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
-            Dec(Count);
-          end;
-        TypeInfo:=TD^.Parentinfo;
-        TypeRttiType:= GRttiPool.GetType(TypeInfo);
-      until TypeInfo=nil;
-    end;
-
-  result := FProperties;
+  Result := Nil;
 end;
 end;
 
 
 function TRttiType.GetProperty(const AName: string): TRttiProperty;
 function TRttiType.GetProperty(const AName: string): TRttiProperty;
@@ -1942,15 +1956,6 @@ begin
       end;
       end;
 end;
 end;
 
 
-destructor TRttiType.Destroy;
-var
-  i: Integer;
-begin
-  for i := 0 to high(FProperties) do
-    FProperties[i].Free;
-  inherited destroy;
-end;
-
 { TRttiNamedObject }
 { TRttiNamedObject }
 
 
 function TRttiNamedObject.GetName: string;
 function TRttiNamedObject.GetName: string;