View Issue Details

IDProjectCategoryView StatusLast Update
0038570pas2jsrtlpublic2021-03-02 14:57
Reporterhenrique Assigned ToMattias Gaertner  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformPas2JsOSWindows 
Summary0038570: Declared fields in RTTI
DescriptionI made the implementation in RTTI to search for the declared fields of a type.

You can close bug 0038457 that the change is here.
TagsNo tags attached.
Fixed in Revision1093.
Attached Files

Activities

henrique

2021-03-02 14:16

reporter  

0001-Implementa-o-para-pegar-os-fields-declarados.patch (4,722 bytes)   
From 683a3cf837c780b9d63f53c2c314ce7db2990316 Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Tue, 2 Mar 2021 10:10:24 -0300
Subject: [PATCH] =?UTF-8?q?Implementa=C3=A7=C3=A3o=20para=20pegar=20os=20f?=
 =?UTF-8?q?ields=20declarados.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 packages/rtl/rtti.pas | 100 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 96 insertions(+), 4 deletions(-)

diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas
index 6f8088c..72d3714 100644
--- a/packages/rtl/rtti.pas
+++ b/packages/rtl/rtti.pas
@@ -135,12 +135,15 @@ type
   TRttiField = class(TRttiMember)
   private
     function GetFieldType: TRttiType;
+    function GetFieldTypeInfo: TTypeMemberField;
   public
+    constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember);
+    function GetValue(Instance: JSValue): TValue;
+    procedure SetValue(Instance: JSValue; const AValue: TValue);
     property FieldType: TRttiType read GetFieldType;
-    //function GetValue(Instance: Pointer): TValue;
-    //procedure SetValue(Instance: Pointer; const AValue: TValue);
-    //function ToString: string; override;
+    property FieldTypeInfo: TTypeMemberField read GetFieldTypeInfo;
   end;
+
   TRttiFieldArray = specialize TArray<TRttiField>;
 
   TRttiParameter = class(TRttiNamedObject)
@@ -240,6 +243,7 @@ type
     destructor Destroy; override;
     function GetAttributes: TCustomAttributeArray; override;
     function GetField(const AName: string): TRttiField; virtual;
+    function GetFields: TRttiFieldArray; virtual;
     function GetMethods: TRttiMethodArray; virtual;
     function GetMethods(const aName: String): TRttiMethodArray; virtual;
     function GetMethod(const aName: String): TRttiMethod; virtual;
@@ -294,6 +298,8 @@ type
 
   TRttiInstanceType = class(TRttiStructuredType)
   private
+    FFields: TRttiFieldArray;
+
     function GetClassTypeInfo: TTypeInfoClass;
     function GetMetaClassType: TClass;
   protected
@@ -301,6 +307,9 @@ type
   public
     constructor Create(ATypeInfo: PTypeInfo);
 
+    function GetFields: TRttiFieldArray; override;
+    function GetDeclaredFields: TRttiFieldArray; override;
+
     property ClassTypeInfo: TTypeInfoClass read GetClassTypeInfo;
     property MetaClassType: TClass read GetMetaClassType;
   end;
@@ -988,6 +997,50 @@ begin
   inherited Create(ATypeInfo);
 end;
 
+function TRttiInstanceType.GetDeclaredFields: TRttiFieldArray;
+var
+  A, FieldCount: Integer;
+
+begin
+  if not Assigned(FFields) then
+  begin
+    FieldCount := StructTypeInfo.FieldCount;
+
+    SetLength(FFields, FieldCount);
+
+    for A := 0 to Pred(FieldCount) do
+      FFields[A] := TRttiField.Create(Self, StructTypeInfo.GetField(A));
+  end;
+
+  Result := FFields;
+end;
+
+function TRttiInstanceType.GetFields: TRttiFieldArray;
+var
+  A, Start: Integer;
+
+  BaseClass: TRttiStructuredType;
+
+  Declared: TRttiFieldArray;
+
+begin
+  BaseClass := Self;
+  Result := nil;
+
+  while Assigned(BaseClass) do
+  begin
+    Declared := BaseClass.GetDeclaredFields;
+    Start := Length(Result);
+
+    SetLength(Result, Start + Length(Declared));
+
+    for A := Low(Declared) to High(Declared) do
+      Result[Start + A] := Declared[A];
+
+    BaseClass := BaseClass.GetAncestor;
+  end;
+end;
+
 { TRttiInterfaceType }
 
 constructor TRttiInterfaceType.Create(ATypeInfo: PTypeInfo);
@@ -1184,11 +1237,40 @@ end;
 
 { TRttiField }
 
+constructor TRttiField.Create(AParent: TRttiType; ATypeInfo: TTypeMember);
+begin
+  if not (ATypeInfo is TTypeMemberField) then
+    raise EInvalidCast.Create('');
+
+  inherited;
+end;
+
 function TRttiField.GetFieldType: TRttiType;
 begin
   Result := GRttiContext.GetType(FTypeInfo);
 end;
 
+function TRttiField.GetFieldTypeInfo: TTypeMemberField;
+begin
+  Result := TTypeMemberField(FTypeInfo);
+end;
+
+function TRttiField.GetValue(Instance: JSValue): TValue;
+var
+  JSInstance: TJSObject absolute Instance;
+
+begin
+  Result := TValue.FromJSValue(JSInstance[Name]);
+end;
+
+procedure TRttiField.SetValue(Instance: JSValue; const AValue: TValue);
+var
+  JSInstance: TJSObject absolute Instance;
+
+begin
+  JSInstance[Name] := AValue.AsJSValue;
+end;
+
 { TRttiParameter }
 
 function TRttiParameter.GetName: String;
@@ -1442,9 +1524,19 @@ begin
 end;
 
 function TRttiType.GetField(const AName: string): TRttiField;
+var
+  AField: TRttiField;
+
 begin
   Result:=nil;
-  if AName='' then ;
+  for AField in GetFields do
+    if AField.Name = AName then
+      Exit(AField);
+end;
+
+function TRttiType.GetFields: TRttiFieldArray;
+begin
+  Result := nil;
 end;
 
 { TVirtualInterface }
-- 
2.30.0.windows.1

Issue History

Date Modified Username Field Change
2021-03-02 14:16 henrique New Issue
2021-03-02 14:16 henrique File Added: 0001-Implementa-o-para-pegar-os-fields-declarados.patch
2021-03-02 14:29 Michael Van Canneyt Assigned To => Mattias Gaertner
2021-03-02 14:29 Michael Van Canneyt Status new => assigned
2021-03-02 14:57 Mattias Gaertner Status assigned => resolved
2021-03-02 14:57 Mattias Gaertner Resolution open => fixed
2021-03-02 14:57 Mattias Gaertner Fixed in Revision => 1093.