From 0c8f670ee0747bee6a8cfb085d4efe486e48ce70 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Thu, 5 Oct 2017 21:10:30 +0000
Subject: [PATCH] + add TRttiPointerType * extend Rtti test

git-svn-id: trunk@37402 -
---
 packages/rtl-objpas/src/inc/rtti.pp      | 14 +++++++++++++
 packages/rtl-objpas/tests/tests.rtti.pas | 25 ++++++++++++++++++++++++
 2 files changed, 39 insertions(+)

diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index 8fe6478a1e..78dd20171b 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/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;
diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas
index 0d12753a24..f8d1aeb562 100644
--- a/packages/rtl-objpas/tests/tests.rtti.pas
+++ b/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;