# revisions: 43009,43591,43772,43777,43778,43779,43780,43791,43792

git-svn-id: branches/fixes_3_2@43943 -

packages/rtl-objpas/src/i386/invoke.inc

@@ -68,15 +68,20 @@ procedure InvokeKernelRegister(aCodeAddress: CodePointer; aArgs: Pointer; aArgCo
 label
   nostackargs;
 asm
-  pushl %ebp
+  pushl %ebp  
   movl %esp, %ebp
 
+  { keep stack aligned to 16 bytes? }
+{$if FPC_STACKALIGNMENT=16}
+  leal  -8(%esp),%esp
+{$endif FPC_STACKALIGNMENT=16}
+  
   pushl %edi
   pushl %esi
 
   pushl %eax
   pushl %edx
-
+  
   cmpl $3, %ecx
   jle nostackargs
 
@@ -88,10 +93,17 @@ asm
   movl %ecx, %eax
   shll $2, %eax
 
+  { keep stack aligned to 16 bytes? }
+{$if FPC_STACKALIGNMENT=16}
+  addl $15, %eax
+  movl %eax, %esi
+  andl $15, %esi
+  subl %esi, %eax
+{$endif FPC_STACKALIGNMENT=16}
+  
   sub %eax, %esp
 
-  movl %esp, %edi
-
+  movl %esp, %edi  
   lea 12(%edx), %esi
 
   cld
@@ -103,8 +115,14 @@ nostackargs:
   movl (%edx), %eax
   movl 4(%edx), %edx
 
+{$if FPC_STACKALIGNMENT=16}
+  call -20(%ebp)
+  { ensure stack is cleared }
+  leal -24(%ebp),%esp
+{$else FPC_STACKALIGNMENT=16}  
   call -12(%ebp)
-
+{$endif FPC_STACKALIGNMENT=16}
+  
   popl %ecx
   movl %eax, (%ecx)
   movl %edx, 4(%ecx)
@@ -476,6 +494,11 @@ asm
   { store pointer to stack area (including GP registers) }
   lea (%esp), %edx
 
+{$if FPC_STACKALIGNMENT=16}
+  { keep stack aligned, before the call below stack must be aligned to a 16 byte boundary }
+  leal -8(%esp),%esp
+{$endif FPC_STACKALIGNMENT=16}
+  
   { also store ebx as we'll use that for the function address }
   pushl %ebx
 

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

@@ -136,6 +136,9 @@ type
     function AsBoolean: boolean;
     function AsCurrency: Currency;
     function AsInteger: Integer;
+    function AsChar: Char; inline;
+    function AsAnsiChar: AnsiChar;
+    function AsWideChar: WideChar;
     function AsInt64: Int64;
     function AsUInt64: QWord;
     function AsInterface: IInterface;
@@ -144,6 +147,9 @@ type
     function GetArrayElement(AIndex: SizeInt): TValue;
     procedure SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
     function IsType(ATypeInfo: PTypeInfo): boolean; inline;
+{$ifndef NoGenericMethods}
+    generic function IsType<T>: Boolean; inline;
+{$endif}
     function TryAsOrdinal(out AResult: int64): boolean;
     function GetReferenceToRawData: Pointer;
     procedure ExtractRawData(ABuffer: Pointer);
@@ -156,11 +162,13 @@ type
     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;
@@ -1822,6 +1830,8 @@ begin
       raise EInvalidCast.Create(SErrInvalidTypecast);
     end;
     end
+  else if Kind in [tkInteger, tkInt64, tkQWord] then
+    Result := AsInt64
   else
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
@@ -1847,6 +1857,13 @@ begin
   result := ATypeInfo = TypeInfo;
 end;
 
+{$ifndef NoGenericMethods}
+generic function TValue.IsType<T>: Boolean;
+begin
+  Result := IsType(PTypeInfo(System.TypeInfo(T)));
+end;
+{$endif}
+
 function TValue.AsObject: TObject;
 begin
   if IsObject or (IsClass and not Assigned(FData.FAsObject)) then
@@ -1925,6 +1942,31 @@ begin
     raise EInvalidCast.Create(SErrInvalidTypecast);
 end;
 
+function TValue.AsAnsiChar: AnsiChar;
+begin
+  if Kind = tkChar then
+    Result := Chr(FData.FAsUByte)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsWideChar: WideChar;
+begin
+  if Kind = tkWChar then
+    Result := WideChar(FData.FAsUWord)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsChar: Char;
+begin
+{$if SizeOf(Char) = 1}
+  Result := AsAnsiChar;
+{$else}
+  Result := AsWideChar;
+{$endif}
+end;
+
 function TValue.AsInt64: Int64;
 begin
   if Kind in [tkInteger, tkInt64, tkQWord] then
@@ -1987,6 +2029,9 @@ begin
     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, Integer(AsOrdinal));
+    tkChar: Result := AnsiChar(FData.FAsUByte);
+    tkWChar: Result := UTF8Encode(WideChar(FData.FAsUWord));
   else
     result := '';
   end;
@@ -2238,6 +2283,11 @@ begin
   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);
