* Patch from Henrique Werlang to add TRttiDynArray (Bug ID 0037761)

packages/rtl/rtti.pas

@@ -177,7 +177,11 @@ type
   public
     constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember);
     function GetValue(Instance: TObject): TValue;
-    procedure SetValue(Instance: TObject; const AValue: TValue);
+
+
+    procedure SetValue(Instance: TObject; const AValue: JSValue); overload;
+    procedure SetValue(Instance: TObject; const AValue: TValue); overload;
+
     property PropertyTypeInfo: TTypeMemberProperty read GetPropertyTypeInfo;
     property PropertyType: TRttiType read GetPropertyType;
     property IsReadable: boolean read GetIsReadable;
@@ -233,6 +237,8 @@ type
     //property TypeSize: integer read GetTypeSize;
   end;
 
+  TRttiTypeClass = class of TRttiType;
+
   { TRttiStructuredType }
 
   TRttiStructuredType = class abstract(TRttiType)
@@ -312,6 +318,20 @@ type
     generic class function GetValue<T>(const AValue: String): T;
   end;
 
+  { TRttiDynamicArrayType }
+
+  TRttiDynamicArrayType = class(TRttiType)
+  private
+    function GetDynArrayTypeInfo: TTypeInfoDynArray;
+    function GetElementType: TRttiType;
+  public
+    constructor Create(ATypeInfo: PTypeInfo);
+
+    property DynArrayTypeInfo: TTypeInfoDynArray read GetDynArrayTypeInfo;
+    property ElementType: TRttiType read GetElementType;
+  end;
+
+
   EInvoke = EJS;
 
   TVirtualInterfaceInvokeEvent = function(const aMethodName: string;
@@ -361,6 +381,26 @@ asm
   IntfVar.set(i);
 end;
 
+{ TRttiDynamicArrayType }
+
+function TRttiDynamicArrayType.GetDynArrayTypeInfo: TTypeInfoDynArray;
+begin
+  Result := TTypeInfoDynArray(FTypeInfo);
+end;
+
+function TRttiDynamicArrayType.GetElementType: TRttiType;
+begin
+  Result := GRttiContext.GetType(DynArrayTypeInfo.ElType);
+end;
+
+constructor TRttiDynamicArrayType.Create(ATypeInfo: PTypeInfo);
+begin
+  if not (TTypeInfo(ATypeInfo) is TTypeInfoDynArray) then
+    raise EInvalidCast.Create('');
+
+  inherited Create(ATypeInfo);
+end;
+
 { TRttiOrdinalType }
 
 function TRttiOrdinalType.GetMaxValue: Integer;
@@ -681,33 +721,25 @@ end;
 function TRttiStructuredType.GetMethods: TRttiMethodArray;
 var
   A, MethodCount: Integer;
-
   BaseClass: TRttiStructuredType;
 
 begin
   BaseClass := Self;
   MethodCount := 0;
-
   while Assigned(BaseClass) do
   begin
     Inc(MethodCount, BaseClass.StructTypeInfo.MethodCount);
-
     BaseClass := BaseClass.GetAncestor;
   end;
-
   SetLength(Result, StructTypeInfo.MethodCount);
-
   BaseClass := Self;
-
   while Assigned(BaseClass) do
   begin
     for A := 0 to Pred(BaseClass.StructTypeInfo.MethodCount) do
     begin
       Dec(MethodCount);
-
       Result[MethodCount] := TRttiMethod.Create(BaseClass, BaseClass.StructTypeInfo.GetMethod(A));
     end;
-
     BaseClass := BaseClass.GetAncestor;
   end;
 end;
@@ -715,23 +747,18 @@ end;
 function TRttiStructuredType.GetMethods(const aName: String): TRttiMethodArray;
 var
   Method: TRttiMethod;
-
   MethodCount: Integer;
 
 begin
   MethodCount := 0;
-
   for Method in GetMethods do
     if aName = Method.Name then
       Inc(MethodCount);
-
   SetLength(Result, MethodCount);
-
   for Method in GetMethods do
     if aName = Method.Name then
     begin
       Dec(MethodCount);
-
       Result[MethodCount] := Method;
     end;
 end;
@@ -748,25 +775,53 @@ end;
 
 function TRttiStructuredType.GetProperty(const AName: string): TRttiProperty;
 var
-  A: Integer;
+  A : Integer;
+  BaseClass : TRttiStructuredType;
 
 begin
-  Result := nil;
-
-  for A := 0 to Pred(StructTypeInfo.PropCount) do
-    if StructTypeInfo.GetProp(A).Name = AName then
-      Exit(TRttiProperty.Create(Self, StructTypeInfo.GetProp(A)));
+  BaseClass := Self;
+  while Assigned(BaseClass) do
+     begin
+     for A := 0 to Pred(BaseClass.StructTypeInfo.PropCount) do
+       if StructTypeInfo.GetProp(A).Name = AName then
+         Exit(TRttiProperty.Create(BaseClass, BaseClass.StructTypeInfo.GetProp(A)));
+     BaseClass:=BaseClass.GetAncestor;
+     end;
 end;
 
 function TRttiStructuredType.GetDeclaredProperties: TRttiPropertyArray;
 var
-  A: Integer;
+  A, PropertyCount: Integer;
+
+  BaseClass: TRttiStructuredType;
 
 begin
-  SetLength(Result, StructTypeInfo.PropCount);
+  BaseClass := Self;
+  PropertyCount := 0;
+
+  while Assigned(BaseClass) do
+  begin
+    Inc(PropertyCount, BaseClass.StructTypeInfo.PropCount);
+
+    BaseClass := BaseClass.GetAncestor;
+  end;
+
+  SetLength(Result, PropertyCount);
 
-  for A := 0 to Pred(StructTypeInfo.PropCount) do
-    Result[A] := TRttiProperty.Create(Self, StructTypeInfo.GetProp(A));
+  BaseClass := Self;
+  PropertyCount := 0;
+
+  while Assigned(BaseClass) do
+  begin
+    for A := 0 to Pred(BaseClass.StructTypeInfo.PropCount) do
+    begin
+      Result[PropertyCount] := TRttiProperty.Create(BaseClass, BaseClass.StructTypeInfo.GetProp(A));
+
+      Inc(PropertyCount);
+    end;
+
+    BaseClass := BaseClass.GetAncestor;
+  end;
 end;
 
 function TRttiStructuredType.GetStructTypeInfo: TTypeInfoStruct;
@@ -867,6 +922,29 @@ end;
 
 function TRTTIContext.GetType(aTypeInfo: PTypeInfo): TRTTIType;
 var
+  RttiTypeClass: array[TTypeKind] of TRttiTypeClass = (
+    nil, // tkUnknown
+    TRttiOrdinalType, // tkInteger
+    TRttiOrdinalType, // tkChar
+    TRttiType, // tkString
+    TRttiEnumerationType, // tkEnumeration
+    TRttiType, // tkSet
+    TRttiOrdinalType, // tkDouble
+    TRttiEnumerationType, // tkBool
+    TRttiType, // tkProcVar
+    nil, // tkMethod
+    TRttiType, // tkArray
+    TRttiDynamicArrayType, // tkDynArray
+    TRttiType, // tkRecord
+    TRttiInstanceType, // tkClass
+    TRttiType, // tkClassRef
+    TRttiType, // tkPointer
+    TRttiType, // tkJSValue
+    TRttiType, // tkRefToProcVar
+    TRttiInterfaceType, // tkInterface
+    TRttiType, // tkHelper
+    TRttiInstanceType // tkExtClass
+  );
   t: TTypeinfo absolute aTypeInfo;
   Name: String;
 begin
@@ -878,11 +956,7 @@ begin
     Result:=TRttiType(FPool[Name])
   else
     begin
-      case T.Kind of
-        tkClass: Result:=TRttiInstanceType.Create(aTypeInfo);
-        tkInterface: Result:=TRttiInterfaceType.Create(aTypeInfo);
-        else Result:=TRttiType.Create(aTypeInfo);
-      end;
+    Result := RttiTypeClass[T.Kind].Create(aTypeInfo);
 
     FPool[Name]:=Result;
     end;
@@ -1020,7 +1094,14 @@ begin
   SetJSValueProp(Instance, PropertyTypeInfo, AValue);
 end;
 
+
+procedure TRttiProperty.SetValue(Instance: TObject; const AValue: JSValue);
+begin
+  SetJSValueProp(Instance, PropertyTypeInfo, AValue);
+end;
+
 function TRttiProperty.GetPropertyType: TRttiType;
+
 begin
   Result := GRttiContext.GetType(PropertyTypeInfo.TypeInfo);
 end;