+ add TRttiPointerType

* extend Rtti test

git-svn-id: trunk@37402 -

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

@@ -230,6 +230,12 @@ type
     property StringKind: TRttiStringKind read GetStringKind;
   end;
 
+  TRttiPointerType = class(TRttiType)
+  private
+    function GetReferredType: TRttiType;
+  public
+    property ReferredType: TRttiType read GetReferredType;
+  end;
 
   { TRttiInstanceType }
 
@@ -617,6 +623,13 @@ begin
     Result := false;
 end;
 
+{ TRttiPointerType }
+
+function TRttiPointerType.GetReferredType: TRttiType;
+begin
+  Result := GRttiPool.GetType(FTypeData^.RefType);
+end;
+
 { TRttiPool }
 
 function TRttiPool.GetTypes: specialize TArray<TRttiType>;
@@ -668,6 +681,7 @@ begin
           tkUString,
           tkWString : Result := TRttiStringType.Create(ATypeInfo);
           tkFloat   : Result := TRttiFloatType.Create(ATypeInfo);
+          tkPointer : Result := TRttiPointerType.Create(ATypeInfo);
         else
           Result := TRttiType.Create(ATypeInfo);
         end;

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

@@ -24,6 +24,7 @@ type
   published
     //procedure GetTypes;
     procedure GetTypeInteger;
+    procedure GetTypePointer;
     procedure GetClassProperties;
 
     procedure GetClassPropertiesValue;
@@ -835,6 +836,30 @@ begin
   LContext.Free;
 end;
 
+procedure TTestCase1.GetTypePointer;
+var
+  context: TRttiContext;
+  t: TRttiType;
+  p: TRttiPointerType absolute t;
+begin
+  context := TRttiContext.Create;
+  try
+    t := context.GetType(TypeInfo(Pointer));
+    Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
+    Assert(not Assigned(p.ReferredType), 'ReferredType of Pointer is not Nil');
+    t := context.GetType(TypeInfo(PLongInt));
+    Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
+    Assert(Assigned(p.ReferredType), 'ReferredType of PLongInt is Nil');
+    Assert(p.ReferredType = context.GetType(TypeInfo(LongInt)), 'ReferredType of PLongInt is not a LongInt');
+    t := context.GetType(TypeInfo(PWideChar));
+    Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
+    Assert(Assigned(p.ReferredType), 'ReferredType of PWideChar is Nil');
+    Assert(p.ReferredType = context.GetType(TypeInfo(WideChar)), 'ReferredType of PWideChar is not a WideChar');
+  finally
+    context.Free;
+  end;
+end;
+
 procedure TTestCase1.GetClassProperties;
 var
   LContext: TRttiContext;