@@ -2263,6 +2313,10 @@ 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;
@@ -3823,16 +3877,30 @@ function TRttiProperty.GetValue(Instance: pointer): TValue;
   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:
@@ -3840,32 +3908,82 @@ begin
         s := GetStrProp(TObject(Instance), FPropInfo);
         TValue.Make(@s, FPropInfo^.PropType, result);
       end;
+    tkEnumeration:
+      begin
+        Values.Enum := Integer(GetOrdProp(TObject(Instance), FPropInfo));
+        ValueFromInt(Values.Enum);
+      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
+            Values.Cur := Currency(GetFloatProp(TObject(Instance), FPropInfo));
+            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
+            Values.Cp := Comp(GetFloatProp(TObject(Instance), FPropInfo));
+            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
@@ -3882,8 +4000,17 @@ begin
     tkQWord,
     tkChar,
     tkBool,
-    tkWChar:
+    tkWChar,
+    tkEnumeration:
       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, PPointer(AValue.GetReferenceToRawData)^);
   else
     raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
   end

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

@@ -38,16 +38,30 @@ type
     procedure TestPropGetValueProcInteger;
     procedure TestPropGetValueProcBoolean;
     procedure TestPropGetValueProcShortString;
+    procedure TestPropGetValueObject;
+    procedure TestPropGetValueInterface;
+    procedure TestPropGetValueFloat;
+    procedure TestPropGetValueDynArray;
+    procedure TestPropGetValueEnumeration;
+    procedure TestPropGetValueChars;
 
     procedure TestPropSetValueString;
     procedure TestPropSetValueInteger;
     procedure TestPropSetValueBoolean;
     procedure TestPropSetValueShortString;
+    procedure TestPropSetValueObject;
+    procedure TestPropSetValueInterface;
+    procedure TestPropSetValueFloat;
+    procedure TestPropSetValueDynArray;
+    procedure TestPropSetValueEnumeration;
+    procedure TestPropSetValueChars;
 
     procedure TestGetValueStringCastError;
     procedure TestGetIsReadable;
     procedure TestIsWritable;
 
+    procedure TestIsType;
+
     procedure TestMakeNil;
     procedure TestMakeObject;
     procedure TestMakeArrayDynamic;
@@ -114,6 +128,9 @@ type
   TGetClassPropertiesSub = class(TGetClassProperties)
 
   end;
+
+  TTestDynArray = array of Integer;
+  TTestEnumeration = (en1, en2, en3, en4);
   {$M-}
 
   { TTestValueClass }
@@ -121,18 +138,38 @@ type
   {$M+}
   TTestValueClass = class
   private
+    FAArray: TTestDynArray;
+    FAChar: AnsiChar;
+    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;
     function GetAShortString: ShortString;
     procedure SetWriteOnly(AValue: integer);
   published
+    property AArray: TTestDynArray read FAArray write FAArray;
+    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;
@@ -140,6 +177,8 @@ type
     property AGetBoolean: boolean read GetABoolean;
     property AGetShortString: ShortString read GetAShortString;
     property AWriteOnly: integer write SetWriteOnly;
+    property AChar: AnsiChar read FAChar write FAChar;
+    property AWideChar: WideChar read FAWideChar write FAWideChar;
   end;
   {$M-}
 
