+ add RTTI unit from Joost's Attribute branch

* adjust unit to work without attributes * adjust unit to work without unit list (TRttiContext.GetTypes is disabled due to this) + add ShortString support (due to an intermediary test I had done in $H-) + add unit test from Joost's Attribute branch * adjust unit test accordingly (no attributes, no TRttiContext.GetTypes) + add ShortString tests + add testrunner for RTL-ObjPas tests using the new simpletestrunner git-svn-id: trunk@35096 -
2025-04-20 11:09:42 +02:00 · 2016-12-09 20:45:46 +00:00 · 2016-12-09 20:45:46 +00:00 · 3e5f8af01d
commit 3e5f8af01d
parent 933e449848
5 changed files with 1651 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -7148,6 +7148,7 @@ packages/rtl-objpas/Makefile svneol=native#text/plain
 packages/rtl-objpas/Makefile.fpc svneol=native#text/plain
 packages/rtl-objpas/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/rtl-objpas/fpmake.pp svneol=native#text/plain
+packages/rtl-objpas/src/common/rtti.pp svneol=native#text/plain
 packages/rtl-objpas/src/common/varutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/inc/convutil.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/convutil.pp svneol=native#text/plain
@ -7165,6 +7166,8 @@ packages/rtl-objpas/src/inc/varutilh.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/varutils.inc svneol=native#text/plain
 packages/rtl-objpas/src/inc/widestrutils.pp svneol=native#text/plain
 packages/rtl-objpas/src/win/varutils.pp svneol=native#text/plain
+packages/rtl-objpas/tests/testrunner.rtlobjpas.pp svneol=native#text/pascal
+packages/rtl-objpas/tests/tests.rtti.pas svneol=native#text/plain
 packages/rtl-unicode/Makefile svneol=native#text/plain
 packages/rtl-unicode/Makefile.fpc svneol=native#text/plain
 packages/rtl-unicode/fpmake.pp svneol=native#text/plain
--- a/packages/rtl-objpas/fpmake.pp
+++ b/packages/rtl-objpas/fpmake.pp
@ -116,6 +116,9 @@ begin
       AddUnit('varutils');
       // AddUnit('Math');
     end;
+
+    T:=P.Targets.AddUnit('rtti.pp',CommonSrcOSes);
+    T.ResourceStrings:=true;
  end
 end;
 
