View Issue Details

IDProjectCategoryView StatusLast Update
0036358FPCPatchpublic2020-01-15 14:47
ReporterImants Gulbis Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0036358: Rtti unit properties do not process object, interface and float properties
DescriptionI attached patch for support of objects, interfaces and float numbers in TRttiProperty class
TagsNo tags attached.
Fixed in Revision43777,43778,43779,43780
FPCOldBugId
FPCTarget-
Attached Files

Activities

Imants Gulbis

2019-11-25 15:33

reporter  

rtti.pp.patch (3,299 bytes)   
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43584)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -160,7 +160,8 @@
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
-    class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: Boolean): TValue; inline;  
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -2270,6 +2271,11 @@
 class operator TValue.:=(AValue: Boolean): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
+end;   
+
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
 
@@ -3865,6 +3871,15 @@
   i: int64;
   c: Char;
   wc: WideChar;
+  o: TObject;
+  intf: IInterface;
+  Float: record
+    S: Single;
+    D: Double;
+    E: Extended;
+    C: Currency;
+    Co: Comp;
+  end;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
@@ -3903,6 +3918,46 @@
         i := GetOrdProp(TObject(Instance), FPropInfo);
         TValue.Make(@i, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      o := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@o, FPropInfo^.PropType, Result);
+    end;
+    tkInterface: 
+    begin
+      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@intf, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
+            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
+          end;
+        ftSingle :
+          begin
+            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
+          end;
+      end;
+    end;
   else
     result := TValue.Empty;
   end
@@ -3921,6 +3976,12 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:       
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
rtti.pp.patch (3,299 bytes)   

Sven Barth

2019-11-26 00:11

manager   ~0119500

Is there a reason why you used a record for the float values?

Imants Gulbis

2019-11-26 06:58

reporter   ~0119503

I like to group together values with similar meaning. It increase code readability and it is possible to use same variable names for other groups. Considering that variable name was one letter and they all where floats I did that. Other than that it has no other meaning.

Imants Gulbis

2019-11-26 15:14

reporter   ~0119509

I added support of setting and getting dynamic array properties in 2_rtti.pp.patch
2_rtti.pp.patch (4,290 bytes)   
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43592)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -138,7 +138,8 @@
     function AsInteger: Integer;
     function AsInt64: Int64;
     function AsUInt64: QWord;
-    function AsInterface: IInterface;
+    function AsInterface: IInterface;   
+    function AsDynArray: Pointer;
     function ToString: String;
     function GetArrayLength: SizeInt;
     function GetArrayElement(AIndex: SizeInt): TValue;
@@ -163,7 +164,8 @@
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
-    class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: Boolean): TValue; inline;  
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -1982,6 +1984,14 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsDynArray: Pointer;
+begin
+  if Kind = tkDynArray then
+    Result := PPointer(FData.FValueData.GetReferenceToRawData)^
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInterface: IInterface;
 begin
   if Kind = tkInterface then
@@ -2280,6 +2290,11 @@
 class operator TValue.:=(AValue: Boolean): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
+end;   
+
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
 
@@ -3875,6 +3890,16 @@
   i: int64;
   c: Char;
   wc: WideChar;
+  o: TObject;
+  intf: IInterface;
+  Float: record
+    S: Single;
+    D: Double;
+    E: Extended;
+    C: Currency;
+    Co: Comp;
+  end;
+  A: Pointer;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
@@ -3913,6 +3938,51 @@
         i := GetOrdProp(TObject(Instance), FPropInfo);
         TValue.Make(@i, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      o := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@o, FPropInfo^.PropType, Result);
+    end;
+    tkInterface: 
+    begin
+      intf := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@intf, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            Float.C := GetFloatProp(TObject(Instance), FPropInfo);   
+            TValue.Make(@Float.C, FPropInfo^.PropType, Result);
+          end;
+        ftSingle :
+          begin
+            Float.S := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.S, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            Float.D := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.D, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            Float.E := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.E, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            Float.Co := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Float.Co, FPropInfo^.PropType, Result);
+          end;
+      end;
+    end;
+    tkDynArray:
+      begin
+        A := GetDynArrayProp(TObject(Instance), FPropInfo);
+        TValue.Make(@A, FPropInfo^.PropType, Result);
+      end
   else
     result := TValue.Empty;
   end
@@ -3931,6 +4001,14 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:       
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
+    tkDynArray:
+      SetDynArrayProp(TObject(Instance), FPropInfo, AValue.AsDynArray);
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
2_rtti.pp.patch (4,290 bytes)   

Sven Barth

2019-11-30 13:09

manager   ~0119558

Then I'd suggest you to use a variant record so that the amount of stack space that is required is reduced (all other non-managed variables could be moved in there as well). Due to the pointer being passed to TValue.Make the compiler can't optimize the stack space (I don't know if it even could do that otherwise, at least not currently...).

Also you need to pay attention to targets where Comp and/or Currency is Int64 (e.g. Win64). I currently don't know whether in that case GetInt64Prop should be used (that would need to be tested), but you can check for that case with FPC_CURRENCY_IS_INT64 and FPC_COMP_IS_INT64.

Additionally I'd ask you to extend the testsuite in packages/rtl-objpas/tests/tests.rtti.pas so that we can make sure that your added code works correctly and keeps working correctly.

Imants Gulbis

2019-12-12 12:22

reporter   ~0119782

I tried to use variant but for managed types and single type it did not work as I expected so I left there variables and I updated tests. I ran them only on 64 bit ubuntu.
3_rtti.pp.patch (14,913 bytes)   
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43639)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -135,14 +135,19 @@
     function AsOrdinal: Int64;
     function AsBoolean: boolean;
     function AsCurrency: Currency;
-    function AsInteger: Integer;
+    function AsInteger: Integer;    
+    function AsEnumeration: Int64;
     function AsInt64: Int64;
     function AsUInt64: QWord;
-    function AsInterface: IInterface;
+    function AsInterface: IInterface;   
+    function AsDynArray: Pointer;
     function ToString: String;
     function GetArrayLength: SizeInt;
     function GetArrayElement(AIndex: SizeInt): TValue;
+    function GetArrayDimensions: Integer;
     procedure SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
+    procedure SetArrayLength(Dimensions: SizeInt; Sizes: array of SizeInt);
+    procedure SetArrayLength(Sizes: SizeInt); inline;
     function IsType(ATypeInfo: PTypeInfo): boolean; inline;
 {$ifndef NoGenericMethods}
     generic function IsType<T>: Boolean; inline;
@@ -158,12 +163,14 @@
 {$ifdef FPC_HAS_TYPE_EXTENDED}
     class operator := (AValue: Extended): TValue; inline;
 {$endif}
-    class operator := (AValue: Currency): TValue; inline;
+    class operator := (AValue: Currency): TValue; inline;  
+    class operator := (AValue: Comp): TValue; inline;
     class operator := (AValue: Int64): TValue; inline;
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
-    class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: Boolean): TValue; inline;  
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -617,6 +624,7 @@
 {$ifdef unix}
   BaseUnix,
 {$endif}
+  Variants,
   fgl;
 
 function AlignToPtr(aPtr: Pointer): Pointer; inline;
@@ -793,6 +801,7 @@
   SErrVirtIntfMethodNil = 'Method %1:d of ''%0:s'' is Nil';
   SErrVirtIntfCreateVmt = 'Failed to create VMT for ''%s''';
   SErrVirtIntfIInterface = 'Failed to prepare IInterface method callbacks';
+  SErrCanotChangeSize = 'Only dynamic array can change length!';
 
 var
   PoolRefCount : integer;
@@ -1944,6 +1953,23 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsEnumeration: Int64;
+begin
+  if Kind in [tkEnumeration] then
+    case TypeData^.OrdType of
+      otSByte:  Result := FData.FAsSByte;
+      otUByte:  Result := FData.FAsUByte;
+      otSWord:  Result := FData.FAsSWord;
+      otUWord:  Result := FData.FAsUWord;
+      otSLong:  Result := FData.FAsSLong;
+      otULong:  Result := FData.FAsULong;
+      otSQWord: Result := FData.FAsSInt64;
+      otUQWord: Result := FData.FAsUInt64;
+    end
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInt64: Int64;
 begin
   if Kind in [tkInteger, tkInt64, tkQWord] then
@@ -1957,6 +1983,8 @@
       otSQWord: Result := FData.FAsSInt64;
       otUQWord: Result := FData.FAsUInt64;
     end
+  else if (Kind = tkChar) then
+    Result := FData.FAsUByte
   else if (Kind = tkFloat) and (TypeData^.FloatType = ftComp) then
     Result := Int64(FData.FAsComp)
   else
@@ -1982,6 +2010,14 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsDynArray: Pointer;
+begin
+  if Kind = tkDynArray then
+    Result := PPointer(FData.FValueData.GetReferenceToRawData)^
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInterface: IInterface;
 begin
   if Kind = tkInterface then