@@ -716,6 +755,7 @@ begin
 
   Check(v.GetReferenceToRawData <> @c);
   Check(AnsiChar(v.AsOrdinal) = #20);
+  Check(v.AsAnsiChar = #20);
 end;
 
 procedure TTestCase1.TestMakeWideChar;
@@ -735,6 +775,7 @@ begin
 
   Check(v.GetReferenceToRawData <> @c);
   Check(WideChar(v.AsOrdinal) = #$1234);
+  Check(v.AsWideChar = #$1234);
 end;
 
 procedure TTestCase1.MakeFromOrdinalTObject;
@@ -839,6 +880,33 @@ begin
   end;
 end;
 
+procedure TTestCase1.TestIsType;
+type
+  TMyLongInt = type LongInt;
+var
+  v: TValue;
+  l: LongInt;
+  ml: TMyLongInt;
+begin
+  l := 42;
+  ml := 42;
+  TValue.Make(@l, TypeInfo(l), v);
+  Check(v.IsType(TypeInfo(l)));
+  Check(not v.IsType(TypeInfo(ml)));
+  Check(not v.IsType(TypeInfo(String)));
+  Check(v.specialize IsType<LongInt>);
+  Check(not v.specialize IsType<TMyLongInt>);
+  Check(not v.specialize IsType<String>);
+
+  TValue.Make(@ml, TypeInfo(ml), v);
+  Check(v.IsType(TypeInfo(ml)));
+  Check(not v.IsType(TypeInfo(l)));
+  Check(not v.IsType(TypeInfo(String)));
+  Check(v.specialize IsType<TMyLongInt>);
+  Check(not v.specialize IsType<LongInt>);
+  Check(not v.specialize IsType<String>);
+end;
+
 procedure TTestCase1.TestPropGetValueBoolean;
 var
   ATestClass : TTestValueClass;
@@ -1030,6 +1098,225 @@ begin
   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;
+  i: IInterface;
+begin
+  c := TRttiContext.Create;
+  i := TInterfacedObject.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AUnknown := i;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('AUnknown');
+      AValue := AProperty.GetValue(ATestClass);
+      Check(i = AValue.AsInterface);
+    finally
+      AtestClass.Free;
+    end;
+    Check(i = AValue.AsInterface);
+  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;
+  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.AsOrdinal);
+      ATestClass.AEnumeration := en1;
+      CheckEquals(Ord(en3), AValue.AsOrdinal);
+      CheckEquals('en3', AValue.ToString);
+      CheckEquals(True, AValue.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals(Ord(en3),AValue.AsOrdinal);
+  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.AsAnsiChar);
+      ATestClass.AChar := 'N';
+      CheckEquals('C', AValueC.AsAnsiChar);
+      CheckEquals('C', AValueC.ToString);
+      CheckEquals(True, AValueC.IsOrdinal);
+
+      AProperty := ARttiType.GetProperty('AWideChar');
+      AValueW := AProperty.GetValue(ATestClass);
+      CheckEquals('W',AValueW.AsWideChar);
+      ATestClass.AWideChar := 'Z';
+      CheckEquals('W', AValueW.AsWideChar);
+      CheckEquals('W', AValueW.ToString);
+      CheckEquals(True, AValueW.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+
+    CheckEquals('C',AValueC.AsAnsiChar);
+    CheckEquals('W',AValueW.AsWideChar);
+  finally
+    c.Free;
+  end;
+end;
+
 procedure TTestCase1.TestPropSetValueString;
 var
   ATestClass : TTestValueClass;
@@ -1153,9 +1440,264 @@ begin
       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;
+  finally
+    c.Free;
+  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;
+  TypeInfo: PTypeInfo;
+  i: IInterface;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('AUnknown');
+      TypeInfo := GetPropInfo(ATestClass, 'AUnknown')^.PropType;
+
+      i := TInterfacedObject.Create;
+      TValue.Make(@i, TypeInfo, AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      Check(ATestClass.AUnknown = i);
+
+      i := TInterfacedObject.Create;
+      AProperty.SetValue(ATestClass, i);
+      Check(ATestClass.AUnknown = i);
+    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.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.AsAnsiChar);
+
+      AProperty := ARttiType.GetProperty('AWideChar');
+      AValueW := AProperty.GetValue(ATestClass);
+      CheckEquals('W', AValueW.AsWideChar);
     finally
       AtestClass.Free;
     end;
+      CheckEquals('C', AValueC.AsAnsiChar);
+      CheckEquals('W', AValueW.AsWideChar);
   finally
     c.Free;
   end;

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

@@ -14,6 +14,9 @@ type
   TValueHelper = record helper for TValue
     function AsUnicodeString: UnicodeString;
     function AsAnsiString: AnsiString;
+    function AsChar: Char; inline;
+    function AsAnsiChar: AnsiChar;
+    function AsWideChar: WideChar;
   end;
 {$endif}
 
@@ -56,6 +59,25 @@ function TValueHelper.AsAnsiString: AnsiString;
 begin
   Result := AnsiString(AsString);
 end;
+
+function TValue.AsWideChar: WideChar;
+begin
+  if Kind <> tkWideChar then
+    raise EInvalidCast.Create('Invalid cast');
+  Result := WideChar(Word(AsOrdinal));
+end;
+
+function TValue.AsAnsiChar: AnsiChar;
+begin
+  if Kind <> tkChar then
+    raise EInvalidCast.Create('Invalid cast');
+  Result := AnsiChar(Byte(AsOrdinal));
+end;
+
+function TValue.AsChar: Char;
+begin
+  Result := AsWideChar;
+end;
 {$endif}
 
 function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;