--- a/packages/rtl-objpas/src/common/rtti.pp
+++ b/packages/rtl-objpas/src/common/rtti.pp
@ -0,0 +1,929 @@
+{
+  This file is part of the Free Pascal run time library.
+  Copyright (C) 2013 Joost van der Sluis joost@cnoc.nl
+  member of the Free Pascal development team.
+
+  Extended RTTI compatibility unit
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+unit Rtti;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  typinfo;
+
+type
+  TRttiType = class;
+  TRttiProperty = class;
+  TRttiInstanceType = class;
+
+  IValueData = interface
+  ['{1338B2F3-2C21-4798-A641-CA2BC5BF2396}']
+    procedure ExtractRawData(ABuffer: pointer);
+    procedure ExtractRawDataNoCopy(ABuffer: pointer);
+    function GetDataSize: integer;
+    function GetReferenceToRawData: pointer;
+  end;
+
+  TValueData = record
+    FTypeInfo: PTypeInfo;
+    FValueData: IValueData;
+    case integer of
+      0:  (FAsUByte: Byte);
+      1:  (FAsUWord: Word);
+      2:  (FAsULong: LongWord);
+      3:  (FAsObject: Pointer);
+      4:  (FAsClass: TClass);
+      5:  (FAsSByte: Shortint);
+      9:  (FAsDouble: Double);
+      10: (FAsExtenden: Extended);
+      12: (FAsCurr: Currency);
+      14: (FAsSInt64: Int64);
+  end;
+
+  { TValue }
+
+  TValue = object
+  private
+    FData: TValueData;
+    function GetTypeDataProp: PTypeData;
+    function GetTypeInfo: PTypeInfo;
+    function GetTypeKind: TTypeKind;
+    function GetIsEmpty: boolean;
+  public
+    class function Empty: TValue;
+    class procedure Make(ABuffer: pointer; ATypeInfo: PTypeInfo; out result: TValue);
+    function IsArray: boolean;
+    function AsString: string;
+    function AsExtended: Extended;
+    function IsClass: boolean;
+    function AsClass: TClass;
+    function IsObject: boolean;
+    function AsObject: TObject;
+    function IsOrdinal: boolean;
+    function AsOrdinal: Int64;
+    function AsBoolean: boolean;
+    function AsCurrency: Currency;
+    function AsInteger: Integer;
+    function ToString: string;
+    function IsType(ATypeInfo: PTypeInfo): boolean;
+    function TryAsOrdinal(out AResult: int64): boolean;
+    property Kind: TTypeKind read GetTypeKind;
+    property TypeData: PTypeData read GetTypeDataProp;
+    property TypeInfo: PTypeInfo read GetTypeInfo;
+    property IsEmpty: boolean read GetIsEmpty;
+  end;
+
+  { TRttiContext }
+
+  TRttiContext = record
+  private
+    FContextToken: IInterface;
+  public
+    class function Create: TRttiContext; static;
+    procedure  Free;
+    function GetType(ATypeInfo: PTypeInfo): TRttiType;
+    function GetType(AClass: TClass): TRttiType;
+    //function GetTypes: specialize TArray<TRttiType>;
+  end;
+
+  { TRttiObject }
+
+  TRttiObject = class
+  public
+
+  end;
+
+  { TRttiNamedObject }
+
+  TRttiNamedObject = class(TRttiObject)
+  protected
+    function GetName: string; virtual;
+  public
+    property Name: string read GetName;
+  end;
+
+  { TRttiType }
+
+  TRttiType = class(TRttiNamedObject)
+  private
+    FTypeInfo: PTypeInfo;
+    FPropertiesResolved: boolean;
+    FProperties: specialize TArray<TRttiProperty>;
+    function GetAsInstance: TRttiInstanceType;
+  protected
+    FTypeData: PTypeData;
+    function GetName: string; override;
+    function GetIsInstance: boolean; virtual;
+    function GetIsManaged: boolean; virtual;
+    function GetIsOrdinal: boolean; virtual;
+    function GetIsRecord: boolean; virtual;
+    function GetIsSet: boolean; virtual;
+    function GetTypeKind: TTypeKind; virtual;
+    function GetTypeSize: integer; virtual;
+    function GetBaseType: TRttiType; virtual;
+  public
+    constructor create(ATypeInfo : PTypeInfo);
+    function GetProperties: specialize TArray<TRttiProperty>;
+    function GetProperty(const AName: string): TRttiProperty; virtual;
+    destructor destroy; override;
+    property IsInstance: boolean read GetIsInstance;
+    property isManaged: boolean read GetIsManaged;
+    property IsOrdinal: boolean read GetIsOrdinal;
+    property IsRecord: boolean read GetIsRecord;
+    property IsSet: boolean read GetIsSet;
+    property BaseType: TRttiType read GetBaseType;
+    property AsInstance: TRttiInstanceType read GetAsInstance;
+    property TypeKind: TTypeKind read GetTypeKind;
+    property TypeSize: integer read GetTypeSize;
+  end;
+
+  TRttiStructuredType = class(TRttiType)
+
+  end;
+
+  { TRttiFloatType }
+
+  TRttiFloatType = class(TRttiType)
+  private
+    function GetFloatType: TFloatType;
+  public
+    property FloatType: TFloatType read GetFloatType;
+  end;
+
+
+  TRttiStringKind = (skShortString, skAnsiString, skWideString, skUnicodeString);
+
+  { TRttiStringType }
+
+  TRttiStringType = class(TRttiType)
+  private
+    function GetStringKind: TRttiStringKind;
+  public
+    property StringKind: TRttiStringKind read GetStringKind;
+  end;
+
+
+  { TRttiInstanceType }
+
+  TRttiInstanceType = class(TRttiStructuredType)
+  private
+    function GetDeclaringUnitName: string;
+    function GetMetaClassType: TClass;
+  protected
+    function GetIsInstance: boolean; override;
+    function GetTypeSize: integer; override;
+    function GetBaseType: TRttiType; override;
+  public
+    property MetaClassType: TClass read GetMetaClassType;
+    property DeclaringUnitName: string read GetDeclaringUnitName;
+
+  end;
+
+  { TRttiMember }
+
+  TMemberVisibility=(mvPrivate, mvProtected, mvPublic, mvPublished);
+
+  TRttiMember = class(TRttiNamedObject)
+  private
+    FParent: TRttiType;
+  protected
+    function GetVisibility: TMemberVisibility; virtual;
+  public
+    constructor create(AParent: TRttiType);
+    property Visibility: TMemberVisibility read GetVisibility;
+    property Parent: TRttiType read FParent;
+  end;
+
+  { TRttiProperty }
+
+  TRttiProperty = class(TRttiMember)
+  private
+    FPropInfo: PPropInfo;
+    function GetPropertyType: TRttiType;
+    function GetIsWritable: boolean;
+    function GetIsReadable: boolean;
+  protected
+    function GetVisibility: TMemberVisibility; override;
+    function GetName: string; override;
+  public
+    constructor create(AParent: TRttiType; APropInfo: PPropInfo);
+    function GetValue(Instance: pointer): TValue;
+    procedure SetValue(Instance: pointer; const AValue: TValue);
+    property PropertyType: TRttiType read GetPropertyType;
+    property IsReadable: boolean read GetIsReadable;
+    property IsWritable: boolean read GetIsWritable;
+    property Visibility: TMemberVisibility read GetVisibility;
+  end;
+
+function IsManaged(TypeInfo: PTypeInfo): boolean;
+
+implementation
+
+type
+
+  { TRttiPool }
+
+  TRttiPool = class
+  private
+    FTypesList: specialize TArray<TRttiType>;
+    FTypeCount: LongInt;
+    FLock: TRTLCriticalSection;
+  public
+    function GetTypes: specialize TArray<TRttiType>;
+    function GetType(ATypeInfo: PTypeInfo): TRttiType;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  IPooltoken = interface
+  ['{3CDB3CE9-AB55-CBAA-7B9D-2F3BB1CF5AF8}']
+    function RttiPool: TRttiPool;
+  end;
+
+  { TPoolToken }
+
+  TPoolToken = class(TInterfacedObject, IPooltoken)
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function RttiPool: TRttiPool;
+  end;
+
+  { TValueDataIntImpl }
+
+  TValueDataIntImpl = class(TInterfacedObject, IValueData)
+  private
+    FDataSize: integer;
+    FBuffer: pointer;
+  public
+    constructor Create(ACopyFromBuffer: Pointer; ALen: integer);
+    destructor Destroy; override;
+    procedure ExtractRawData(ABuffer: pointer);
+    procedure ExtractRawDataNoCopy(ABuffer: pointer);
+    function GetDataSize: integer;
+    function GetReferenceToRawData: pointer;
+  end;
+
+resourcestring
+  SErrUnableToGetValueForType = 'Unable to get value for type %s';
+  SErrUnableToSetValueForType = 'Unable to set value for type %s';
+  SErrInvalidTypecast         = 'Invalid class typecast';
+
+var
+  PoolRefCount : integer;
+  GRttiPool    : TRttiPool;
+
+function IsManaged(TypeInfo: PTypeInfo): boolean;
+begin
+  result := TypeInfo^.Kind in [tkString, tkAString, tkLString, tkInterface, tkArray, tkDynArray];
+end;
+
+{ TRttiPool }
+
+function TRttiPool.GetTypes: specialize TArray<TRttiType>;
+begin
+  if not Assigned(FTypesList) then
+    Exit(Nil);
+  EnterCriticalsection(FLock);
+  Result := Copy(FTypesList, 0, FTypeCount);
+  LeaveCriticalsection(FLock);
+end;
+
+function TRttiPool.GetType(ATypeInfo: PTypeInfo): TRttiType;
+var
+  i: integer;
+begin
+  if not Assigned(ATypeInfo) then
+    Exit(Nil);
+  EnterCriticalsection(FLock);
+  Result := Nil;
+  for i := 0 to FTypeCount - 1 do
+    begin
+      if FTypesList[i].FTypeInfo = ATypeInfo then
+        begin
+          Result := FTypesList[i];
+          Break;
+        end;
+    end;
+  if not Assigned(Result) then
+    begin
+      if FTypeCount = Length(FTypesList) then
+        begin
+          SetLength(FTypesList, FTypeCount * 2);
+        end;
+      case ATypeInfo^.Kind of
+        tkClass   : Result := TRttiInstanceType.Create(ATypeInfo);
+        tkSString,
+        tkLString,
+        tkAString,
+        tkUString,
+        tkWString : Result := TRttiStringType.Create(ATypeInfo);
+        tkFloat   : Result := TRttiFloatType.Create(ATypeInfo);
+      else
+        Result := TRttiType.Create(ATypeInfo);
+      end;
+      FTypesList[FTypeCount] := Result;
+      Inc(FTypeCount);
+    end;
+  LeaveCriticalsection(FLock);
+end;
+
+constructor TRttiPool.Create;
+begin
+  InitCriticalSection(FLock);
+  SetLength(FTypesList, 32);
+end;
+
+destructor TRttiPool.Destroy;
+var
+  i: LongInt;
+begin
+  for i := 0 to length(FTypesList)-1 do
+    FTypesList[i].Free;
+  DoneCriticalsection(FLock);
+  inherited Destroy;
+end;
+
+{ TPoolToken }
+
+constructor TPoolToken.Create;
+begin
+  inherited Create;
+  if InterlockedIncrement(PoolRefCount)=1 then
+    GRttiPool := TRttiPool.Create;
+end;
+
+destructor TPoolToken.Destroy;
+begin
+  if InterlockedDecrement(PoolRefCount)=0 then
+    GRttiPool.Free;
+  inherited;
+end;
+
+function TPoolToken.RttiPool: TRttiPool;
+begin
+  result := GRttiPool;
+end;
+
+{ TValueDataIntImpl }
+
+constructor TValueDataIntImpl.create(ACopyFromBuffer: Pointer; ALen: integer);
+begin
+  FDataSize:=ALen;
+  if ALen>0 then
+    begin
+      Getmem(FBuffer,FDataSize);
+      system.move(ACopyFromBuffer^,FBuffer^,FDataSize);
+    end;
+end;
+
+destructor TValueDataIntImpl.Destroy;
+begin
+  if assigned(FBuffer) then
+    Freemem(FBuffer);
+  inherited Destroy;
+end;
+
+procedure TValueDataIntImpl.ExtractRawData(ABuffer: pointer);
+begin
+  system.move(FBuffer^,ABuffer^,FDataSize);
+end;
+
+procedure TValueDataIntImpl.ExtractRawDataNoCopy(ABuffer: pointer);
+begin
+  system.move(FBuffer^,ABuffer^,FDataSize);
+end;
+
+function TValueDataIntImpl.GetDataSize: integer;
+begin
+  result := FDataSize;
+end;
+
+function TValueDataIntImpl.GetReferenceToRawData: pointer;
+begin
+  result := FBuffer;
+end;
+
+{ TRttiFloatType }
+
+function TRttiFloatType.GetFloatType: TFloatType;
+begin
+  result := FTypeData^.FloatType;
+end;
+
+{ TValue }
+
+class function TValue.Empty: TValue;
+begin
+  result.FData.FTypeInfo := nil;
+end;
+
+class procedure TValue.Make(ABuffer: pointer; ATypeInfo: PTypeInfo; out result: TValue);
+begin
+  result.FData.FTypeInfo:=ATypeInfo;
+  case ATypeInfo^.Kind of
+    tkSString  : result.FData.FValueData := TValueDataIntImpl.Create(@PShortString(ABuffer)^[1],Length(PShortString(ABuffer)^));
+    tkAString  : result.FData.FValueData := TValueDataIntImpl.Create(@PAnsiString(ABuffer)^[1],length(PAnsiString(ABuffer)^));
+    tkClass    : result.FData.FAsObject := PPointer(ABuffer)^;
+    tkInteger  : result.FData.FAsSInt64 := PInt64(ABuffer)^;
+    tkBool     : result.FData.FAsSInt64 := Int64(PBoolean(ABuffer)^);
+    tkFloat    : begin
+                   case GetTypeData(ATypeInfo)^.FloatType of
+                     ftCurr   : result.FData.FAsCurr := PCurrency(ABuffer)^;
+                     ftDouble : result.FData.FAsDouble := PDouble(ABuffer)^;
+                   end;
+                 end;
+  else
+    raise Exception.CreateFmt(SErrUnableToGetValueForType,[ATypeInfo^.Name]);
+  end;
+end;
+
+
+function TValue.GetTypeDataProp: PTypeData;
+begin
+  result := GetTypeData(FData.FTypeInfo);
+end;
+
+function TValue.GetTypeInfo: PTypeInfo;
+begin
+  result := FData.FTypeInfo;
+end;
+
+function TValue.GetTypeKind: TTypeKind;
+begin
+  result := FData.FTypeInfo^.Kind;
+end;
+
+function TValue.GetIsEmpty: boolean;
+begin
+  result := (FData.FTypeInfo=nil);
+end;
+
+function TValue.IsArray: boolean;
+begin
+  result := kind in [tkArray, tkDynArray];
+end;
+
+function TValue.AsString: string;
+var
+  s: string;
+begin
+  case Kind of
+    tkSString,
+    tkAString   : begin
+                    setlength(s,FData.FValueData.GetDataSize);
+                    system.move(FData.FValueData.GetReferenceToRawData^,s[1],FData.FValueData.GetDataSize);
+                  end;
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+  end;
+  result := s;
+end;
+
+function TValue.AsExtended: Extended;
+begin
+  if Kind = tkFloat then
+    begin
+    case TypeData^.FloatType of
+      ftDouble   : result := FData.FAsDouble;
+      ftExtended : result := FData.FAsExtenden;
+    else
+      raise EInvalidCast.Create(SErrInvalidTypecast);
+    end;
+    end
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsObject: TObject;
+begin
+  if IsObject then
+    result := TObject(FData.FAsObject)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.IsObject: boolean;
+begin
+  result := fdata.FTypeInfo^.Kind = tkClass;
+end;
+
+function TValue.IsClass: boolean;
+begin
+  result := false;
+end;
+
+function TValue.AsClass: TClass;
+begin
+  if IsClass then
+    result := FData.FAsClass
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.IsOrdinal: boolean;
+begin
+  result := Kind in [tkInteger, tkInt64, tkBool];
+end;
+
+function TValue.AsBoolean: boolean;
+begin
+  if (Kind = tkBool) then
+    result := boolean(FData.FAsSInt64)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsOrdinal: int64;
+begin
+  if IsOrdinal then
+    result := FData.FAsSInt64
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsCurrency: Currency;
+begin
+  if (Kind = tkFloat) and (TypeData^.FloatType=ftCurr) then
+    result := FData.FAsCurr
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.AsInteger: Integer;
+begin
+  if Kind in [tkInteger, tkInt64] then
+    result := integer(FData.FAsSInt64)
+  else
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+end;
+
+function TValue.ToString: String;
+begin
+  case Kind of
+    tkSString,
+    tkAString : result := AsString;
+    tkInteger : result := IntToStr(AsInteger);
+    tkBool    : result := BoolToStr(AsBoolean, True);
+  else
+    result := '';
+  end;
+end;
+
+function TValue.IsType(ATypeInfo: PTypeInfo): boolean;
+begin
+  result := ATypeInfo = TypeInfo;
+end;
+
+function TValue.TryAsOrdinal(out AResult: int64): boolean;
+begin
+  result := IsOrdinal;
+  if result then
+    AResult := AsOrdinal;
+end;
+
+
+{ TRttiStringType }
+
+function TRttiStringType.GetStringKind: TRttiStringKind;
+begin
+  case TypeKind of
+    tkSString : result := skShortString;
+    tkLString : result := skAnsiString;
+    tkAString : result := skAnsiString;
+    tkUString : result := skUnicodeString;
+    tkWString : result := skWideString;
+  end;
+end;
+
+{ TRttiInstanceType }
+
+function TRttiInstanceType.GetMetaClassType: TClass;
+begin
+  result := FTypeData^.ClassType;
+end;
+
+function TRttiInstanceType.GetDeclaringUnitName: string;
+begin
+  result := FTypeData^.UnitName;
+end;
+
+function TRttiInstanceType.GetBaseType: TRttiType;
+var
+  AContext: TRttiContext;
+begin
+  AContext := TRttiContext.Create;
+  try
+    result := AContext.GetType(FTypeData^.ParentInfo);
+  finally
+    AContext.Free;
+  end;
+end;
+
+function TRttiInstanceType.GetIsInstance: boolean;
+begin
+  Result:=True;
+end;
+
+function TRttiInstanceType.GetTypeSize: integer;
+begin
+  Result:=sizeof(TObject);
+end;
+
+{ TRttiMember }
+
+function TRttiMember.GetVisibility: TMemberVisibility;
+begin
+  result := mvPublished;
+end;
+
+constructor TRttiMember.create(AParent: TRttiType);
+begin
+  inherited create();
+  FParent := AParent;
+end;
+
+{ TRttiProperty }
+
+function TRttiProperty.GetPropertyType: TRttiType;
+begin
+  result := GRttiPool.GetType(FPropInfo^.PropType);
+end;
+
+function TRttiProperty.GetIsReadable: boolean;
+begin
+  result := assigned(FPropInfo^.GetProc);
+end;
+
+function TRttiProperty.GetIsWritable: boolean;
+begin
+  result := assigned(FPropInfo^.SetProc);
+end;
+
+function TRttiProperty.GetVisibility: TMemberVisibility;
+begin
+  // At this moment only pulished rtti-property-info is supported by fpc
+  result := mvPublished;
+end;
+
+function TRttiProperty.GetName: string;
+begin
+  Result:=FPropInfo^.Name;
+end;
+
+constructor TRttiProperty.create(AParent: TRttiType; APropInfo: PPropInfo);
+begin
+  inherited create(AParent);
+  FPropInfo := APropInfo;
+end;
+
+function TRttiProperty.GetValue(Instance: pointer): TValue;
+var
+  s: string;
+  ss: ShortString;
+  i: int64;
+begin
+  case FPropinfo^.PropType^.Kind of
+    tkSString:
+      begin
+        ss := GetStrProp(TObject(Instance), FPropInfo);
+        TValue.Make(@ss, FPropInfo^.PropType, result);
+      end;
+    tkAString:
+      begin
+        s := GetStrProp(TObject(Instance), FPropInfo);
+        TValue.Make(@s, FPropInfo^.PropType, result);
+      end;
+    tkInteger,
+    tkInt64,
+    tkQWord,
+    tkChar,
+    tkBool,
+    tkWChar:
+      begin
+        i := GetOrdProp(TObject(Instance), FPropInfo);
+        TValue.Make(@i, FPropInfo^.PropType, result);
+      end;
+  else
+    result := TValue.Empty;
+  end
+end;
+
+procedure TRttiProperty.SetValue(Instance: pointer; const AValue: TValue);
+begin
+  case FPropinfo^.PropType^.Kind of
+    tkSString,
+    tkAString:
+      SetStrProp(TObject(Instance), FPropInfo, AValue.AsString);
+    tkInteger,
+    tkInt64,
+    tkQWord,
+    tkChar,
+    tkBool,
+    tkWChar:
+      SetOrdProp(TObject(Instance), FPropInfo, AValue.AsOrdinal);
+  else
+    raise exception.createFmt(SErrUnableToSetValueForType, [PropertyType.Name]);
+  end
+end;
+
+function TRttiType.GetIsInstance: boolean;
+begin
+  result := false;
+end;
+
+function TRttiType.GetIsManaged: boolean;
+begin
+  result := Rtti.IsManaged(FTypeInfo);
+end;
+
+function TRttiType.GetIsOrdinal: boolean;
+begin
+  result := false;
+end;
+
+function TRttiType.GetIsRecord: boolean;
+begin
+  result := false;
+end;
+function TRttiType.GetIsSet: boolean;
+
+begin
+  result := false;
+end;
+
+function TRttiType.GetAsInstance: TRttiInstanceType;
+begin
+  // This is a ridicoulous design, but Delphi-compatible...
+  result := TRttiInstanceType(self);
+end;
+
+function TRttiType.GetBaseType: TRttiType;
+begin
+  result := nil;
+end;
+
+function TRttiType.GetTypeKind: TTypeKind;
+begin
+  result := FTypeInfo^.Kind;
+end;
+
+function TRttiType.GetTypeSize: integer;
+begin
+  result := -1;
+end;
+
+function TRttiType.GetName: string;
+begin
+  Result:=FTypeInfo^.Name;
+end;
+
+constructor TRttiType.create(ATypeInfo: PTypeInfo);
+begin
+  inherited create();
+  FTypeInfo:=ATypeInfo;
+  if assigned(FTypeInfo) then
+    FTypeData:=GetTypeData(ATypeInfo);
+end;
+
+function aligntoptr(p : pointer) : pointer;inline;
+   begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+     result:=align(p,sizeof(p));
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+     result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+   end;
+
+function TRttiType.GetProperties: specialize TArray<TRttiProperty>;
+type
+  PPropData = ^TPropData;
+var
+  TypeInfo: PTypeInfo;
+  TypeRttiType: TRttiType;
+  TD: PTypeData;
+  PPD: PPropData;
+  TP: PPropInfo;
+  Count: longint;
+begin
+  if not FPropertiesResolved then
+    begin
+      TypeInfo := FTypeInfo;
+
+      // Get the total properties count
+      SetLength(FProperties,FTypeData^.PropCount);
+      // Clear list
+      FillChar(FProperties[0],FTypeData^.PropCount*sizeof(TRttiProperty),0);
+      TypeRttiType:= self;
+      repeat
+        TD:=GetTypeData(TypeInfo);
+
+        // published properties count for this object
+        // skip the attribute-info if available
+        PPD := PPropData(pointer(@TD^.UnitName)+PByte(@TD^.UnitName)^+1);
+        Count:=PPD^.PropCount;
+        // Now point TP to first propinfo record.
+        TP:=PPropInfo(@PPD^.PropList);
+        While Count>0 do
+          begin
+            // Don't overwrite properties with the same name
+            if FProperties[TP^.NameIndex]=nil then
+              FProperties[TP^.NameIndex]:=TRttiProperty.Create(TypeRttiType, TP);
+
+            // Point to TP next propinfo record.
+            // Located at Name[Length(Name)+1] !
+            TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
+            Dec(Count);
+          end;
+        TypeInfo:=TD^.Parentinfo;
+        TypeRttiType:= GRttiPool.GetType(TypeInfo);
+      until TypeInfo=nil;
+    end;
+
+  result := FProperties;
+end;
+
+function TRttiType.GetProperty(const AName: string): TRttiProperty;
+var
+  FPropList: specialize TArray<TRttiProperty>;
+  i: Integer;
+begin
+  result := nil;
+  FPropList := GetProperties;
+  for i := 0 to length(FPropList)-1 do
+    if sametext(FPropList[i].Name,AName) then
+      begin
+        result := FPropList[i];
+        break;
+      end;
+end;
+
+destructor TRttiType.Destroy;
+var
+  i: Integer;
+begin
+  for i := 0 to high(FProperties) do
+    FProperties[i].Free;
+  inherited destroy;
+end;
+
+{ TRttiNamedObject }
+
+function TRttiNamedObject.GetName: string;
+begin
+  result := '';
+end;
+
+{ TRttiContext }
+
+class function TRttiContext.Create: TRttiContext;
+begin
+  result.FContextToken := nil;
+end;
+
+procedure TRttiContext.Free;
+begin
+  FContextToken := nil;
+end;
+
+function TRttiContext.GetType(ATypeInfo: PTypeInfo): TRttiType;
+begin
+  if not assigned(FContextToken) then
+    FContextToken := TPoolToken.Create;
+  result := (FContextToken as IPooltoken).RttiPool.GetType(ATypeInfo);
+end;
+
+
+function TRttiContext.GetType(AClass: TClass): TRttiType;
+begin
+  if assigned(AClass) then
+    result := GetType(PTypeInfo(AClass.ClassInfo))
+  else
+    result := nil;
+end;
+
+{function TRttiContext.GetTypes: specialize TArray<TRttiType>;
+
+begin
+  if not assigned(FContextToken) then
+    FContextToken := TPoolToken.Create;
+  result := (FContextToken as IPooltoken).RttiPool.GetTypes;
+end;}
+
+initialization
+  PoolRefCount := 0;
+end.
+
--- a/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
+++ b/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
@ -0,0 +1,18 @@
+program testrunner.rtlobjpas;
+
+{$mode objfpc}{$H+}
+
+uses
+  simpletestrunner,
+  tests.rtti;
+
+var
+  Application: TTestRunner;
+
+begin
+  Application := TTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'RTL-ObjPas unit tests';
+  Application.Run;
+  Application.Free;
+end.
--- a/packages/rtl-objpas/tests/tests.rtti.pas
+++ b/packages/rtl-objpas/tests/tests.rtti.pas
@ -0,0 +1,698 @@
+unit tests.rtti;
+
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+{$IFDEF FPC}
+  fpcunit,testregistry, testutils,
+{$ELSE FPC}
+  TestFramework,
+{$ENDIF FPC}
+  Classes, SysUtils, typinfo,
+  Rtti;
+
+type
+
+  { TTestCase1 }
+
+  TTestCase1= class(TTestCase)
+  published
+    //procedure GetTypes;
+    procedure GetTypeInteger;
+    procedure GetClassProperties;
+
+    procedure GetClassPropertiesValue;
+
+    procedure TestTRttiTypeProperties;
+    procedure TestPropGetValueString;
+    procedure TestPropGetValueInteger;
+    procedure TestPropGetValueBoolean;
+    procedure TestPropGetValueShortString;
+    procedure TestPropGetValueProcString;
+    procedure TestPropGetValueProcInteger;
+    procedure TestPropGetValueProcBoolean;
+    procedure TestPropGetValueProcShortString;
+
+    procedure TestPropSetValueString;
+    procedure TestPropSetValueInteger;
+    procedure TestPropSetValueBoolean;
+    procedure TestPropSetValueShortString;
+
+    procedure TestGetValueStringCastError;
+    procedure TestMakeObject;
+    procedure TestGetIsReadable;
+    procedure TestIsWritable;
+  end;
+
+implementation
+
+type
+
+  TGetClassProperties = class
+  private
+    FPubPropRO: integer;
+    FPubPropRW: integer;
+  published
+    property PubPropRO: integer read FPubPropRO;
+    property PubPropRW: integer read FPubPropRW write FPubPropRW;
+    property PubPropSetRO: integer read FPubPropRO;
+    property PubPropSetRW: integer read FPubPropRW write FPubPropRW;
+  end;
+
+  { TTestValueClass }
+
+  TTestValueClass = class
+  private
+    FAInteger: integer;
+    FAString: string;
+    FABoolean: boolean;
+    FAShortString: ShortString;
+    function GetAInteger: integer;
+    function GetAString: string;
+    function GetABoolean: boolean;
+    function GetAShortString: ShortString;
+    procedure SetWriteOnly(AValue: integer);
+  published
+    property AInteger: Integer read FAInteger write FAInteger;
+    property AString: string read FAString write FAString;
+    property ABoolean: boolean read FABoolean write FABoolean;
+    property AShortString: ShortString read FAShortString write FAShortString;
+    property AGetInteger: Integer read GetAInteger;
+    property AGetString: string read GetAString;
+    property AGetBoolean: boolean read GetABoolean;
+    property AGetShortString: ShortString read GetAShortString;
+    property AWriteOnly: integer write SetWriteOnly;
+  end;
+
+
+{ TTestValueClass }
+
+function TTestValueClass.GetAInteger: integer;
+begin
+  result := FAInteger;
+end;
+
+function TTestValueClass.GetAString: string;
+begin
+  result := FAString;
+end;
+
+function TTestValueClass.GetABoolean: boolean;
+begin
+  result := FABoolean;
+end;
+
+function TTestValueClass.GetAShortString: ShortString;
+begin
+  Result := FAShortString;
+end;
+
+procedure TTestValueClass.SetWriteOnly(AValue: integer);
+begin
+  // Do nothing
+end;
+
+{ Note: GetTypes currently only returns those types that had been acquired using
+        GetType, so GetTypes itself can't be really tested currently }
+(*procedure TTestCase1.GetTypes;
+var
+  LContext: TRttiContext;
+  LType: TRttiType;
+  IsTestCaseClassFound: boolean;
+begin
+  LContext := TRttiContext.Create;
+
+  { Enumerate all types declared in the application }
+  for LType in LContext.GetTypes() do
+    begin
+    if LType.Name='TTestCase1' then
+      IsTestCaseClassFound:=true;
+    end;
+  LContext.Free;
+  CheckTrue(IsTestCaseClassFound, 'RTTI information does not contain class of testcase.');
+end;*)
+
+procedure TTestCase1.TestGetValueStringCastError;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AValue: TValue;
+  i: integer;
+  HadException: boolean;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AString := '12';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AValue := ARttiType.GetProperty('astring').GetValue(ATestClass);
+      HadException := false;
+      try
+        i := AValue.AsInteger;
+      except
+        on E: Exception do
+          if E.ClassType=EInvalidCast then
+            HadException := true;
+      end;
+      Check(HadException, 'No or invalid exception on invalid cast');
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestMakeObject;
+var
+  AValue: TValue;
+  ATestClass: TTestValueClass;
+begin
+  ATestClass := TTestValueClass.Create;
+  ATestClass.AInteger := 54329;
+  TValue.Make(@ATestClass, TypeInfo(TTestValueClass),AValue);
+  CheckEquals(AValue.IsClass, False);
+  CheckEquals(AValue.IsObject, True);
+  Check(AValue.AsObject=ATestClass);
+  CheckEquals(TTestValueClass(AValue.AsObject).AInteger, 54329);
+  ATestClass.Free;
+end;
+
+procedure TTestCase1.TestGetIsReadable;
+var
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+begin
+  c := TRttiContext.Create;
+  try
+    ARttiType := c.GetType(TTestValueClass);
+    AProperty := ARttiType.GetProperty('aBoolean');
+    CheckEquals(AProperty.IsReadable, true);
+    AProperty := ARttiType.GetProperty('aGetBoolean');
+    CheckEquals(AProperty.IsReadable, true);
+    AProperty := ARttiType.GetProperty('aWriteOnly');
+    CheckEquals(AProperty.IsReadable, False);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestIsWritable;
+var
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+begin
+  c := TRttiContext.Create;
+  try
+    ARttiType := c.GetType(TTestValueClass);
+    AProperty := ARttiType.GetProperty('aBoolean');
+    CheckEquals(AProperty.IsWritable, true);
+    AProperty := ARttiType.GetProperty('aGetBoolean');
+    CheckEquals(AProperty.IsWritable, false);
+    AProperty := ARttiType.GetProperty('aWriteOnly');
+    CheckEquals(AProperty.IsWritable, True);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueBoolean;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.ABoolean := true;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('aBoolean');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(true,AValue.AsBoolean);
+      ATestClass.ABoolean := false;
+      CheckEquals(true, AValue.AsBoolean);
+      CheckEquals('True', AValue.ToString);
+      CheckEquals(True, AValue.IsOrdinal);
+      CheckEquals(1, AValue.AsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+      CheckEquals(True,AValue.AsBoolean);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueShortString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AShortString := 'Hello World';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('aShortString');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals('Hello World',AValue.AsString);
+      ATestClass.AShortString := 'Foobar';
+      CheckEquals('Hello World', AValue.AsString);
+      CheckEquals(False, AValue.IsOrdinal);
+      CheckEquals(False, AValue.IsObject);
+      CheckEquals(False, AValue.IsArray);
+      CheckEquals(False, AValue.IsClass);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals('Hello World',AValue.AsString);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueInteger;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AInteger := 472349;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('ainteger');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(472349,AValue.AsInteger);
+      ATestClass.AInteger := 12;
+      CheckEquals(472349, AValue.AsInteger);
+      CheckEquals('472349', AValue.ToString);
+      CheckEquals(True, AValue.IsOrdinal);
+    finally
+      AtestClass.Free;
+    end;
+      CheckEquals(472349,AValue.AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  i: int64;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AString := 'Hello World';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('astring');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals('Hello World',AValue.AsString);
+      ATestClass.AString := 'Goodbye World';
+      CheckEquals('Hello World',AValue.AsString);
+      CheckEquals('Hello World',AValue.ToString);
+      Check(TypeInfo(string)=AValue.TypeInfo);
+      Check(AValue.TypeData=GetTypeData(AValue.TypeInfo));
+      Check(AValue.IsEmpty=false);
+      Check(AValue.IsObject=false);
+      Check(AValue.IsClass=false);
+      CheckEquals(AValue.IsOrdinal, false);
+      CheckEquals(AValue.TryAsOrdinal(i), false);
+      CheckEquals(AValue.IsType(TypeInfo(string)), true);
+      CheckEquals(AValue.IsType(TypeInfo(integer)), false);
+      CheckEquals(AValue.IsArray, false);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals('Hello World',AValue.AsString);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueProcBoolean;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.ABoolean := true;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('aGetBoolean');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(true,AValue.AsBoolean);
+    finally
+      AtestClass.Free;
+    end;
+      CheckEquals(True,AValue.AsBoolean);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueProcShortString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AShortString := 'Hello World';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('aGetShortString');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals('Hello World',AValue.AsString);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals('Hello World',AValue.AsString);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  s: string;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('astring');
+
+      s := 'ipse lorem or something like that';
+      TValue.Make(@s, TypeInfo(s), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AString, s);
+      s := 'Another string';
+      CheckEquals(ATestClass.AString, 'ipse lorem or something like that');
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueInteger;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  i: integer;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('aInteger');
+
+      i := -43573;
+      TValue.Make(@i, TypeInfo(i), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AInteger, i);
+      i := 1;
+      CheckEquals(ATestClass.AInteger, -43573);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueBoolean;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  b: boolean;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('aboolean');
+
+      b := true;
+      TValue.Make(@b, TypeInfo(b), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.ABoolean, b);
+      b := false;
+      CheckEquals(ATestClass.ABoolean, true);
+      TValue.Make(@b, TypeInfo(b), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.ABoolean, false);
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropSetValueShortString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+  s: string;
+  ss: ShortString;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      AProperty := ARttiType.GetProperty('aShortString');
+
+      s := 'ipse lorem or something like that';
+      TValue.Make(@s, TypeInfo(s), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AShortString, s);
+      s := 'Another string';
+      CheckEquals(ATestClass.AShortString, 'ipse lorem or something like that');
+
+      ss := 'Hello World';
+      TValue.Make(@ss, TypeInfo(ss), AValue);
+      AProperty.SetValue(ATestClass, AValue);
+      CheckEquals(ATestClass.AShortString, ss);
+      ss := 'Foobar';
+      CheckEquals(ATestClass.AShortString, 'Hello World');
+    finally
+      AtestClass.Free;
+    end;
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueProcInteger;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AInteger := 472349;
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('agetinteger');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals(472349,AValue.AsInteger);
+    finally
+      AtestClass.Free;
+    end;
+      CheckEquals(472349,AValue.AsInteger);
+  finally
+    c.Free;
+  end;
+end;
+
+procedure TTestCase1.TestPropGetValueProcString;
+var
+  ATestClass : TTestValueClass;
+  c: TRttiContext;
+  ARttiType: TRttiType;
+  AProperty: TRttiProperty;
+  AValue: TValue;
+begin
+  c := TRttiContext.Create;
+  try
+    ATestClass := TTestValueClass.Create;
+    ATestClass.AString := 'Hello World';
+    try
+      ARttiType := c.GetType(ATestClass.ClassInfo);
+      Check(assigned(ARttiType));
+      AProperty := ARttiType.GetProperty('agetstring');
+      AValue := AProperty.GetValue(ATestClass);
+      CheckEquals('Hello World',AValue.AsString);
+    finally
+      AtestClass.Free;
+    end;
+    CheckEquals('Hello World',AValue.AsString);
+  finally
+    c.Free;
+  end;
+end;
+
+
+procedure TTestCase1.TestTRttiTypeProperties;
+var
+  c: TRttiContext;
+  ARttiType: TRttiType;
+
+begin
+  c := TRttiContext.Create;
+  try
+    ARttiType := c.GetType(TTestValueClass);
+    Check(assigned(ARttiType));
+    CheckEquals(ARttiType.Name,'TTestValueClass');
+    Check(ARttiType.TypeKind=tkClass);
+//    CheckEquals(ARttiType.IsPublicType,false);
+    CheckEquals(ARttiType.TypeSize,SizeOf(TObject));
+    CheckEquals(ARttiType.IsManaged,false);
+    CheckEquals(ARttiType.BaseType.classname,'TRttiInstanceType');
+    CheckEquals(ARttiType.IsInstance,True);
+    CheckEquals(ARttiType.AsInstance.DeclaringUnitName,'tests.rtti');
+    Check(ARttiType.BaseType.Name='TObject');
+    Check(ARttiType.AsInstance.BaseType.Name='TObject');
+    CheckEquals(ARttiType.IsOrdinal,False);
+    CheckEquals(ARttiType.IsRecord,False);
+    CheckEquals(ARttiType.IsSet,False);
+  finally
+    c.Free;
+  end;
+
+end;
+
+procedure TTestCase1.GetTypeInteger;
+var
+  LContext: TRttiContext;
+  LType: TRttiType;
+begin
+  LContext := TRttiContext.Create;
+
+  LType := LContext.GetType(TypeInfo(integer));
+  CheckEquals(LType.Name, 'LongInt');
+
+  LContext.Free;
+end;
+
+procedure TTestCase1.GetClassProperties;
+var
+  LContext: TRttiContext;
+  LType: TRttiType;
+  PropList: {$ifdef fpc}specialize{$endif} TArray<TRttiProperty>;
+begin
+  LContext := TRttiContext.Create;
+
+  LType := LContext.GetType(TypeInfo(TGetClassProperties));
+  PropList := LType.GetProperties;
+
+  CheckEquals(4, length(PropList));
+  CheckEquals('PubPropRO', PropList[0].Name);
+  CheckEquals('PubPropRW', PropList[1].Name);
+  CheckEquals('PubPropSetRO', PropList[2].Name);
+  CheckEquals('PubPropSetRW', PropList[3].Name);
+
+  LContext.Free;
+end;
+
+procedure TTestCase1.GetClassPropertiesValue;
+var
+  AGetClassProperties: TGetClassProperties;
+  LContext: TRttiContext;
+  LType: TRttiType;
+  AValue: TValue;
+begin
+  LContext := TRttiContext.Create;
+
+  LType := LContext.GetType(TGetClassProperties);
+
+  AGetClassProperties := TGetClassProperties.Create;
+  try
+    AGetClassProperties.PubPropRW:=12345;
+
+    AValue := LType.GetProperty('PubPropRW').GetValue(AGetClassProperties);
+    CheckEquals(12345, AValue.AsInteger);
+
+  finally
+    AGetClassProperties.Free;
+  end;
+
+  LContext.Free;
+end;
+
+initialization
+{$ifdef fpc}
+  RegisterTest(TTestCase1);
+{$else fpc}
+  RegisterTest(TTestCase1.Suite);
+{$endif fpc}
+end.
+