@@ -2006,6 +2042,7 @@
     tkPointer : result := '(pointer @ ' + HexStr(FData.FAsPointer) + ')';
     tkInterface : result := '(interface @ ' + HexStr(PPointer(FData.FValueData.GetReferenceToRawData)^) + ')';
     tkInterfaceRaw : result := '(raw interface @ ' + HexStr(FData.FAsPointer) + ')';
+    tkEnumeration: Result := GetEnumName(TypeInfo, Ord(AsEnumeration));
   else
     result := '';
   end;
@@ -2014,12 +2051,23 @@
 function TValue.GetArrayLength: SizeInt;
 var
   td: PTypeData;
+  Bounds: TBoundArray;
+  Size: SizeInt;
+  Total: SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
-  if Kind = tkDynArray then
-    Result := DynArraySize(PPointer(FData.FValueData.GetReferenceToRawData)^)
-  else begin
+  if Kind = tkDynArray then begin
+    if GetArrayDimensions > 1 then
+    begin
+      Bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      Total := 1;
+      for Size in Bounds do
+        Total *= (Size + 1);
+      Result := Total;
+    end else
+      Result := DynArraySize(PPointer(FData.FValueData.GetReferenceToRawData)^)
+  end else begin
     td := TypeData;
     if (td^.ArrayData.Size = 0) and (td^.ArrayData.ElCount = 0) then
       Result := FData.FArrLength
@@ -2034,12 +2082,45 @@
   eltype: PTypeInfo;
   elsize: SizeInt;
   td: PTypeData;
+  index, elements, i, j, last: Integer;
+  bounds: TBoundArray;
+  indices: array of SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
   if Kind = tkDynArray then begin
-    data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
-    eltype := TypeData^.elType2;
+    if GetArrayDimensions > 1 then
+    begin
+      bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      for i := Low(bounds) to High(bounds) do
+        bounds[i] := bounds[i] + 1;
+
+      indices := [];
+      SetLength(indices, Length(bounds));  
+      index := AIndex;
+      last := High(bounds);
+      for i := Low(indices) to High(indices) - 1 do
+      begin
+        elements := 1;
+        for j := High(bounds) downto i + 1 do
+          elements *= bounds[j];
+
+        indices[i] := index div elements;
+        index := index mod elements;
+      end;
+
+      indices[last] := index mod bounds[last];
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, indices, FData.FTypeInfo);
+
+      eltype := TypeData^.elType2;
+      while eltype^.Kind = tkDynArray do
+        eltype := GetTypeData(eltype)^.ElType2;
+    end
+    else
+    begin
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
+      eltype := TypeData^.elType2;
+    end;
   end else begin
     td := TypeData;
     eltype := td^.ArrayData.ElType;
@@ -2057,6 +2138,33 @@
   Make(data, eltype, Result);
 end;
 
+function TValue.GetArrayDimensions: Integer;
+begin
+  if not IsArray then
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+
+  if Kind = tkDynArray then
+    Result := DynArrayDim(FData.FTypeInfo)
+  else
+    Result := GetTypeData(FData.FTypeInfo)^.ArrayData.DimCount
+end;
+
+procedure TValue.SetArrayLength(Dimensions: SizeInt; Sizes: array of SizeInt);
+begin
+  if not IsArray then
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+
+  if Kind = tkDynArray then
+    DynArraySetLength(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo, Dimensions, @Sizes[0])
+  else
+    raise EInvalidOpException.Create(SErrCanotChangeSize);
+end;   
+
+procedure TValue.SetArrayLength(Sizes: SizeInt);
+begin
+  SetArrayLength(1, [Sizes])
+end;
+
 procedure TValue.SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
 var
   data: Pointer;
@@ -2063,12 +2171,45 @@
   eltype: PTypeInfo;
   elsize: SizeInt;
   td, tdv: PTypeData;
+  index, elements, i, j, last: Integer;
+  bounds: TBoundArray;
+  indices: array of SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
   if Kind = tkDynArray then begin
-    data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
-    eltype := TypeData^.elType2;
+    if GetArrayDimensions > 1 then
+    begin
+      bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      for i := Low(bounds) to High(bounds) do
+        bounds[i] := bounds[i] + 1;
+
+      indices := [];
+      SetLength(indices, Length(bounds));
+      index := AIndex;
+      last := High(bounds);
+      for i := Low(indices) to High(indices) - 1 do
+      begin
+        elements := 1;
+        for j := High(bounds) downto i + 1 do
+          elements *= bounds[j];
+
+        indices[i] := index div elements;
+        index := index mod elements;
+      end;
+
+      indices[last] := index mod bounds[last];
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, indices, FData.FTypeInfo);
+
+      eltype := TypeData^.elType2;
+      while eltype^.Kind = tkDynArray do
+        eltype := GetTypeData(eltype)^.ElType2;
+    end
+    else
+    begin
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
+      eltype := TypeData^.elType2;
+    end;
   end else begin
     td := TypeData;
     eltype := td^.ArrayData.ElType;
@@ -2257,6 +2398,11 @@
   Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
+class operator TValue.:= (AValue: Comp): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
+end;
+
 class operator TValue.:=(AValue: Int64): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
@@ -2280,9 +2426,13 @@
 class operator TValue.:=(AValue: Boolean): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
+end;   
+
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
-
 function Invoke(aCodeAddress: CodePointer; const aArgs: TValueArray;
   aCallConv: TCallConv; aResultType: PTypeInfo; aIsStatic: Boolean;
   aIsConstructor: Boolean): TValue;
@@ -3870,16 +4020,19 @@
   end;
 
 var
-  s: string;
+  V: Variant;
+  s: String;
   ss: ShortString;
-  i: int64;
-  c: Char;
-  wc: WideChar;
+  C: Comp;
+  E: Extended;
+  O: TObject;
+  A: Pointer;
+  Si: Single;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
       begin
-        ss := GetStrProp(TObject(Instance), FPropInfo);
+        ss := ShortString(GetStrProp(TObject(Instance), FPropInfo));
         TValue.Make(@ss, FPropInfo^.PropType, result);
       end;
     tkAString:
@@ -3886,33 +4039,94 @@
       begin
         s := GetStrProp(TObject(Instance), FPropInfo);
         TValue.Make(@s, FPropInfo^.PropType, result);
+      end;   
+    tkEnumeration:
+      begin
+        V := Integer(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@TVarData(V).vinteger, FPropInfo^.PropType, result);
       end;
     tkBool:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        ValueFromBool(i);
+        V := GetOrdProp(TObject(Instance), FPropInfo);
+        ValueFromBool(TVarData(V).vint64);
       end;
     tkInteger:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        ValueFromInt(i);
+        V := GetOrdProp(TObject(Instance), FPropInfo);
+        ValueFromInt(TVarData(V).vint64);
       end;
     tkChar:
       begin
-        c := AnsiChar(GetOrdProp(TObject(Instance), FPropInfo));
-        TValue.Make(@c, FPropInfo^.PropType, result);
+        V := Byte(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@TVarData(V).vbyte, FPropInfo^.PropType, result);
       end;
     tkWChar:
       begin
-        wc := WideChar(GetOrdProp(TObject(Instance), FPropInfo));
-        TValue.Make(@wc, FPropInfo^.PropType, result);
+        V := Word(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@TVarData(V).vword, FPropInfo^.PropType, result);
       end;
     tkInt64,
     tkQWord:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        TValue.Make(@i, FPropInfo^.PropType, result);
+        V := GetOrdProp(TObject(Instance), FPropInfo);
+        TValue.Make(@TVarData(V).vint64, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      O := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@O, FPropInfo^.PropType, Result);
+    end;
+    tkInterface: 
+    begin
+      V := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@TVarData(V).vunknown, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            {$IfDef FPC_CURRENCY_IS_INT64}
+              V := Currency(GetOrdProp(TObject(Instance), FPropInfo));
+              TValue.Make(@TVarData(V).vcurrency, FPropInfo^.PropType, Result);
+            {$Else}
+              V := Currency(GetFloatProp(TObject(Instance), FPropInfo));
+              TValue.Make(@TVarData(V).vcurrency, FPropInfo^.PropType, Result);
+            {$EndIf}
+          end;
+        ftSingle :
+          begin
+            //V := Single() makes variant of double nos single
+            Si := Single(GetFloatProp(TObject(Instance), FPropInfo));
+            TValue.Make(@Si, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            V := Double(GetFloatProp(TObject(Instance), FPropInfo));
+            TValue.Make(@TVarData(V).vdouble, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            E := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@E, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            {$IfDef FPC_COMP_IS_INT64}
+            C := Comp(GetOrdProp(TObject(Instance), FPropInfo));
+            TValue.Make(@C, FPropInfo^.PropType, Result);
+            {$Else}
+            C := Comp(GetFloatProp(TObject(Instance), FPropInfo));
+            TValue.Make(@C, FPropInfo^.PropType, Result);
+            {$EndIf}
+          end;
+      end;
+    end;
+    tkDynArray:
+      begin
+        A := GetDynArrayProp(TObject(Instance), FPropInfo);
+        TValue.Make(@A, FPropInfo^.PropType, Result);
+      end
   else
     result := TValue.Empty;
   end
@@ -3931,6 +4145,16 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:       
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);  
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
+    tkDynArray:
+      SetDynArrayProp(TObject(Instance), FPropInfo, AValue.AsDynArray);
+    tkEnumeration:
+      SetOrdProp(TObject(Instance), FPropInfo, AValue.AsEnumeration)
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
3_rtti.pp.patch (14,913 bytes)   
3_tests.rtti.pas.patch (19,230 bytes)   
Index: packages/rtl-objpas/tests/tests.rtti.pas
===================================================================
--- packages/rtl-objpas/tests/tests.rtti.pas	(revision 43639)
+++ packages/rtl-objpas/tests/tests.rtti.pas	(working copy)
@@ -37,12 +37,24 @@
     procedure TestPropGetValueProcString;
     procedure TestPropGetValueProcInteger;
     procedure TestPropGetValueProcBoolean;
-    procedure TestPropGetValueProcShortString;
+    procedure TestPropGetValueProcShortString;  
+    procedure TestPropGetValueObject;
+    procedure TestPropGetValueInterface;   
+    procedure TestPropGetValueFloat;
+    procedure TestPropGetValueDynArray;  
+    procedure TestPropGetValueDyn3Array;    
+    procedure TestPropGetValueEnumeration;
 
     procedure TestPropSetValueString;
     procedure TestPropSetValueInteger;
     procedure TestPropSetValueBoolean;
     procedure TestPropSetValueShortString;
+    procedure TestPropSetValueObject;      
+    procedure TestPropSetValueInterface;
+    procedure TestPropSetValueFloat;     
+    procedure TestPropSetValueDynArray;
+    procedure TestPropSetValueDyn3Array;  
+    procedure TestPropSetValueEnumeration;
 
     procedure TestGetValueStringCastError;
     procedure TestGetIsReadable;
@@ -116,6 +128,10 @@
   TGetClassPropertiesSub = class(TGetClassProperties)
 
   end;
+
+  TTestDynArray = array of Integer;    
+  TTestDyn3Array = array of array of array of Integer;
+  TTestEnumeration = (en1, en2, en3, en4);
   {$M-}
 
   { TTestValueClass }
@@ -123,10 +139,20 @@
   {$M+}
   TTestValueClass = class
   private
+    FAArray: TTestDynArray;
+    FAArray3: TTestDyn3Array;
+    FAComp: Comp;
+    FACurrency: Currency;
+    FADouble: Double;
+    FAEnumeration: TTestEnumeration;
+    FAExtended: Extended;
     FAInteger: integer;
+    FAObject: TObject;
+    FASingle: Single;
     FAString: string;
     FABoolean: boolean;
     FAShortString: ShortString;
+    FAUnknown: IUnknown;
     function GetAInteger: integer;
     function GetAString: string;
     function GetABoolean: boolean;
@@ -133,8 +159,18 @@
     function GetAShortString: ShortString;
     procedure SetWriteOnly(AValue: integer);
   published
+    property AArray: TTestDynArray read FAArray write FAArray; 
+    property AArray3: TTestDyn3Array read FAArray3 write FAArray3;
+    property AEnumeration: TTestEnumeration read FAEnumeration write FAEnumeration;
     property AInteger: Integer read FAInteger write FAInteger;
     property AString: string read FAString write FAString;
+    property ASingle: Single read FASingle write FASingle;
+    property ADouble: Double read FADouble write FADouble;
+    property AExtended: Extended read FAExtended write FAExtended;
+    property ACurrency: Currency read FACurrency write FACurrency;
+    property AObject: TObject read FAObject write FAObject;    
+    property AUnknown: IUnknown read FAUnknown write FAUnknown;
+    property AComp: Comp read FAComp write FAComp;
     property ABoolean: boolean read FABoolean write FABoolean;
     property AShortString: ShortString read FAShortString write FAShortString;
     property AGetInteger: Integer read GetAInteger;
@@ -154,6 +190,24 @@
   end;
   {$M-}
 
+  {$M+}
+  IObjectInterface = interface
+    ['{1302EDC2-B2A0-4BF6-B0CE-B76D0E3D3A37}']
+    function ToObject: TObject;
+  end;
+  {$M-}
+
+  {$M+}
+
+  { TObjectInterfaceImplementation }
+
+  TObjectInterfaceImplementation = class(TInterfacedObject, IObjectInterface)
+  public
+    function ToObject: TObject;
+  end;
+
+  {$M-}
+
   TManagedRec = record
     s: string;
   end;
@@ -209,6 +263,13 @@
   ICORBATest = interface
   end;
 
+{ TObjectInterfaceImplementation }
+
+function TObjectInterfaceImplementation.ToObject: TObject;
+begin
+  Result := Self;
+end;
+
 {$POP}
 {$endif}
 
@@ -269,9 +330,9 @@
 var
   ATestClass : TTestValueClass;
   c: TRttiContext;
+  i: Integer;
   ARttiType: TRttiType;
   AValue: TValue;
-  i: integer;
   HadException: boolean;
 begin
   c := TRttiContext.Create;
@@ -1059,6 +1120,269 @@
   end;
 end;
 
+procedure TTestCase1.TestPropGetValueObject;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: TObject;
+begin
+  c := TRttiContext.Create;
+  O := TObject.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AObject := O;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AObject');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(O.GetHashCode, AValue.AsObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals(O.GetHashCode, AValue.AsObject.GetHashCode);
+  finally
+    c.Free;
+    O.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueInterface;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: IObjectInterface;
+begin
+  c := TRttiContext.Create;
+  O := TObjectInterfaceImplementation.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AUnknown := O;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AUnknown');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(O.ToObject.GetHashCode, (AValue.AsInterface as IObjectInterface).ToObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals(O.ToObject.GetHashCode, (AValue.AsInterface as IObjectInterface).ToObject.GetHashCode);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueFloat;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValueS, AValueD, AValueE, AValueC, AValueCm: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.ASingle := 1.1;
+    ATestClass.ADouble := 2.2;
+    ATestClass.AExtended := 3.3;
+    ATestClass.ACurrency := 4;
+    ATestClass.AComp := 5;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+
+      AProperty := ARttiType.GetProperty('ASingle');
+      AValueS := AProperty.GetValue(ATestClass);
+      CheckEquals(1.1, AValueS.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ADouble');
+      AValueD := AProperty.GetValue(ATestClass);
+      CheckEquals(2.2, AValueD.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('AExtended');
+      AValueE := AProperty.GetValue(ATestClass);
+      CheckEquals(3.3, AValueE.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ACurrency');
+      AValueC := AProperty.GetValue(ATestClass);
+      CheckEquals(4.0, AValueC.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('AComp');
+      AValueCm := AProperty.GetValue(ATestClass);
+      CheckEquals(5.0, AValueCm.AsExtended, 0.001);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(1.1, AValueS.AsExtended, 0.001);   
+    CheckEquals(2.2, AValueD.AsExtended, 0.001);
+    CheckEquals(3.3, AValueE.AsExtended, 0.001);
+    CheckEquals(4.0, AValueC.AsExtended, 0.001);
+    CheckEquals(5.0, AValueCm.AsExtended, 0.001);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueDynArray;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDynArray;
+begin
+  c := TRttiContext.Create;
+  A := [1, 2, 3, 4];
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AArray := A;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AArray');
+      AValue := AProperty.GetValue(ATestClass);
+
+      CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);  
+      CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+      CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+      CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);
+    CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+    CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+    CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger);
+    AValue.SetArrayLength(5);
+    CheckEquals(5, AValue.GetArrayLength);
+    AValue.SetArrayElement(4, 6);
+
+    CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);
+    CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+    CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+    CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger); 
+    CheckEquals(6, AValue.GetArrayElement(4).AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueDyn3Array;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDyn3Array;
+  i, j, k, idx: Integer;
+begin
+  c := TRttiContext.Create;
+  A := [[[1, 2, 3, 4], [5, 6, 7, 8]],[[9, 10, 11, 12], [13, 14, 15, 16]]];
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AArray3 := A;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AArray3');
+      AValue := AProperty.GetValue(ATestClass);
+
+      CheckEquals(3, AValue.GetArrayDimensions);
+      CheckEquals(16, AValue.GetArrayLength);
+
+      idx := 0;
+      for i := 0 to 1 do
+        for j := 0 to 1 do
+          for k := 0 to 3 do
+          begin
+            CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+            Inc(idx);
+          end;
+    finally
+      AtestClass.Free;
+    end;
+
+    idx := 0;
+    for i := 0 to 1 do
+      for j := 0 to 1 do
+        for k := 0 to 3 do
+        begin
+          CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+          Inc(idx);
+        end;
+
+    AValue.SetArrayLength(3, [2, 2, 5]);
+    CheckEquals(20, AValue.GetArrayLength);
+    AValue.SetArrayElement(4, 17);
+    AValue.SetArrayElement(9, 18);
+    AValue.SetArrayElement(14, 19);
+    AValue.SetArrayElement(19, 20);
+
+    idx := 0;
+    for i := 0 to 1 do
+      for j := 0 to 1 do
+      begin
+        for k := 0 to 3 do
+        begin
+          CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+          Inc(idx);
+        end;
+        Inc(idx);
+      end;
+
+    CheckEquals(17, AValue.GetArrayElement(4).AsInteger);
+    CheckEquals(18, AValue.GetArrayElement(9).AsInteger);
+    CheckEquals(19, AValue.GetArrayElement(14).AsInteger);
+    CheckEquals(20, AValue.GetArrayElement(19).AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueEnumeration;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AEnumeration := en3;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AEnumeration');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(Ord(en3),AValue.AsEnumeration);
+      ATestClass.AEnumeration := en1;
+      CheckEquals(Ord(en3), AValue.AsEnumeration);
+      CheckEquals('en3', AValue.ToString);
+      CheckEquals(True, AValue.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(Ord(en3),AValue.AsEnumeration);
+  finally
+    c.Free;
+  end;
+end;
+
 procedure TTestCase1.TestPropSetValueString;
 var
   ATestClass : TTestValueClass;
@@ -1182,6 +1506,9 @@
       CheckEquals(ATestClass.AShortString, ss);
       ss := 'Foobar';
       CheckEquals(ATestClass.AShortString, 'Hello World');
+
+      AProperty.SetValue(ATestClass, 'Another string');
+      CheckEquals(ATestClass.AShortString, 'Another string');
     finally
       AtestClass.Free;
     end;
@@ -1190,6 +1517,259 @@
   end;
 end;
 
+procedure TTestCase1.TestPropSetValueObject;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: TObject;
+  TypeInfo: PTypeInfo;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AObject');
+      TypeInfo := GetPropInfo(ATestClass, 'AObject')^.PropType;
+
+      O := TPersistent.Create;
+      TValue.Make(@O, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AObject.GetHashCode, O.GetHashCode);
+      O.Free;
+
+      O := TPersistent.Create;
+      AProperty.SetValue(ATestClass, O);        
+      CheckEquals(ATestClass.AObject.GetHashCode, O.GetHashCode);
+      O.Free;
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueInterface;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: IObjectInterface;
+  TypeInfo: PTypeInfo;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AUnknown');
+      TypeInfo := GetPropInfo(ATestClass, 'AUnknown')^.PropType;
+
+      O := TObjectInterfaceImplementation.Create;
+      TValue.Make(@O, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals((ATestClass.AUnknown as IObjectInterface).ToObject.GetHashCode, O.ToObject.GetHashCode);
+
+      O := TObjectInterfaceImplementation.Create;
+      AProperty.SetValue(ATestClass, O);
+      CheckEquals((ATestClass.AUnknown as IObjectInterface).ToObject.GetHashCode, O.ToObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueFloat;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  TypeInfo: PTypeInfo;
+  S: Single;
+  D: Double;
+  E: Extended;
+  Cur: Currency;
+  Cmp: Comp;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+
+      AProperty := ARttiType.GetProperty('ASingle');
+      TypeInfo := GetPropInfo(ATestClass, 'ASingle')^.PropType;
+
+      S := 1.1;
+      TValue.Make(@S, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(S, ATestClass.ASingle, 0.001);
+                     
+      S := 1.2;
+      AProperty.SetValue(ATestClass, S);
+      CheckEquals(S, ATestClass.ASingle, 0.001);
+
+      AProperty := ARttiType.GetProperty('ADouble');
+      TypeInfo := GetPropInfo(ATestClass, 'ADouble')^.PropType;
+
+      D := 2.1;
+      TValue.Make(@D, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(D, ATestClass.ADouble, 0.001);
+
+      D := 2.2;
+      AProperty.SetValue(ATestClass, D);
+      CheckEquals(D, ATestClass.ADouble, 0.001);
+
+      AProperty := ARttiType.GetProperty('AExtended');
+      TypeInfo := GetPropInfo(ATestClass, 'AExtended')^.PropType;
+
+      E := 3.1;
+      TValue.Make(@E, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(E, ATestClass.AExtended, 0.001);
+
+      E := 3.2;
+      AProperty.SetValue(ATestClass, E);
+      CheckEquals(E, ATestClass.AExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ACurrency');
+      TypeInfo := GetPropInfo(ATestClass, 'ACurrency')^.PropType;
+
+      Cur := 40;
+      TValue.Make(@Cur, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Cur, ATestClass.ACurrency, 0.001);
+
+      Cur := 41;
+      AProperty.SetValue(ATestClass, Cur);
+      CheckEquals(Cur, ATestClass.ACurrency, 0.001);
+
+      AProperty := ARttiType.GetProperty('AComp');
+      TypeInfo := GetPropInfo(ATestClass, 'AComp')^.PropType;
+
+      Cmp := 50;
+      TValue.Make(@Cmp, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Cmp, ATestClass.AComp, 0.001);
+
+      Cmp := 51;
+      AProperty.SetValue(ATestClass, Cmp);
+      CheckEquals(Cmp, ATestClass.AComp, 0.001);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueDynArray;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDynArray;
+  TypeInfo: PTypeInfo;
+  i: Integer;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AArray');
+      TypeInfo := GetPropInfo(ATestClass, 'AArray')^.PropType;
+                          
+      A := [1, 2, 3, 4, 5];
+      TValue.Make(@A, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+
+      for i := 0 to High(A) do
+        CheckEquals(A[i], ATestClass.AArray[i]);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueDyn3Array;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDyn3Array;
+  TypeInfo: PTypeInfo;
+  i, j, k: Integer;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AArray3');
+      TypeInfo := GetPropInfo(ATestClass, 'AArray3')^.PropType;
+
+      A := [[[1, 2, 3], [4, 5, 6]], [[7, 8, 9], [10, 11, 12]]];
+      TValue.Make(@A, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+
+      for i := 0 to 1 do   
+        for j := 0 to 1 do       
+          for k := 0 to 3 do
+            CheckEquals(A[i, j, k], ATestClass.AArray3[i, j, k]);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueEnumeration;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  E: TTestEnumeration;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AEnumeration');
+
+      E := en2;
+      TValue.Make(@E, TypeInfo(TTestEnumeration), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Ord(E), Ord(ATestClass.AEnumeration));
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
 procedure TTestCase1.TestPropGetValueProcInteger;
 var
   ATestClass : TTestValueClass;
3_tests.rtti.pas.patch (19,230 bytes)   

Sven Barth

2019-12-12 13:41

manager   ~0119793

I should have been a bit more clear: when I said "variant record" I meant a normal record with a variant part, not a Variant:

=== code begin ===

var
  tmp: record
    case Integer of
      0: (i: Int64);
      1: (wc: WideChar);
      2: ...
  end;

=== code end ===

This allows to put at least the non-managed types into as few Bytes as possible. The managed types (AnsiString, UnicodeString, IInterface) need to be separate however.

Thank you for adding tests however. :)

Imants Gulbis

2019-12-13 12:43

reporter   ~0119815

I fixed what you said and added two new tests for char and wide-char
4_rtti.pp.patch (15,155 bytes)   
Index: packages/rtl-objpas/src/inc/rtti.pp
===================================================================
--- packages/rtl-objpas/src/inc/rtti.pp	(revision 43679)
+++ packages/rtl-objpas/src/inc/rtti.pp	(working copy)
@@ -136,13 +136,20 @@
     function AsBoolean: boolean;
     function AsCurrency: Currency;
     function AsInteger: Integer;
+    function AsEnumeration: Int64;
+    function AsChar: Char;
+    function AsWideChar: WideChar;
     function AsInt64: Int64;
     function AsUInt64: QWord;
     function AsInterface: IInterface;
+    function AsDynArray: Pointer;
     function ToString: String;
     function GetArrayLength: SizeInt;
     function GetArrayElement(AIndex: SizeInt): TValue;
+    function GetArrayDimensions: Integer;
     procedure SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
+    procedure SetArrayLength(Dimensions: SizeInt; Sizes: array of SizeInt);
+    procedure SetArrayLength(Sizes: SizeInt); inline;
     function IsType(ATypeInfo: PTypeInfo): boolean; inline;
 {$ifndef NoGenericMethods}
     generic function IsType<T>: Boolean; inline;
@@ -159,11 +166,13 @@
     class operator := (AValue: Extended): TValue; inline;
 {$endif}
     class operator := (AValue: Currency): TValue; inline;
+    class operator := (AValue: Comp): TValue; inline;
     class operator := (AValue: Int64): TValue; inline;
     class operator := (AValue: QWord): TValue; inline;
     class operator := (AValue: TObject): TValue; inline;
     class operator := (AValue: TClass): TValue; inline;
     class operator := (AValue: Boolean): TValue; inline;
+    class operator := (AValue: IUnknown): TValue; inline;
     property DataSize: SizeInt read GetDataSize;
     property Kind: TTypeKind read GetTypeKind;
     property TypeData: PTypeData read GetTypeDataProp;
@@ -617,6 +626,7 @@
 {$ifdef unix}
   BaseUnix,
 {$endif}
+  Variants,
   fgl;
 
 function AlignToPtr(aPtr: Pointer): Pointer; inline;
@@ -793,6 +803,7 @@
   SErrVirtIntfMethodNil = 'Method %1:d of ''%0:s'' is Nil';
   SErrVirtIntfCreateVmt = 'Failed to create VMT for ''%s''';
   SErrVirtIntfIInterface = 'Failed to prepare IInterface method callbacks';
+  SErrCanotChangeSize = 'Only dynamic array can change length!';
 
 var
   PoolRefCount : integer;
@@ -1944,6 +1955,39 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsEnumeration: Int64;
+begin
+  if Kind in [tkEnumeration] then
+    case TypeData^.OrdType of
+      otSByte:  Result := FData.FAsSByte;
+      otUByte:  Result := FData.FAsUByte;
+      otSWord:  Result := FData.FAsSWord;
+      otUWord:  Result := FData.FAsUWord;
+      otSLong:  Result := FData.FAsSLong;
+      otULong:  Result := FData.FAsULong;
+      otSQWord: Result := FData.FAsSInt64;
+      otUQWord: Result := FData.FAsUInt64;
+    end
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsChar: Char;
+begin
+  if Kind in [tkChar] then
+    Result := Chr(FData.FAsUByte)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsWideChar: WideChar;
+begin
+  if Kind in [tkWChar] then
+    Result := WideChar(FData.FAsUWord)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInt64: Int64;
 begin
   if Kind in [tkInteger, tkInt64, tkQWord] then
@@ -1957,6 +2001,8 @@
       otSQWord: Result := FData.FAsSInt64;
       otUQWord: Result := FData.FAsUInt64;
     end
+  else if (Kind = tkChar) then
+    Result := FData.FAsUByte
   else if (Kind = tkFloat) and (TypeData^.FloatType = ftComp) then
     Result := Int64(FData.FAsComp)
   else
@@ -1982,6 +2028,14 @@
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsDynArray: Pointer;
+begin
+  if Kind = tkDynArray then
+    Result := PPointer(FData.FValueData.GetReferenceToRawData)^
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
 function TValue.AsInterface: IInterface;
 begin
   if Kind = tkInterface then
@@ -2006,6 +2060,9 @@
     tkPointer : result := '(pointer @ ' + HexStr(FData.FAsPointer) + ')';
     tkInterface : result := '(interface @ ' + HexStr(PPointer(FData.FValueData.GetReferenceToRawData)^) + ')';
     tkInterfaceRaw : result := '(raw interface @ ' + HexStr(FData.FAsPointer) + ')';
+    tkEnumeration: Result := GetEnumName(TypeInfo, Ord(AsEnumeration));
+    tkChar: Result := AsChar;
+    tkWChar: Result := UTF8Encode(AsWideChar);
   else
     result := '';
   end;
@@ -2014,12 +2071,23 @@
 function TValue.GetArrayLength: SizeInt;
 var
   td: PTypeData;
+  Bounds: TBoundArray;
+  Size: SizeInt;
+  Total: SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
-  if Kind = tkDynArray then
-    Result := DynArraySize(PPointer(FData.FValueData.GetReferenceToRawData)^)
-  else begin
+  if Kind = tkDynArray then begin
+    if GetArrayDimensions > 1 then
+    begin
+      Bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      Total := 1;
+      for Size in Bounds do
+        Total *= (Size + 1);
+      Result := Total;
+    end else
+      Result := DynArraySize(PPointer(FData.FValueData.GetReferenceToRawData)^)
+  end else begin
     td := TypeData;
     if (td^.ArrayData.Size = 0) and (td^.ArrayData.ElCount = 0) then
       Result := FData.FArrLength
@@ -2034,12 +2102,45 @@
   eltype: PTypeInfo;
   elsize: SizeInt;
   td: PTypeData;
+  index, elements, i, j, last: Integer;
+  bounds: TBoundArray;
+  indices: array of SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
   if Kind = tkDynArray then begin
-    data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
-    eltype := TypeData^.elType2;
+    if GetArrayDimensions > 1 then
+    begin
+      bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      for i := Low(bounds) to High(bounds) do
+        bounds[i] := bounds[i] + 1;
+
+      indices := [];
+      SetLength(indices, Length(bounds));
+      index := AIndex;
+      last := High(bounds);
+      for i := Low(indices) to High(indices) - 1 do
+      begin
+        elements := 1;
+        for j := High(bounds) downto i + 1 do
+          elements *= bounds[j];
+
+        indices[i] := index div elements;
+        index := index mod elements;
+      end;
+
+      indices[last] := index mod bounds[last];
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, indices, FData.FTypeInfo);
+
+      eltype := TypeData^.elType2;
+      while eltype^.Kind = tkDynArray do
+        eltype := GetTypeData(eltype)^.ElType2;
+    end
+    else
+    begin
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
+      eltype := TypeData^.elType2;
+    end;
   end else begin
     td := TypeData;
     eltype := td^.ArrayData.ElType;
@@ -2057,6 +2158,33 @@
   Make(data, eltype, Result);
 end;
 
+function TValue.GetArrayDimensions: Integer;
+begin
+  if not IsArray then
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+
+  if Kind = tkDynArray then
+    Result := DynArrayDim(FData.FTypeInfo)
+  else
+    Result := GetTypeData(FData.FTypeInfo)^.ArrayData.DimCount
+end;
+
+procedure TValue.SetArrayLength(Dimensions: SizeInt; Sizes: array of SizeInt);
+begin
+  if not IsArray then
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+
+  if Kind = tkDynArray then
+    DynArraySetLength(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo, Dimensions, @Sizes[0])
+  else
+    raise EInvalidOpException.Create(SErrCanotChangeSize);
+end;
+
+procedure TValue.SetArrayLength(Sizes: SizeInt);
+begin
+  SetArrayLength(1, [Sizes])
+end;
+
 procedure TValue.SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
 var
   data: Pointer;
@@ -2063,12 +2191,45 @@
   eltype: PTypeInfo;
   elsize: SizeInt;
   td, tdv: PTypeData;
+  index, elements, i, j, last: Integer;
+  bounds: TBoundArray;
+  indices: array of SizeInt;
 begin
   if not IsArray then
     raise EInvalidCast.Create(SErrInvalidTypecast);
   if Kind = tkDynArray then begin
-    data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
-    eltype := TypeData^.elType2;
+    if GetArrayDimensions > 1 then
+    begin
+      bounds := DynArrayBounds(PPointer(FData.FValueData.GetReferenceToRawData)^, FData.FTypeInfo);
+      for i := Low(bounds) to High(bounds) do
+        bounds[i] := bounds[i] + 1;
+
+      indices := [];
+      SetLength(indices, Length(bounds));
+      index := AIndex;
+      last := High(bounds);
+      for i := Low(indices) to High(indices) - 1 do
+      begin
+        elements := 1;
+        for j := High(bounds) downto i + 1 do
+          elements *= bounds[j];
+
+        indices[i] := index div elements;
+        index := index mod elements;
+      end;
+
+      indices[last] := index mod bounds[last];
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, indices, FData.FTypeInfo);
+
+      eltype := TypeData^.elType2;
+      while eltype^.Kind = tkDynArray do
+        eltype := GetTypeData(eltype)^.ElType2;
+    end
+    else
+    begin
+      data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
+      eltype := TypeData^.elType2;
+    end;
   end else begin
     td := TypeData;
     eltype := td^.ArrayData.ElType;
@@ -2257,6 +2418,11 @@
   Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
+class operator TValue.:= (AValue: Comp): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
+end;
+
 class operator TValue.:=(AValue: Int64): TValue;
 begin
   Make(@AValue, System.TypeInfo(AValue), Result);
@@ -2282,6 +2448,10 @@
   Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
+class operator TValue.:= (AValue: IUnknown): TValue;
+begin
+  Make(@AValue, System.TypeInfo(AValue), Result);
+end;
 
 function Invoke(aCodeAddress: CodePointer; const aArgs: TValueArray;
   aCallConv: TCallConv; aResultType: PTypeInfo; aIsStatic: Boolean;
@@ -3870,16 +4040,30 @@
   end;
 
 var
-  s: string;
+  Values: record
+    case Integer of
+      0: (Enum: Int64);
+      1: (Bool: Int64);
+      2: (Int: Int64);
+      3: (Ch: Byte);
+      4: (Wch: Word);
+      5: (I64: Int64);
+      6: (Si: Single);
+      7: (Db: Double);
+      8: (Ex: Extended);
+      9: (Cur: Currency);
+     10: (Cp: Comp);
+     11: (A: Pointer;)
+  end;
+  s: String;
   ss: ShortString;
-  i: int64;
-  c: Char;
-  wc: WideChar;
+  O: TObject;
+  Int: IUnknown;
 begin
   case FPropinfo^.PropType^.Kind of
     tkSString:
       begin
-        ss := GetStrProp(TObject(Instance), FPropInfo);
+        ss := ShortString(GetStrProp(TObject(Instance), FPropInfo));
         TValue.Make(@ss, FPropInfo^.PropType, result);
       end;
     tkAString:
@@ -3887,32 +4071,90 @@
         s := GetStrProp(TObject(Instance), FPropInfo);
         TValue.Make(@s, FPropInfo^.PropType, result);
       end;
+    tkEnumeration:
+      begin
+        Values.Enum := Integer(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@Values.Enum, FPropInfo^.PropType, result);
+      end;
     tkBool:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        ValueFromBool(i);
+        Values.Bool := GetOrdProp(TObject(Instance), FPropInfo);
+        ValueFromBool(Values.Bool);
       end;
     tkInteger:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        ValueFromInt(i);
+        Values.Int := GetOrdProp(TObject(Instance), FPropInfo);
+        ValueFromInt(Values.Int);
       end;
     tkChar:
       begin
-        c := AnsiChar(GetOrdProp(TObject(Instance), FPropInfo));
-        TValue.Make(@c, FPropInfo^.PropType, result);
+        Values.Ch := Byte(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@Values.Ch, FPropInfo^.PropType, result);
       end;
     tkWChar:
       begin
-        wc := WideChar(GetOrdProp(TObject(Instance), FPropInfo));
-        TValue.Make(@wc, FPropInfo^.PropType, result);
+        Values.Wch := Word(GetOrdProp(TObject(Instance), FPropInfo));
+        TValue.Make(@Values.Wch, FPropInfo^.PropType, result);
       end;
     tkInt64,
     tkQWord:
       begin
-        i := GetOrdProp(TObject(Instance), FPropInfo);
-        TValue.Make(@i, FPropInfo^.PropType, result);
+        Values.I64 := GetOrdProp(TObject(Instance), FPropInfo);
+        TValue.Make(@Values.I64, FPropInfo^.PropType, result);
       end;
+    tkClass:
+    begin
+      O := GetObjectProp(TObject(Instance), FPropInfo);
+      TValue.Make(@O, FPropInfo^.PropType, Result);
+    end;
+    tkInterface:
+    begin
+      Int := GetInterfaceProp(TObject(Instance), FPropInfo);
+      TValue.Make(@Int, FPropInfo^.PropType, Result);
+    end;
+    tkFloat:
+    begin
+      case GetTypeData(FPropInfo^.PropType)^.FloatType of
+        ftCurr   :
+          begin
+            {$IfDef FPC_CURRENCY_IS_INT64}
+              Values.Cur := Currency(GetOrdProp(TObject(Instance), FPropInfo));
+            {$Else}
+              Values.Cur := Currency(GetFloatProp(TObject(Instance), FPropInfo));
+            {$EndIf}
+            TValue.Make(@Values.Cur, FPropInfo^.PropType, Result);
+          end;
+        ftSingle :
+          begin
+            Values.Si := Single(GetFloatProp(TObject(Instance), FPropInfo));
+            TValue.Make(@Values.Si, FPropInfo^.PropType, Result);
+          end;
+        ftDouble :
+          begin
+            Values.Db := Double(GetFloatProp(TObject(Instance), FPropInfo));
+            TValue.Make(@Values.Db, FPropInfo^.PropType, Result);
+          end;
+        ftExtended:
+          begin
+            Values.Ex := GetFloatProp(TObject(Instance), FPropInfo);
+            TValue.Make(@Values.Ex, FPropInfo^.PropType, Result);
+          end;
+        ftComp   :
+          begin
+            {$IfDef FPC_COMP_IS_INT64}
+            Values.Cp := Comp(GetOrdProp(TObject(Instance), FPropInfo));
+            {$Else}
+            Values.Cp := Comp(GetFloatProp(TObject(Instance), FPropInfo));
+            {$EndIf}
+            TValue.Make(@Values.Cp, FPropInfo^.PropType, Result);
+          end;
+      end;
+    end;
+    tkDynArray:
+      begin
+        Values.A := GetDynArrayProp(TObject(Instance), FPropInfo);
+        TValue.Make(@Values.A, FPropInfo^.PropType, Result);
+      end
   else
     result := TValue.Empty;
   end
@@ -3931,6 +4173,16 @@
     tkBool,
     tkWChar:
       SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+    tkClass:
+      SetObjectProp(TObject(Instance), FPropInfo, AValue.AsObject);
+    tkInterface:
+      SetInterfaceProp(TObject(Instance), FPropInfo, AValue.AsInterface);
+    tkFloat:
+      SetFloatProp(TObject(Instance), FPropInfo, AValue.AsExtended);
+    tkDynArray:
+      SetDynArrayProp(TObject(Instance), FPropInfo, AValue.AsDynArray);
+    tkEnumeration:
+      SetOrdProp(TObject(Instance), FPropInfo, AValue.AsEnumeration)
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end
4_rtti.pp.patch (15,155 bytes)   
4_tests.rtti.pas.patch (21,836 bytes)   
Index: packages/rtl-objpas/tests/tests.rtti.pas
===================================================================
--- packages/rtl-objpas/tests/tests.rtti.pas	(revision 43679)
+++ packages/rtl-objpas/tests/tests.rtti.pas	(working copy)
@@ -37,12 +37,26 @@
     procedure TestPropGetValueProcString;
     procedure TestPropGetValueProcInteger;
     procedure TestPropGetValueProcBoolean;
-    procedure TestPropGetValueProcShortString;
+    procedure TestPropGetValueProcShortString;  
+    procedure TestPropGetValueObject;
+    procedure TestPropGetValueInterface;   
+    procedure TestPropGetValueFloat;
+    procedure TestPropGetValueDynArray;  
+    procedure TestPropGetValueDyn3Array;    
+    procedure TestPropGetValueEnumeration;
+    procedure TestPropGetValueChars;
 
     procedure TestPropSetValueString;
     procedure TestPropSetValueInteger;
     procedure TestPropSetValueBoolean;
     procedure TestPropSetValueShortString;
+    procedure TestPropSetValueObject;      
+    procedure TestPropSetValueInterface;
+    procedure TestPropSetValueFloat;     
+    procedure TestPropSetValueDynArray;
+    procedure TestPropSetValueDyn3Array;  
+    procedure TestPropSetValueEnumeration; 
+    procedure TestPropSetValueChars;
 
     procedure TestGetValueStringCastError;
     procedure TestGetIsReadable;
@@ -116,6 +130,10 @@
   TGetClassPropertiesSub = class(TGetClassProperties)
 
   end;
+
+  TTestDynArray = array of Integer;    
+  TTestDyn3Array = array of array of array of Integer;
+  TTestEnumeration = (en1, en2, en3, en4);
   {$M-}
 
   { TTestValueClass }
@@ -123,10 +141,22 @@
   {$M+}
   TTestValueClass = class
   private
+    FAArray: TTestDynArray;
+    FAArray3: TTestDyn3Array;
+    FAChar: Char;
+    FAComp: Comp;
+    FACurrency: Currency;
+    FADouble: Double;
+    FAEnumeration: TTestEnumeration;
+    FAExtended: Extended;
     FAInteger: integer;
+    FAObject: TObject;
+    FASingle: Single;
     FAString: string;
     FABoolean: boolean;
     FAShortString: ShortString;
+    FAUnknown: IUnknown;
+    FAWideChar: WideChar;
     function GetAInteger: integer;
     function GetAString: string;
     function GetABoolean: boolean;
@@ -133,8 +163,18 @@
     function GetAShortString: ShortString;
     procedure SetWriteOnly(AValue: integer);
   published
+    property AArray: TTestDynArray read FAArray write FAArray; 
+    property AArray3: TTestDyn3Array read FAArray3 write FAArray3;
+    property AEnumeration: TTestEnumeration read FAEnumeration write FAEnumeration;
     property AInteger: Integer read FAInteger write FAInteger;
     property AString: string read FAString write FAString;
+    property ASingle: Single read FASingle write FASingle;
+    property ADouble: Double read FADouble write FADouble;
+    property AExtended: Extended read FAExtended write FAExtended;
+    property ACurrency: Currency read FACurrency write FACurrency;
+    property AObject: TObject read FAObject write FAObject;    
+    property AUnknown: IUnknown read FAUnknown write FAUnknown;
+    property AComp: Comp read FAComp write FAComp;
     property ABoolean: boolean read FABoolean write FABoolean;
     property AShortString: ShortString read FAShortString write FAShortString;
     property AGetInteger: Integer read GetAInteger;
@@ -142,6 +182,8 @@
     property AGetBoolean: boolean read GetABoolean;
     property AGetShortString: ShortString read GetAShortString;
     property AWriteOnly: integer write SetWriteOnly;
+    property AChar: Char read FAChar write FAChar;
+    property AWideChar: WideChar read FAWideChar write FAWideChar;
   end;
   {$M-}
 
@@ -154,6 +196,24 @@
   end;
   {$M-}
 
+  {$M+}
+  IObjectInterface = interface
+    ['{1302EDC2-B2A0-4BF6-B0CE-B76D0E3D3A37}']
+    function ToObject: TObject;
+  end;
+  {$M-}
+
+  {$M+}
+
+  { TObjectInterfaceImplementation }
+
+  TObjectInterfaceImplementation = class(TInterfacedObject, IObjectInterface)
+  public
+    function ToObject: TObject;
+  end;
+
+  {$M-}
+
   TManagedRec = record
     s: string;
   end;
@@ -209,6 +269,13 @@
   ICORBATest = interface
   end;
 
+{ TObjectInterfaceImplementation }
+
+function TObjectInterfaceImplementation.ToObject: TObject;
+begin
+  Result := Self;
+end;
+
 {$POP}
 {$endif}
 
@@ -269,9 +336,9 @@
 var
   ATestClass : TTestValueClass;
   c: TRttiContext;
+  i: Integer;
   ARttiType: TRttiType;
   AValue: TValue;
-  i: integer;
   HadException: boolean;
 begin
   c := TRttiContext.Create;
@@ -1059,6 +1126,312 @@
   end;
 end;
 
+procedure TTestCase1.TestPropGetValueObject;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: TObject;
+begin
+  c := TRttiContext.Create;
+  O := TObject.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AObject := O;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AObject');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(O.GetHashCode, AValue.AsObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals(O.GetHashCode, AValue.AsObject.GetHashCode);
+  finally
+    c.Free;
+    O.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueInterface;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: IObjectInterface;
+begin
+  c := TRttiContext.Create;
+  O := TObjectInterfaceImplementation.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AUnknown := O;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AUnknown');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(O.ToObject.GetHashCode, (AValue.AsInterface as IObjectInterface).ToObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals(O.ToObject.GetHashCode, (AValue.AsInterface as IObjectInterface).ToObject.GetHashCode);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueFloat;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValueS, AValueD, AValueE, AValueC, AValueCm: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.ASingle := 1.1;
+    ATestClass.ADouble := 2.2;
+    ATestClass.AExtended := 3.3;
+    ATestClass.ACurrency := 4;
+    ATestClass.AComp := 5;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+
+      AProperty := ARttiType.GetProperty('ASingle');
+      AValueS := AProperty.GetValue(ATestClass);
+      CheckEquals(1.1, AValueS.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ADouble');
+      AValueD := AProperty.GetValue(ATestClass);
+      CheckEquals(2.2, AValueD.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('AExtended');
+      AValueE := AProperty.GetValue(ATestClass);
+      CheckEquals(3.3, AValueE.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ACurrency');
+      AValueC := AProperty.GetValue(ATestClass);
+      CheckEquals(4.0, AValueC.AsExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('AComp');
+      AValueCm := AProperty.GetValue(ATestClass);
+      CheckEquals(5.0, AValueCm.AsExtended, 0.001);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(1.1, AValueS.AsExtended, 0.001);   
+    CheckEquals(2.2, AValueD.AsExtended, 0.001);
+    CheckEquals(3.3, AValueE.AsExtended, 0.001);
+    CheckEquals(4.0, AValueC.AsExtended, 0.001);
+    CheckEquals(5.0, AValueCm.AsExtended, 0.001);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueDynArray;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDynArray;
+begin
+  c := TRttiContext.Create;
+  A := [1, 2, 3, 4];
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AArray := A;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AArray');
+      AValue := AProperty.GetValue(ATestClass);
+
+      CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);  
+      CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+      CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+      CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);
+    CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+    CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+    CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger);
+    AValue.SetArrayLength(5);
+    CheckEquals(5, AValue.GetArrayLength);
+    AValue.SetArrayElement(4, 6);
+
+    CheckEquals(A[0], AValue.GetArrayElement(0).AsInteger);
+    CheckEquals(A[1], AValue.GetArrayElement(1).AsInteger);
+    CheckEquals(A[2], AValue.GetArrayElement(2).AsInteger);
+    CheckEquals(A[3], AValue.GetArrayElement(3).AsInteger); 
+    CheckEquals(6, AValue.GetArrayElement(4).AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueDyn3Array;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDyn3Array;
+  i, j, k, idx: Integer;
+begin
+  c := TRttiContext.Create;
+  A := [[[1, 2, 3, 4], [5, 6, 7, 8]],[[9, 10, 11, 12], [13, 14, 15, 16]]];
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AArray3 := A;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AArray3');
+      AValue := AProperty.GetValue(ATestClass);
+
+      CheckEquals(3, AValue.GetArrayDimensions);
+      CheckEquals(16, AValue.GetArrayLength);
+
+      idx := 0;
+      for i := 0 to 1 do
+        for j := 0 to 1 do
+          for k := 0 to 3 do
+          begin
+            CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+            Inc(idx);
+          end;
+    finally
+      AtestClass.Free;
+    end;
+
+    idx := 0;
+    for i := 0 to 1 do
+      for j := 0 to 1 do
+        for k := 0 to 3 do
+        begin
+          CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+          Inc(idx);
+        end;
+
+    AValue.SetArrayLength(3, [2, 2, 5]);
+    CheckEquals(20, AValue.GetArrayLength);
+    AValue.SetArrayElement(4, 17);
+    AValue.SetArrayElement(9, 18);
+    AValue.SetArrayElement(14, 19);
+    AValue.SetArrayElement(19, 20);
+
+    idx := 0;
+    for i := 0 to 1 do
+      for j := 0 to 1 do
+      begin
+        for k := 0 to 3 do
+        begin
+          CheckEquals(A[i, j, k], AValue.GetArrayElement(idx).AsInteger);
+          Inc(idx);
+        end;
+        Inc(idx);
+      end;
+
+    CheckEquals(17, AValue.GetArrayElement(4).AsInteger);
+    CheckEquals(18, AValue.GetArrayElement(9).AsInteger);
+    CheckEquals(19, AValue.GetArrayElement(14).AsInteger);
+    CheckEquals(20, AValue.GetArrayElement(19).AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueEnumeration;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AEnumeration := en3;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AEnumeration');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(Ord(en3),AValue.AsEnumeration);
+      ATestClass.AEnumeration := en1;
+      CheckEquals(Ord(en3), AValue.AsEnumeration);
+      CheckEquals('en3', AValue.ToString);
+      CheckEquals(True, AValue.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(Ord(en3),AValue.AsEnumeration);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueChars;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValueC, AValueW: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AChar := 'C';        
+    ATestClass.AWideChar := 'W';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+
+      AProperty := ARttiType.GetProperty('AChar');
+      AValueC := AProperty.GetValue(ATestClass);
+      CheckEquals('C',AValueC.AsChar);
+      ATestClass.AChar := 'N';
+      CheckEquals('C', AValueC.AsChar);
+      CheckEquals('C', AValueC.ToString);
+      CheckEquals(True, AValueC.IsOrdinal);
+
+      AProperty := ARttiType.GetProperty('AWideChar');
+      AValueW := AProperty.GetValue(ATestClass);
+      CheckEquals('W',AValueW.AsWideChar);
+      ATestClass.AChar := 'Z';
+      CheckEquals('W', AValueW.AsWideChar);
+      CheckEquals('W', AValueW.ToString);
+      CheckEquals(True, AValueW.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals('C',AValueC.AsChar);
+    CheckEquals('W',AValueW.AsWideChar);
+  finally
+    c.Free;
+  end;
+end;
+
 procedure TTestCase1.TestPropSetValueString;
 var
   ATestClass : TTestValueClass;
@@ -1182,6 +1555,9 @@
       CheckEquals(ATestClass.AShortString, ss);
       ss := 'Foobar';
       CheckEquals(ATestClass.AShortString, 'Hello World');
+
+      AProperty.SetValue(ATestClass, 'Another string');
+      CheckEquals(ATestClass.AShortString, 'Another string');
     finally
       AtestClass.Free;
     end;
@@ -1190,6 +1566,293 @@
   end;
 end;
 
+procedure TTestCase1.TestPropSetValueObject;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: TObject;
+  TypeInfo: PTypeInfo;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AObject');
+      TypeInfo := GetPropInfo(ATestClass, 'AObject')^.PropType;
+
+      O := TPersistent.Create;
+      TValue.Make(@O, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AObject.GetHashCode, O.GetHashCode);
+      O.Free;
+
+      O := TPersistent.Create;
+      AProperty.SetValue(ATestClass, O);        
+      CheckEquals(ATestClass.AObject.GetHashCode, O.GetHashCode);
+      O.Free;
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueInterface;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  O: IObjectInterface;
+  TypeInfo: PTypeInfo;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AUnknown');
+      TypeInfo := GetPropInfo(ATestClass, 'AUnknown')^.PropType;
+
+      O := TObjectInterfaceImplementation.Create;
+      TValue.Make(@O, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals((ATestClass.AUnknown as IObjectInterface).ToObject.GetHashCode, O.ToObject.GetHashCode);
+
+      O := TObjectInterfaceImplementation.Create;
+      AProperty.SetValue(ATestClass, O);
+      CheckEquals((ATestClass.AUnknown as IObjectInterface).ToObject.GetHashCode, O.ToObject.GetHashCode);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueFloat;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  TypeInfo: PTypeInfo;
+  S: Single;
+  D: Double;
+  E: Extended;
+  Cur: Currency;
+  Cmp: Comp;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+
+      AProperty := ARttiType.GetProperty('ASingle');
+      TypeInfo := GetPropInfo(ATestClass, 'ASingle')^.PropType;
+
+      S := 1.1;
+      TValue.Make(@S, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(S, ATestClass.ASingle, 0.001);
+                     
+      S := 1.2;
+      AProperty.SetValue(ATestClass, S);
+      CheckEquals(S, ATestClass.ASingle, 0.001);
+
+      AProperty := ARttiType.GetProperty('ADouble');
+      TypeInfo := GetPropInfo(ATestClass, 'ADouble')^.PropType;
+
+      D := 2.1;
+      TValue.Make(@D, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(D, ATestClass.ADouble, 0.001);
+
+      D := 2.2;
+      AProperty.SetValue(ATestClass, D);
+      CheckEquals(D, ATestClass.ADouble, 0.001);
+
+      AProperty := ARttiType.GetProperty('AExtended');
+      TypeInfo := GetPropInfo(ATestClass, 'AExtended')^.PropType;
+
+      E := 3.1;
+      TValue.Make(@E, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(E, ATestClass.AExtended, 0.001);
+
+      E := 3.2;
+      AProperty.SetValue(ATestClass, E);
+      CheckEquals(E, ATestClass.AExtended, 0.001);
+
+      AProperty := ARttiType.GetProperty('ACurrency');
+      TypeInfo := GetPropInfo(ATestClass, 'ACurrency')^.PropType;
+
+      Cur := 40;
+      TValue.Make(@Cur, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Cur, ATestClass.ACurrency, 0.001);
+
+      Cur := 41;
+      AProperty.SetValue(ATestClass, Cur);
+      CheckEquals(Cur, ATestClass.ACurrency, 0.001);
+
+      AProperty := ARttiType.GetProperty('AComp');
+      TypeInfo := GetPropInfo(ATestClass, 'AComp')^.PropType;
+
+      Cmp := 50;
+      TValue.Make(@Cmp, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Cmp, ATestClass.AComp, 0.001);
+
+      Cmp := 51;
+      AProperty.SetValue(ATestClass, Cmp);
+      CheckEquals(Cmp, ATestClass.AComp, 0.001);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueDynArray;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDynArray;
+  TypeInfo: PTypeInfo;
+  i: Integer;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AArray');
+      TypeInfo := GetPropInfo(ATestClass, 'AArray')^.PropType;
+                          
+      A := [1, 2, 3, 4, 5];
+      TValue.Make(@A, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+
+      for i := 0 to High(A) do
+        CheckEquals(A[i], ATestClass.AArray[i]);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueDyn3Array;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  A: TTestDyn3Array;
+  TypeInfo: PTypeInfo;
+  i, j, k: Integer;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AArray3');
+      TypeInfo := GetPropInfo(ATestClass, 'AArray3')^.PropType;
+
+      A := [[[1, 2, 3], [4, 5, 6]], [[7, 8, 9], [10, 11, 12]]];
+      TValue.Make(@A, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+
+      for i := 0 to 1 do   
+        for j := 0 to 1 do       
+          for k := 0 to 3 do
+            CheckEquals(A[i, j, k], ATestClass.AArray3[i, j, k]);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueEnumeration;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  E: TTestEnumeration;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AEnumeration');
+
+      E := en2;
+      TValue.Make(@E, TypeInfo(TTestEnumeration), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(Ord(E), Ord(ATestClass.AEnumeration));
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueChars;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValueC, AValueW: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AChar := 'C';           
+    ATestClass.AWideChar := 'W';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+
+      AProperty := ARttiType.GetProperty('AChar');
+      AValueC := AProperty.GetValue(ATestClass);
+      CheckEquals('C', AValueC.AsChar);
+
+      AProperty := ARttiType.GetProperty('AWideChar');
+      AValueW := AProperty.GetValue(ATestClass);
+      CheckEquals('W', AValueW.AsWideChar);
+    finally
+      AtestClass.Free;
+    end;
+      CheckEquals('C', AValueC.AsChar);     
+      CheckEquals('W', AValueW.AsWideChar);
+  finally
+    c.Free;
+  end;
+end;
+
 procedure TTestCase1.TestPropGetValueProcInteger;
 var
   ATestClass : TTestValueClass;
4_tests.rtti.pas.patch (21,836 bytes)   

Sven Barth

2019-12-24 22:36

manager   ~0120057

I've applied most of your changes, some with a few adjustments like (Wide)Char stuff or the test for IInterface (you don't need to cast to object; the interface instance stays the same; also you could simply use "intf as TObject").
What I did not apply however is AsEnumeration as that does not really provide any advantage over AsOrdinal except *maybe* the exception if it isn't an enumeration. What we might discuss is a generic method that returns the real enum type.
Also I did not apply the dynamic array changes as these break Delphi compatibility. Not necessarily the existance of SetArrayLength and such, but mainly because GetArrayElement only works on one dimensional arrays with it returning another tkDynArray value for an element. So if you want to have this functionality I'd suggest you to rework it to only work with one dimension. AsDynArray might best be implemented as a generic method as well, returning a real dynamic array type.

Imants Gulbis

2020-01-06 18:20

reporter   ~0120240

Ok no need to brake compatibility with Delphi for array manipulations. If I need them I can write helper type and implement it there.

If all is complete in your side you can assign bug to me and after testing changes I will close it.

Sven Barth

2020-01-10 15:54

manager   ~0120308

Okay, if you have further improvements, please feel free to open another report. But maybe discuss non-Delphi compatible things for the Rtti unit on the mailing list first (you can always check the Delphi documentation online to see what is available).

You may close now. :)

Imants Gulbis

2020-01-15 14:47

reporter   ~0120463

-

Issue History

Date Modified Username Field Change
2019-11-25 15:33 Imants Gulbis New Issue
2019-11-25 15:33 Imants Gulbis File Added: rtti.pp.patch
2019-11-26 00:11 Sven Barth Note Added: 0119500
2019-11-26 00:11 Sven Barth Assigned To => Sven Barth
2019-11-26 00:11 Sven Barth Status new => feedback
2019-11-26 00:11 Sven Barth FPCTarget => -
2019-11-26 06:58 Imants Gulbis Note Added: 0119503
2019-11-26 06:58 Imants Gulbis Status feedback => assigned
2019-11-26 15:14 Imants Gulbis File Added: 2_rtti.pp.patch
2019-11-26 15:14 Imants Gulbis Note Added: 0119509
2019-11-30 13:09 Sven Barth Note Added: 0119558
2019-11-30 13:09 Sven Barth Status assigned => feedback
2019-12-12 12:22 Imants Gulbis File Added: 3_rtti.pp.patch
2019-12-12 12:22 Imants Gulbis File Added: 3_tests.rtti.pas.patch
2019-12-12 12:22 Imants Gulbis Note Added: 0119782
2019-12-12 12:22 Imants Gulbis Status feedback => assigned
2019-12-12 13:41 Sven Barth Note Added: 0119793
2019-12-12 13:42 Sven Barth Status assigned => feedback
2019-12-13 12:43 Imants Gulbis File Added: 4_rtti.pp.patch
2019-12-13 12:43 Imants Gulbis File Added: 4_tests.rtti.pas.patch
2019-12-13 12:43 Imants Gulbis Note Added: 0119815
2019-12-13 12:43 Imants Gulbis Status feedback => assigned
2019-12-24 22:36 Sven Barth Fixed in Revision => 43777,43778,43779,43780
2019-12-24 22:36 Sven Barth Note Added: 0120057
2020-01-06 18:20 Imants Gulbis Note Added: 0120240
2020-01-10 15:54 Sven Barth Status assigned => resolved
2020-01-10 15:54 Sven Barth Resolution open => fixed
2020-01-10 15:54 Sven Barth Fixed in Version => 3.3.1
2020-01-10 15:54 Sven Barth Note Added: 0120308
2020-01-15 14:47 Imants Gulbis Status resolved => closed
2020-01-15 14:47 Imants Gulbis Note Added: 0120463